Archive for December, 2010

Programming Praxis – Arithmetic Drill

December 31, 2010

In today’s Programming Praxis exercise, our goal is to write a program that allows children to test their arithmetic skill. Let’s get started, shall we?

First, some imports.

import Control.Monad
import System.Random
import Text.Printf

All we need for a new sum are two random numbers.

drill :: Maybe Int -> IO ()
drill n = play n =<< liftM2 (,) rnd rnd
          where rnd = randomRIO (1, maybe 10 id n)

Processing input isn’t too difficult. Just print the appropriate response and repeat the same sum if the answer is wrong or start a new one when the correct answer is given or requested. Since getLine produces an error when an end-of-file character is encountered we have to use catch to deal with it.

play :: Maybe Int -> (Int, Int) -> IO ()
play n (a,b) = printf "%d + %d = " a b >>
               catch getLine (\_ -> return "quit") >>= \s -> case s of
    "quit" -> putStrLn "Goodbye!"
    "?"    -> print (a + b) >> drill n
    x      -> if x == show (a + b) then putStrLn "Right!" >> drill n
              else putStrLn "Wrong, try again!" >> play n (a,b)

All that’s left to do is to start the program.

main :: IO ()
main = drill Nothing

Programming Praxis – Tracking Santa

December 24, 2010

In today’s Programming Praxis, our task is to calculate the total distance traveled by Santa based on data published by NORAD. Let’s get started, shall we?

First, some imports:

import Data.List.HT
import Text.HJson
import Text.HJson.Query

The easiest version of the algorithm to calculate the distance between two coordinated can be found here. I’ve made a few small adjustments to get rid of some duplication. The Scheme solution rounds off the result, but I don’t believe that is correct. Granted, it doesn’t result in a big deviation (3 miles on a total of almost 200000), but rounding off should be saved until the end.

dist :: RealFloat a => (a, a) -> (a, a) -> a
dist (lat1, lng1) (lat2, lng2) =
  let toRad d = d * pi / 180
      haversin x = sin (toRad $ x / 2) ^ 2
      a = haversin (lat2 - lat1) +
          cos (toRad lat1) * cos (toRad lat2) * haversin (lng2 - lng1)
  in 2 * 6371 * atan2 (sqrt a) (sqrt (1 - a))

Rather than hunting through the string ourselves for the coordinates, we use a Json library.

coords :: Json -> [(Double, Double)]
coords = map ((\[JString lat, JString lng] -> (read lat, read lng)) .
              getFromKeys ["lat", "lng"]) . getFromArr

The total distance can be easily calculated by summing the distances between the subsequent points of the route.

totalMiles :: RealFloat a => [(a, a)] -> Int
totalMiles = round . (* 0.621371192) . sum . mapAdjacent dist

All that’s left to do is to read in the route and print out the result.

main :: IO ()
main = either print (print . totalMiles . coords) . fromString .
       drop 16 =<< readFile "santa.txt"

Initially there was a much larger difference between my version and the provided answer. It turns out that the route on page 2 is different from the current route published by NORAD, resulting in a difference of about 2000 miles. Using the same route as the Scheme version reduced this to 3, due to the rounding error present in the provided solution.

Programming Praxis – Interval Arithmetic

December 21, 2010

In today’s Programming Praxis exercise, our goal is to implement some functions to do interval arithmetic. Let’s get started, shall we?

The plus and minus functions are trivial.

plus :: (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
plus (a,b) (c,d) = (a+c, b+d)

minus :: (Num a, Num b) => (a, b) -> (b, a) -> (a, b)
minus (a,b) (c,d) = (a-d, b-c)

As Chun Kin Lee pointed out, my initial attempt at removing duplication doesn’t work for ranges with negative numbers, so I had to go back to way mentioned in the original algorithm.

times :: (Num a, Ord a) => (a, a) -> (a, a) -> (a, a)
times (a,b) (c,d) = let x = [a*c,a*d,b*c,b*d] in (minimum x, maximum x)

divide :: (Fractional a, Ord a) => (a, a) -> (a, a) -> (a, a)
divide (a,b) (c,d) = if c < 0 && d > 0 then error "divide by 0"
    else let x = [a/c,a/d,b/c,b/d] in (minimum x, maximum x)

Converting between bounded and centered intervals is also trivial.

toCenter :: Fractional a => (a, a) -> (a, a)
toCenter (a,b) = ((a+b) / 2, (b-a) / 2)

fromCenter :: Num a => (a, a) -> (a, a)
fromCenter (a,b) = (a-b, a+b)

Some tests to see if everything is working properly:

main :: IO ()
main = do let x = (1,2)
              y = (3,4)
          print $ plus x y == (4,6)
          print $ minus x y == (-3,-1)
          print $ times x y == (3,8)
          print $ divide x y == (1/4,2/3)
          print $ divide x x == (1/2, 2)
          print $ toCenter x == (3/2,1/2)
          print $ fromCenter (3/2,1/2) == x

Everything seems to be working fine.

Programming Praxis – Polite Numbers

December 17, 2010

In today’s Programming Praxis exercise, our task is to list all the ways that a number can be written as the sum of a consecutive series of integers. Let’s get started, shall we?

Some imports:

import Data.List
import Data.Numbers.Primes

We need a function to calculate the divisors of a number, which we recycle from a previous exercise:

divisors :: Integral a => a -> [a]
divisors = nub . sort . map product . subsequences . primeFactors

We use a somewhat more compact version of the algorithm than the Scheme solution. The main savings are replacing the if statement with simply taking the maximum of the two numbers and not including an explicit check for powers of two, since the basic algorithm already produces the correct answer and powers of 2 are rare enough that in my opinion the extra algorithm size is not warranted.

polites :: Integral a => a -> [[a]]
polites n = [ [max (d//2 - n//d + 1) (n//d - d//2)..n//d + d//2]
            | d <- tail $ divisors n, odd d, let (//) = div]

Thanks to laziness we don’t have to duplicate code when calculating the politeness of a number (the length of the result set). The result sets themselves are never evaluated, so all this does is count the odd divisors.

politeness :: Integral a => a -> Int
politeness = length . polites

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ polites 15 == [[4..6],[1..5],[7,8]]
          print $ politeness 15 == 3
          print $ polites 28 == [[1..7]]
          print $ politeness 28 == 1
          print $ polites 33 == [[10..12],[3..8],[16,17]]
          print $ politeness 33 == 3
          print . all (null . polites) . take 10 $ iterate (* 2) 1

Looks like it is.

Programming Praxis – Longest Duplicated Substring

December 14, 2010

In today’s Programming Praxis exercise, our task is to implement the algorithm to find the longest duplicated substring in a word. Let’s get started, shall we?

Some imports:

import Data.List
import Data.List.HT (mapAdjacent)
import qualified Data.List.Key as K

It seems we have yet another case of simply translating the English description to Haskell syntax: create a list of suffixes, sort, get the longest common prefix of all adjacent pairs and return the longest one.

lds :: Ord a => [a] -> [a]
lds = K.maximum length . mapAdjacent lcp . sort . tails where
    lcp (x:xs) (y:ys) | x == y = x : lcp xs ys
    lcp _      _               = []

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ lds "banana"
          print $ lds "ask not what your country can do for you, \
                      \ask what you can do for your country"

Everything seems to be working fine.

Programming Praxis – Two Random Selections

December 10, 2010

In today’s Programming Praxis exercise we have to implement two algorithms that select random items from a list in linear time. Let’s get started, shall we?

Some imports:

import Control.Monad
import Data.List
import System.Random

I found myself doing the same thing in both functions so I factored it out. This function gives you an x in y chance of choosing a instead of b.

chance :: Int -> Int -> a -> a -> IO a
chance x y a b = fmap (\r -> if r < x then a else b) $ randomRIO (0, y - 1)

The first algorithm (selecting one item at random from a list) can be done by folding over the list, with each item having a decreasing chance of becoming the new choice.

fortune :: [a] -> IO a
fortune = foldM (\a (n, x) -> chance 1 n x a) undefined . zip [1..]

The second algorithm (selecting m items from a list of integers) is pretty much the same, except now we also have to keep track of how many items we selected. This version always goes through the entire list rather than stopping when m items have been selected, but since it still runs in O(n) and the resulting code is cleaner I went with this version.

sample :: Int -> Int -> IO [Int]
sample m n = fmap snd $ foldM (\(m', a) x -> chance m' x
    (m' - 1, x:a) (m', a)) (m, []) [n, n-1..1]

With random algorithms it’s always a good idea to check the distribution of the results, as was proven again today because it revealed a bug in my code.

main :: IO ()
main = do let dist n f = mapM_ (\x -> print (length x, head x)) .
                         group . sort . concat =<< replicateM n f
          dist 10000 . fmap return $ fortune ["rock", "paper", "scissors"]
          dist 10000 $ sample 6 43

The frequency distribution is pretty much equal and they sum up to the correct amount, so everything seems to be working correctly.

Programming Praxis – Ullman’s Puzzle

December 7, 2010

In today’s Programming Praxis exercise, our task is to write a solution to Ullman’s puzzle, which is to check whether there exists a subsequence of exactly length k of a series of real numbers that sums up to less than a given t. Let’s get started, shall we?

A quick import:

import Data.List

Today’s exercise is a short one. My first attempt was basically converting the problem statement into Haskell syntax:

ullman :: (Num a, Ord a) => a -> Int -> [a] -> Bool
ullman t k = any (\s -> length s == k && sum s < t) . subsequences

The Scheme solution uses a more efficient algorithm, so for the sake of completeness we’ll translate that into Haskell as well. This one runs in O(n log n) rather than O(n!) and it’s shorter to boot.

ullman2 :: (Ord a, Num a) => a -> Int -> [a] -> Bool
ullman2 t k = (< t) . sum . take k . sort

Some tests to see if everything is working properly:

main :: IO ()
main = do let xs = [18.1,55.1, 91.2, 74.6, 73.0, 85.9, 73.9, 81.4,
                    87.1, 49.3, 88.8, 5.7, 26.3, 7.1, 58.2, 31.7,
                    5.8, 76.9, 16.5, 8.1, 48.3, 6.8, 92.4, 83.0, 19.6]
          let ys = [3, 4, 3]
          print $ ullman 98.2 3 xs
          print $ ullman2 98.2 3 xs
          print . not $ ullman 5 2 ys
          print . not $ ullman2 5 2 ys

Looks like it is.

Programming Praxis – Maximum Sum Subsequence

December 3, 2010

In today’s Programming Praxis exercise, we have to implement four different ways of solving the problem of finding the contiguous subsequence with the maximum sum from a list, each with a different big O complexity. Let’s get started, shall we?

A quick import:

import Data.List

The O(n^3) version is simple: generate all the contiguous subsequences and find the one with the highest sum.

maxSum1 :: (Ord a, Num a) => [a] -> a
maxSum1 xs = maximum . map sum $ inits =<< tails xs

The previous algorithm can be improved by keeping track of the sum during the subsequence generation, reducing it to O(n^2).

maxSum2 :: (Ord a, Num a) => [a] -> a
maxSum2 xs = maximum $ scanl (+) 0 =<< tails xs

The O(n log n) one is a lot more tricky, and took me a couple of tries. In the end, I decided to things things bottom-up rather than the Scheme solution’s top-down approach. We start by converting each number to a list of length 1 with a sum equal to itself. Then we keep merging these list pairwise until we only have one element left. The merging is the same as in the Scheme solution: the new maximum sum is equal to the maximum of those of the two subsequences and the maximum sum that can be obtained after the concatenation.

maxSum3 :: (Ord a, Num a) => [a] -> a
maxSum3 = fst . head . until (null . tail) f . map (\x -> (x, [x])) where
    f ((lm, l):(rm, r):xs) = (maximum [maximum (scanl (+) 0 r) +
        maximum (scanr (+) 0 l), lm, rm], l ++ r) : f xs
    f xs = xs

The O(n) solution is easier to write, and can be done with a simple fold.

maxSum4 :: (Ord a, Num a) => [a] -> a
maxSum4 = snd . foldl (\(here, sofar) x -> let m = max 0 $ here + x
                                           in (m, max m sofar)) (0, 0)

Some tests to see if everything is working properly:

main :: IO ()
main = do let test f = print $ f [31,-41,59,26,-53,58,97,-93,-23,84] == 187
          test maxSum1
          test maxSum2
          test maxSum3
          test maxSum4

Yep. I have to admit though, I wouldn’t have come up with the O(n log n) or O(n) version during an interview, and maybe not even the O(n^2) version. I would have assumed there would be a more efficient algorithm, but having never needed to solve this problem before nor having read Programming Pearls I wouldn’t have been able to give the exact lower bound. I Guess I won’t be working for Phil any time soon 🙂 Then again, I personally believe that, in an age where efficient algorithms for problems like this are a five-second Google search away, an encyclopedic knowledge of efficient algorithms is nice to have but hardly essential.