Archive for April, 2011

Programming Praxis – Rule 30 RNG

April 29, 2011

In today’s Programming Praxis exercise, our goal is to write a random number generator based on the Rule 30 cellular automaton. Let’s get started, shall we?

Some imports:

import Control.Monad.State
import Data.Bits
import Data.Word

First we define the amount of bits in our RNG state.

size :: Int
size = 7 * 43

We’re going to be needing a function to convert a list of bits to a number.

fromBits :: (Bits a, Integral a) => [Bool] -> a
fromBits = foldl (\a x -> shift a 1 .|. fromIntegral (fromEnum x)) 0

The step function replaces the state with the next generation of cells for a given rule and returns the middle bit.

step :: Monad m => Int -> StateT Integer m Bool
step r = modify (\s -> let b i = testBit s (mod i size) in
    fromBits [ testBit r $ fromBits [b (n+1), b n, b (n - 1)]
             | n <- [size - 1, size - 2..0]]) >> gets (`testBit` div size 2)

To produce a random number, we take the middle bit of the desired number of generations and convert that to an unsigned integer.

randomBits :: Monad m => Int -> Int -> StateT Integer m Word
randomBits n r = return . fromBits =<< replicateM n (step r)

To test the algorithm, we see if we get the correct result when we only set the bit in the middle. Afterwards, we produce a bunch of 8-bit numbers.

main :: IO ()
main = evalStateT (do r <- randomBits 32 30
                      liftIO $ print (r == 3112904540)
                      liftIO . print =<< replicateM 100 (randomBits 8 30)
                  ) $ bit (div size 2)

Looks like everything is working properly.


Programming Praxis – Miscellanea

April 26, 2011

In today’s Programming Praxis exercise, our goal is to write three fucntions: FizzBuzz, a function to determine if a base 36 number is prime and one to split a list down the middle while going through the list only once. Let’s get started, shall we?

Some imports:

import Data.Foldable (toList)
import Data.Numbers.Primes
import Data.Sequence (ViewL(..), (|>), fromList, viewl, empty)

First up we have the classic FizzBuzz interview question. There are plenty of ways to solve it, but I’m partial to this one.

fizzbuzz :: Integral a => a -> IO ()
fizzbuzz n = mapM_ (putStrLn . f) [1..n] where
    f n = case (mod n 3, mod n 5) of (0, 0) -> "FizzBuzz"
                                     (0, _) -> "Fizz"
                                     (_, 0) -> "Buzz"
                                     _      -> show n

To determine if a word is prime we convert it from base 36 to base 10 and then determine if it’s prime.

isPrimeWord :: String -> Bool
isPrimeWord = isPrime . sum . zipWith (*) (iterate (* 36) 1) . reverse .
    map (\c -> maybe 0 id . lookup c $ zip (['0'..'9'] ++ ['A'..'Z']) [0..])

For splitting the list, the tortoise and hare algorithm seems dubious to me given the requirement that the list is only scanned once, since both of them scan the list (albeit looking only at half of the elements each). I’ve gone with a different approach. We start with two empty lists, which are balanced. If the lists are balanced, the next element will be added to the right one, which unbalances the list. If they are not balanced, the left element of the right list is added to the end of the left list.

splitList :: [a] -> ([a], [a])
splitList = f True (empty, empty) where
    f _     (l,r) [] = (toList l, toList r)
    f True  (l,r) (x:xs) = f False (l, r |> x) xs
    f False (l,r) (x:xs) = f True ((\(h :< t) -> (l |> h, t |> x)) $ viewl r) xs

Some tests to see if everything is working correctly:

main :: IO ()
main = do fizzbuzz 20
          print . not $ isPrimeWord "PRAXIS"
          print $ isPrimeWord "LISP"
          print $ splitList [] == ([],[] :: [Int])
          print $ splitList [1..4] == ([1,2],[3,4])
          print $ splitList [1..5] == ([1,2],[3,4,5])

Programming Praxis – Xref

April 22, 2011

In today’s Programming Praxis exercise, our goal is to write a program that can tell us on which lines each identifier and operator in a program appers. Let’s get started, shall we?

Some imports:

import Data.List
import qualified Data.List.Key as K
import Language.Haskell.Lexer

Rather than muck about with brittle regular expressions or something to that effect, we’ll just use a proper Haskell lexer library. Note that the one we’re using comes from the haskell-lexer package, which shares a module name with the haskell-src package that comes with the Haskell Platform. When running this program, pass -hide-package haskell-src as an argument to GHC. With that out of the way, all we need to do is read a file, list all the tokens and group all the identifiers by line.

main :: IO ()
main = do file <- readFile "test.hs"
          mapM_ putStrLn . map ((\((n:_), ls) -> unwords $ n : nub ls) .
              unzip) . fst $ K.sort fst
              [(s, show $ line p) | (tok, (p,s)) <- lexerPass0 file, 
               elem tok [Varid, Conid, Varsym, Consym]]

Running this algorithm on its own source code produces the following:

$ 7 8 9
. 7 8
Conid 10
Consym 10
IO 5
K 2
Varid 10
Varsym 10
as 2
elem 10
file 6 9
fst 8
lexerPass0 9
line 9
ls 7
main 5 6
map 7
mapM_ 7
n 7
nub 7
p 9
putStrLn 7
qualified 2
readFile 6
s 9
show 9
tok 9 10
unwords 7
unzip 8

Looks like everything is working properly.

Programming Praxis – Same Five Digits

April 19, 2011

In today’s Programming Praxis exercise, our goal is to solve a numeric riddle. Let’s get started, shall we?

Some imports:

import Data.List
import qualified Data.List.Key as K

The relevant squares are the ones that consists only of the digits 1 through 5. The explanation as to why can be found in the provided solution.

squares :: [Integer]
squares = filter (all (`elem` "12345") . show) .
          takeWhile (< 100000) $ map (^2) [100..]

The rest of the riddle can be solved with picking the correct element out of a list comprehension. Note the conditions that a < b and b < c. This prevents the same triple occurring in different permutations. I originally hadn’t included these, which is why I couldn’t get it working initially.

sameFive :: Maybe (Integer, Integer, Integer)
sameFive = fmap (fst . head) . find (null . tail) . snd $ K.sort snd
           [ ((a,b,c), findIndex (== 1) dc)
           | a <- squares, b <- squares, a < b, c <- squares, b < c
           , let dc = map length . group . sort $ show =<< [a,b,c]
           , sort dc == [1..5], and $ zipWith (/=) dc [1..5]

All that’s left to do is to see if we get the correct answer.

main :: IO ()
main = print sameFive

Programming Praxis – Partition Numbers

April 15, 2011

In today’s Programming Praxis exercise, our goal is to write a function to calculate partition numbers and to determine the 1000th partition number. Let’s get started, shall we?

Since the recursion in the algorithm is not as simple as in for example the Fibonacci numbers a simple zip will not suffice. To store previous results, we use an IntMap.

import Data.IntMap ((!), fromList, insert, findWithDefault)

Since we’re guaranteed to need every partition number below the one we’re looking for, we simply calculate all of them, starting from 1. This is done by folding over the numbers 1 through x with the IntMap as the accumulator.

partition :: Int -> Integer
partition x = if x < 0 then 0 else foldl p (fromList [(0,1)]) [1..x] ! x where
    p s n = insert n (sum [(-1)^(k+1) * (r pred + r succ) | k <- [1..n],
        let r f = findWithDefault 0 (n - div (k * f (3 * k)) 2) s]) s

Let’s see if we did everything correctly.

main :: IO ()
main = print $ partition 1000 == 24061467864032622473692149727991

Yup. After compiling it runs in about 0.4 seconds on my machine.

Programming Praxis – House Of Representatives

April 12, 2011

In today’s Programming Praxis exercise, our goal is to calculate the amount of seats each state gets in the United States House of Representatives. Let’s get started, shall we?

Some imports:

import Control.Arrow
import qualified Data.List.Key as K
import qualified Data.Map as M

To calculate the seat distribution we need the population data for each state.

popData :: M.Map String Integer
popData = M.fromList [("Alabama",4779736), ("Alaska",710231),
  ("Arizona",6392017), ("Arkansas",2915918), ("California",37253956),
  ("Colorado",5029196), ("Connecticut",3574097), ("Delaware",897934),
  ("Florida",18801310), ("Georgia",9687653), ("Hawaii",1360301),
  ("Idaho",1567582), ("Illinois",12830632), ("Indiana",6483802),
  ("Iowa",3046355), ("Kansas",2853118), ("Kentucky",4339367),
  ("Louisiana",4533372), ("Maine",1328361), ("Maryland",5773552),
  ("Massachusetts",6547629), ("Michigan",9883640), ("Minnesota",5303925),
  ("Mississippi",2967297), ("Missouri",5988927), ("Montana",989415),
  ("Nebraska",1826341), ("Nevada",2700551), ("New Hampshire",1316470),
  ("New Jersey",8791894), ("New Mexico",2059179), ("New York",19378102),
  ("North Carolina",9535483), ("North Dakota",672591), ("Ohio",11536504),
  ("Oklahoma",3751351), ("Oregon",3831074), ("Pennsylvania",12702379),
  ("Rhode Island",1052567), ("South Carolina",4625364), ("South Dakota",814180),
  ("Tennessee",6346105), ("Texas",25145561), ("Utah",2763885),
  ("Vermont",625741), ("Virginia",8001024), ("Washington",6724540),
  ("West Virginia",1852994), ("Wisconsin",5686986), ("Wyoming",563626)]

The algorithm itself is fairly simple. Start with one seat per state and then keep assigning one seat to the state with the highest geometric mean until the desired number of seats is reached.

house :: Int -> M.Map String Integer
house seats = fst $ iterate add ( ((,) 1) popData) !! k where
    add m = M.adjust (first succ) (maxMean m) m
    maxMean = fst . K.maximum (uncurry g . snd) . M.toList
    g n p = f p / sqrt (f n * (f n + 1)) where f = fromIntegral
    k = seats - M.size popData + 1

Some tests to see if everything is working properly:

main :: IO ()
main = do print $ house 435 M.! "California" == 53
          print $ house 435 M.! "Kentucky" == 6
          print $ house 435 M.! "Wyoming" == 1
          print . K.sort (negate . snd) . M.toList $ house 435

Programming Praxis – Credit Card Validation

April 8, 2011

In today’s Programming Praxis exercise our goal is to write to functions related to the Luhn credit card number verification algorithm: one to check if a number is valid and one to make a valid number from a given number by adding one digit. Let’s get started, shall we?

Some imports:

import Data.Char
import Data.List.HT
import Test.QuickCheck

For both functions we need to calculate the Luhn sum of a number, so let’s start with that. This one simply follows the description given in the exercise text. You could probably speed it up a bit by replacing the multiplication with a lookup table.

luhnSum :: Integral a => a -> a
luhnSum n = digitSum a + digitSum (show . (* 2) . digitToInt =<< b)
    where [a,b] = sliceHorizontal 2 . reverse $ show n
          digitSum = sum . map (fromIntegral . digitToInt)

Checking if a number is valid is trivial: just see if the Luhn sum is zero.

isValid :: Integral a => a -> Bool
isValid n = mod (luhnSum n) 10 == 0

Making a valid number means adding the complement of the Luhn sum of 10 times the number (to account for the digit that will be added on the end) to the end of the number. The outer modulo is to account for the case where the Luhn sum is zero.

makeValid :: Integral a => a -> a
makeValid n = 10*n + mod (10 - mod (luhnSum $ 10*n) 10) 10

Some testing to see if everthing is working properly:

prop_luhn :: Integer -> Property
prop_luhn n = n >= 0 ==> isValid (makeValid n)

main :: IO ()
main = do print $ isValid 0
          print $ isValid 34
          print $ isValid 117
          print $ isValid 49927398716
          print . not $ isValid 49927398715
          print $ makeValid 4992739871 == 49927398716
          quickCheck prop_luhn

Yup. Have fun committing credit card fraud 🙂

Programming Praxis – Fortune

April 5, 2011

In today’s Programming Praxis exercise, our goal is to implement the fortune Unix command line tool. Let’s get started, shall we?

Some imports:

import Control.Monad
import System.Environment
import System.Random

Since we wrote some code in a previous exercise to select a random item from a list we can just use that here again:

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)

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

All that’s left to do to implement the fortune program is to read the appropriate file and choose a random line.

main :: IO ()
main = putStrLn =<< fortune . lines =<<
       readFile . head . (++ ["fortunes.txt"]) =<< getArgs

Four lines versus the 23 of the C version. Not bad.

Programming Praxis – Maximum Difference In An Array

April 1, 2011

In today’s Programming Praxis exercise, our goal is to find the maximum difference between two numbers in a list, with the condition that the higher number comes last. We need to write both a quadratic and a linear algorithm. Let’s get started, shall we?

Some imports:

import Data.List
import qualified Data.List.Key as K
import Data.Tuple.HT
import Test.QuickCheck

The quadratic number is a matter of finding the highest subsequent number for each number in the list and returning the pair with the greatest difference. The two reverse functions are needed since K.maximum unfortunately chooses the latter of the two elements when the comparison yields the same value.

maxDiffNaive :: (Enum a, Ord a, Num a) => [a] -> (a, a, a)
maxDiffNaive = K.maximum thd3 . reverse . map f . init . tails . zip [0..]
    where f xs = (i,j,hi-lo) where
                 (i,lo) = head xs
                 (j,hi) = K.maximum (subtract lo . snd) (reverse xs)

The linear version can be represented with a simple fold. The accumulator holds the current minimum value as well as the current maximum difference.

maxDiffSmart :: (Ord a, Num a, Enum a) => [a] -> (a, a, a)
maxDiffSmart = snd . (\(x:xs) -> foldl f (x,(0,0,0)) xs) . zip [0..]
    where f ((i',lo), (i,j,d)) (j',x) = (if x < lo then (j',x) else (i',lo),
              if x-lo > d then (i',j',x-lo) else (i,j,d))

Testing whether the two functions produce the same output can be easily automated using QuickCheck.

prop_maxDiff :: [Integer] -> Property
prop_maxDiff x = not (null x) ==> (maxDiffNaive x == maxDiffSmart x)

To test everything we use a combination of unit tests and QuickCheck.

main :: IO ()
main = do let test f = do print $ f [4,3,9,1,8,2,6,7,5] == (3,4,7)
                          print $ f [4,2,9,1,8,2,6,7,5] == (1,2,7)
                          print $ f [4,3,9,1,2,6,7,8,5] == (3,7,7)
                          print $ f [5,4,3] == (0,0,0)
                          print $ f [1,3,3] == (0,1,2)
          test maxDiffNaive
          test maxDiffSmart
          quickCheck prop_maxDiff

Everything seems to be working correctly.