Programming Praxis – 3SUM

In today’s Programming Praxis exercise, our goal is to find all groups of three numbers in a given list that sum up to 0, and to do so in O(n²). Let’s get started, shall we?

import Data.List
import qualified Data.IntSet as I

The naive O(n³) version can be modified fairly easily to be more efficient. The first two loops can remain unchanged. In the final loop, we already know the number we’re looking for (the complement of the other two and all we need to know is whether it exists in the list. This can be done in O(1) using an IntSet. Unfortunately, this returns every triple thrice, so we sort the triples (O(1)) and remove the duplicates (I used the rather inefficient nub function here for the sake of brevity; in practive you’ll probably want to use a Set to reduce this part from O(k²) to O(k log k)).

sum3 :: [Int] -> [[Int]]
sum3 xs = nub [sort [a,b,-a-b] | (a:bs) <- tails xs, b <- bs, I.member (-a-b) s]
          where s = I.fromList xs

A test to see if everything is working properly:

main :: IO ()
main = print $ sum3 [8,-25,4,10,-10,-7,2,-3] == [[-10,2,8],[-7,-3,10]]

To check whether the function is indeed O(n²) I ran some timings by using list of consecutive numbers:

Input list	Time taken
1 to 8000	0.4s
1 to 16000	1.4s
1 to 32000	5.2s
1 to 64000	20.6s

As you can see, doubling the input size leads to a quadrupling of execution time, give or take a few tenths of a second, which means the algorithm is indeed O(n²).

Programming Praxis – 4SUM

In today’s Programming Praxis exercise, our goal is to find four integers in a given list that sum up to a given target number. Let’s get started, shall we?

We use the same approach of storing pair sums as the given solution. We store them using the sum as the key, which means we can use an IntMap, which offers improved performance over a regular Map.

import qualified Data.IntMap as I

First we generate all the pairs, then we try to find two pairs that sum up to the given number.

sum4 :: Int -> [Int] -> [[Int]]
sum4 n xs = take 1 [p1++p2 | (s, p1) <- I.assocs pairs
                           , p2 <- maybe [] return $ I.lookup (n-s) pairs]
    where pairs = I.fromList [(a+b, [a,b]) | a <- xs, b <- xs]

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ sum (head $ sum4 0 [2,3,1,0,-4,-1]) == 0
          print $ sum4 0 [1,2,3,4,5,6] == []
          print $ sum4 13 [1,2,3,4,5,6] == [[1,1,6,5]]

Programming Praxis – SEND + MORE = MONEY, Part 1

In today’s Programming Praxis exercise, our goal is to provide two different solutions for the well known SEND + MORE = MONEY sum, in which each letter must be replaced by a valid digit to yield a correct sum. Let’s get started, shall we?

A quick import:

import Data.List

I’ll be honest, the only reason I wrote this first solution this way is because the exercise explicitly called for checking all possible solutions using nested loops. It’s so horribly inefficient! Take the test whether all digits are unique for example: normally you’d remove each chosen digit from the list of options for all subsequent ones, but we’re not allowed to do that. I normally also wouldn’t do the multiplications this explicitly, but to avoid overlap with the second solution I left it like this. Unsurprisingly, it takes almost a minute and a half to run.

send1 :: ([Integer], [Integer], [Integer])
send1 = head [([s,e,n,d], [m,o,r,e], [m,o,n,e,y])
             | s <- [1..9], e <- [0..9], n <- [0..9], d <- [0..9]
             , m <- [1..9], o <- [0..9], r <- [0..9], y <- [0..9]
             , length (group $ sort [s,e,n,d,m,o,r,y]) == 8
             , 1000*(s+m) + 100*(e+o) + 10*(n+r) + d+e ==
               10000*m + 1000*o + 100*n + 10*e + y]

This is actually the solution I started with: since all digits need to be unique, you can simply generate the permutations of the numbers 0 through 9, backtracking when s or m are zero or when the numbers don’t add up correctly. By writing a function to do the multiplication and assinging some variables we not only make things more readable, but we also get to use the problem statement directly in the code, which I find conceptually satisfying. I do have the distinct impression that this is what we’re supposed to make in part 2 of this exercise though, since it runs in about a second, which is significantly faster than the two provided solutions.

send2 :: (Integer, Integer, Integer)
send2 = head [ (send, more, money) | (s:e:n:d:m:o:r:y:_) <- permutations [0..9]
             , s /= 0, m /= 0, let fill = foldl ((+) . (* 10)) 0
             , let send = fill [s,e,n,d], let more = fill [m,o,r,e]
             , let money = fill [m,o,n,e,y], send + more == money]

A quick test shows that both algorithms produce the correct solution.

main :: IO ()
main = do print send1
          print send2

Programming Praxis – Sum

In today’s Programming Praxis exercise, our goal is to implement a unix checksum utility. Let’s get started, shall we?

Some imports:

import Data.Char
import System.Environment

I made two changes in the checksum algorithm compared to the Scheme version. I included to conversion to a string to remove some duplication and I used a simpler method of dividing and rounding up.

checksum :: String -> String
checksum = (\(s,b) -> show s ++ " " ++ show (div (b + 511) 512)) .
    foldl (\(s,b) c -> (mod (s + ord c) 65535, b + 1)) (0,0)

Depending on whether or not the program was called with any arguments, the checksum is calculated for either the stdin input or the files provided.

main :: IO ()
main = getArgs >>= \args -> case args of
    [] -> interact checksum
    fs -> mapM_ (\f -> putStrLn . (++ ' ':f) . checksum =<< readFile f) fs

Programming Praxis – Sums Of Powers

In today’s Programming Praxis exercise, our goal is to implement an algorithm that calculates the bernoulli numbers and one that uses them to quickly calculate the sum of the mth power of numbers 1 through n. Let’s get started, shall we?

A quick import:

import Data.Ratio

To calculate the Bernouilli numbers I initially used the naive version, which simply uses the given mathematical formula. This is quick enough for the test case of 1000 numbers, but too slow for the test case that has a million, so we have to do some memoization. A closer look at the formula reveals that any row in the table depends only on the previous row. Since for the end result we are only interested in the last row, we can use iterate to produce the rows of the table. The value of a given column depends only on the number directly above it and the one to the upper right, so we can use a simple zip to calculate the new row.

a :: (Integral a, Integral b) => a -> a -> Ratio b
a i j = iterate (\xs -> zipWith (*) [1..] $ zipWith (-) xs (tail xs))
                (map (1 %) [1..]) !! fromIntegral i !! fromIntegral j

With this function calculating the Bernoulli numbers is trivial.

bernoullis :: (Integral a, Integral b) => a -> [Ratio b]
bernoullis upto = map (flip a 0) [0..upto]

For the algorithm we also need to calculate binomial coefficients, i.e. the amount of different ways you can choose k objects from a group of size n.

choose :: Integral a => a -> a -> Ratio a
choose n k = product [1..n] % (product [1..n-k] * product [1..k])

And some more executable math for the function that calculates the sum of powers.

s :: Integral a => a -> a -> Ratio a
s m n = 1 % (m+1) * sum [choose (m+1) k * a k 0 * (n%1)^(m+1-k) | k <- [0..m]]

We have one test case to test if the algorithm works correctly and one to judge the speed.

main :: IO ()
main = do print $ bernoullis 6 == [1, 1%2, 1%6, 0, -1%30, 0, 1%42]
          print $ s 10 1000 == 91409924241424243424241924242500
          print $ s 100 1000000

The program runs in about 150-170 ms, so we get the same speed as the Scheme version. Good enough for me.

Programming Praxis – Maximum Sum Subsequence

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.

Programming Praxis – The Sum Of Two Squares

In today’s Programming Praxis exercise we have to find all the ways a given number can be written as the sum of the squares of two other numbers. Let’s get started.

All we really have to do is to convert the four cases of Dijkstra’s algorithm (listed on the second page of the exercise) from English to Haskell, which is trivial. To avoid repeating ourselves, we pattern match on the result of the comparison between x*x + y*y and n instead of recalculating it three times.

squareSum :: Integer -> [(Integer, Integer)]
squareSum n = b (ceiling . sqrt $ fromIntegral n) 0 where
    b x y = if x < y then [] else case compare (x*x + y*y) n of
                LT -> b x (y + 1)
                EQ -> (x, y) : b (x - 1) (y + 1)
                GT -> b (x - 1) y

A quick test shows us that everything’s working correctly.

main :: IO ()
main = do print $ squareSum 50
          print $ squareSum 48612265
          print $ squareSum 999