Archive for February, 2013

Programming Praxis – An Odd Way To Square

February 26, 2013

In today’s Programming Praxis exercise, our goal is to implement an algorithm to square a number using only addition and subtraction. Let’s get started, shall we?

import Data.Bits
import Data.List

First, the trivial O(n) algorithm. n^2 = n * n = sum (n times n)

square :: Integer -> Integer
square n = sum $ genericReplicate n n

Next, an O(log n) algorithm. Create a sequence in which each element consists of the following values: an incrementing integer i, 2^i and n*2^i. Filter out all elements for which the ith bit of n is 0. Sum the n*2^i terms.

square2 :: Integer -> Integer
square2 n = sum [a | (i,a) <- unfoldr (\(i,p,a) -> if p <= n then
    Just ((i,a), (i+1,p+p,a+a)) else Nothing) (0,1,n), testBit n i]

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ map square  [0..10] == map (^2) [0..10]
          print $ map square2 [0..10] == map (^2) [0..10]
          print $ square (2^20) == 2^40
          print $ square2 (2^1000) == 2^2000

Programming Praxis – Floupia

February 22, 2013

In today’s Programming Praxis exercise, our goal is to calculate the minimum total amount of coins involved in a payment (including change) for a currency with a given set of coin denominations. Let’s get started, shall we?

import Data.List
import Math.Combinat

First we search all transactions involving one coin, then all transactions involving two coins, etc. We exclude all options where the payment and the change include the same coin, since that would make both coins useless. We return the first option for which the change equals the difference between the payment and the amount required.

pay :: (Eq a, Num a) => a -> [a] -> ([a], [a])
pay total coins = head
    [(p,c) | n <- [1..], pc <- [1..n], p <- combine pc coins
           , c <- combine (n - pc) (coins \\ p), sum p - total == sum c]

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ pay 17 [1,3,7,31,153] == ([31], [7,7])
          print $ pay 18 [1,10]         == ([10,10],[1,1])

Programming Praxis – NPR Sunday Puzzle

February 19, 2013

In today’s Programming Praxis exercise, our goal is to find two words that consist of the letters A through F and two other letters. Let’s get started, shall we?

import Data.List

Checking if a word is valid is a simple matter of checking whether it has eight letters and whether it contains all six required letters.

npr :: String -> Bool
npr s = length s == 8 && null ("abcdef" \\ s)

With that out of the way, all that’s left to do is to search all the words in the ddictionary for the ones the satisfy the criterium.

main :: IO ()
main = mapM_ print . filter npr . lines =<< readFile "en_US.dic"

As expected, the only words found are boldface and feedback.

Programming Praxis – Facebook Hacker Cup 2013, Round 1, Problem 1

February 15, 2013

In today’s Programming Praxis exercise, our goal is to solve the first problem of the 2013 Facebook hacker cup, which is to give the sum of the highest values of all possible subsequences of length k of a given list of integers. Let’s get started, shall we?

A quick import:

import Data.List

For this problem, we’re going to need to calculate a lot of binomial coefficients, i.e. the amount of ways to choose k out of n items. This involves calculating factorials. The trivial way to do this in Haskell is to use product [1..n], but that’s not very efficient when you need to calculate many different factorials. So instead we create a lazy lookup table of all factorials, so that we save a lot of duplicated effort.

facts :: [Integer]
facts = scanl (*) 1 [1..]

The brute force way to solve the problem would be to simply enumerate all possible subsequences and sum their maximums. Unfortunately there are a LOT of combinations once you get to the maximum number of 10000 possible values (just printing 10000 choose 5000 takes several terminal screens), so clearly that’s not going to work. Instead, we can solve the problem in O(n) by realizing that each number will be the highest in every combination with lower numbers, e.g. the highest number will occur (n-1) choose (k-1) times, the second highest (n-2) choose (k-2) times, etc. Since the answer needs to be given modulo 1000000007, we do this at every step in order to keep the total down.

facebook :: Int -> [Int] -> Integer
facebook size = foldr (\(i,x) a -> mod (a + x * choose (size-1) i) 1000000007) 0 .
        drop (size - 1) . zip [0..] . map fromIntegral . sort where
    choose k n = div (facts!!n) (facts!!k * facts!!(n-k))

Some test cases to see if everything is working properly:

main :: IO ()
main = do print $ facebook 3 [3,6,2,8] == 30
          print $ facebook 2 [10,20,30,40,50] == 400
          print $ facebook 4 [0,1,2,3,5,8] == 103
          print $ facebook 2 [1069,1122] == 1122
          print $ facebook 5 [10386,10257,10432,10087,10381
                             ,10035,10167,10206,10347,10088] == 2621483
          print $ facebook 1 [3,4] == 7
          print $ facebook 3 [3,4,5] == 5
          print $ facebook 5000 [1..10000]

The worst-case scenario, 5000 cards and 10000 numbers, takes just under 5 seconds. Since there’s a maximum of 25 test cases, the total time should be about two minutes at most. Not too bad.

Programming Praxis – The 147 Puzzle

February 5, 2013

In today’s Programming Praxis exercise, our goal is to find all combinations of five numbers whose inverses sum up to one. Let’s get started, shall we?

Since we’re working with exact fractions, the Ratio library is an obvious fit.

import Data.Ratio

We solve the problem recursively so that the algorithm will work on other amounts of numbers as well. Once we’ve chosen all but the last number, that remainder must have a numerator of one. For the rest, just try all possibilities that still leave a large enough remainder for the rest, keeping track of the previous choice to prevent duplicates (each choice must be more than or equal to the previous choice.)

puzzle :: Integer -> [[Integer]]
puzzle k = f 2 (k%1) 1 where
    f _ 1 r = if numerator r == 1 then [[denominator r]] else []
    f p n r = concat [map (x : ) $ f x (n-1) r'
                     | x <- [p..floor $ n/r], let r' = r - 1%x, r' > 0]

While writing the solution, I also came up with some variations that worked fine for k = 5, but were very slow for k = 6. To prevent this we test both of them.

main :: IO ()
main = do print . (== 147) . length $ puzzle 5
          print . (== 3462) . length $ puzzle 6

Programming Praxis – Hofstadter’s Sequence

February 1, 2013

In today’s Programming Praxis exercise, our goal is to write a program that generates the Hofstadter sequence. Let’s get started, shall we?

A quick import:

import Data.List

The exercise provides a 2-line Haskell solution in addition to the usual Scheme one. This solution, however, is needlessly complicated, including both a worker function and explicit recursion. We can eliminate both using the unfoldr function, which takes an initial state and a function that produces an output element and a new state. The state we need to keep track of is the S sequence and the next number of R that will be generated. Since R is of the same type as S, we combine the two into a single list in which the first element is the upcoming element in R and the rest is S. Whenever we calculate the next element of R, we remove it from S. This way, we can do the whole thing in a single line.

hofstadter :: [Integer]
hofstadter = unfoldr (\(r:s:ss) -> Just (r, r+s:delete (r+s) ss)) [1..]

Since the sequence is infinite, you can take as many elements as you want.

main :: IO ()
main = print $ take 25 hofstadter