Archive for January, 2011

Programming Praxis – Population Count

January 28, 2011

In today’s Programming Praxis, our task is to count the active bits in a number. Let’s get started, shall we?

Some imports:

import Data.Bits
import Data.Word
import qualified Data.IntMap as I

We’ll be implementing three different versions. The first is the trivial naive one: go through all the bits and count how many are active. It works for positive and negative numbers of 32 bits or less.

popCount1 :: Bits a => a -> Int
popCount1 n = length $ filter (testBit n) [0..31]

Next is Wegner’s algorithm, which works best on sparse bit strings. It works on positive and negative numbers of any length.

popCount2 :: Bits a => a -> Int
popCount2 = length . takeWhile (/= 0) . iterate (\n -> n .&. (n - 1))

Finally, there’s the lookup table version, which is faster on large numbers. Unfortunately, it doesn’t handle negative numbers.

popCount3 :: (Integral a, Bits a) => Int -> a -> Int
popCount3 k = sum . map ((ps I.!) . fromIntegral . (.&. (2^k - 1))) .
              takeWhile (/= 0) . iterate (\n -> shiftR n k) where
     ps = I.fromList $ map (\i -> (i, popCount2 i)) [0..2^k - 1]

Some unit tests to see if everything is working properly:

main :: IO ()
main = do print $ popCount1 (23 :: Int) == 4
          print $ popCount1 (-4 :: Int) == 30
          print $ popCount1 (5 :: Word8) == 2

          print $ popCount2 (23 :: Int) == 4
          print $ popCount2 (-4 :: Int) == 30
          print $ popCount2 (5 :: Word8) == 2
          print $ popCount2 (2^200000 - 1 :: Integer) == 200000

          print $ popCount3 1 (23 :: Int) == 4
          print $ popCount3 8 (5 :: Word8) == 2
          print $ popCount3 16 (2^200000 - 1 :: Integer) == 200000

Yep. Though unless you’re going to be working with very large numbers I’d recommend using the second version.

Programming Praxis – Rational Numbers

January 25, 2011

In today’s Programming Praxis exercise, our goal is to implement common operations on rational numbers. Let’s get started, shall we?

We could of course just use the Data.Ratio module, which does everything we need, but that kind of defeats the purpose of the exercise.

Creating a rational number isn’t too difficult, but if you condense the various cases into a single expression like I did here you need to take care to get the signs right. Fortunately, that’s what unit testing is for. I’m using plain tuples here for the sake of brevity. In production it would be advisable to use a data type instead to prevent passing in invalid rationals such as (1,0).

ratio :: Integral a => a -> a -> (a, a)
ratio _ 0 = error "Division by zero"
ratio n d = (signum d * div n g, abs $ div d g) where g = gcd n d

For adding we use the given formula. Subtracting is the same as adding the negative of the second number.

plus :: Integral a => (a, a) -> (a, a) -> (a, a)
plus (nx, dx) (ny, dy) = ratio (nx * dy + dx * ny) (dx * dy)

minus :: Integral a => (a, a) -> (a, a) -> (a, a)
minus x (ny, dy) = plus x (-ny, dy)

Multiplication didn’t pass the unit tests at first. Turns out the formula in the Scheme solution is wrong, so I replaced it with the correct one. Division is just multiplying by the inverse of the second number.

times :: Integral a => (a, a) -> (a, a) -> (a, a)
times (nx, dx) (ny, dy) = ratio (nx * ny) (dx * dy)

divide :: Integral a => (a, a) -> (a, a) -> (a, a)
divide x (ny, dy) = times x (dy, ny)

Finally, there’s the comparison operator.

lessThan :: Integral a => (a, a) -> (a, a) -> Bool
lessThan (nx, dx) (ny, dy) = nx * dy < dx * ny

I used a decent number of unit tests to cover all of the potentially problematic cases.

main :: IO ()
main = do print $ ratio 1 2           == (1,2)
          print $ ratio 1 (-2)        == (-1,2)
          print $ ratio (-1) 2        == (-1,2)
          print $ ratio (-1) (-2)     == (1,2)
          print $ ratio 2 4           == (1,2)
          print $ plus (1,2) (-1,6)   == (1,3)
          print $ minus (1,2) (1,6)   == (1,3)
          print $ times (3,5) (5,3)   == (1,1)
          print $ times (2,5) (3,7)   == (6,35)
          print $ times (2,5) (-3,7)  == (-6,35)
          print $ divide (3,4) (3,2)  == (1,2)
          print $ divide (1,3) (-2,3) == (-1,2)
          print $ lessThan (1,3) (1,2)
          print $ lessThan (-1,2) (1,6)
          print $ lessThan (-1,2) (-1,6)

Everything passes, so it looks like things are working correctly.

Programming Praxis – Slots

January 14, 2011

In today’s Programming Praxis exercise, our goal is to create a game that simulates a slot machine. Let’s get started, shall we?

Some imports:

import Control.Monad
import Data.List
import System.Random
import Text.Printf
import Text.Read.HT

Pulling the lever spins the wheels, prints the result and returns the amount of money gained or lost.

pull :: Int -> IO Int
pull n = do ws <- replicateM 3 $ randomRIO (0,5)
            putStrLn . unwords $ map (wheel !!) ws
            result . group $ sort ws where
    wheel = words "BAR BELL ORANGE LEMON PLUM CHERRY"                
    result [[0,0,0]] = win "JACKPOT" 101
    result [_]       = win "TOP DOLLAR" 11
    result [[0,0],_] = win "DOUBLE BAR" 6
    result [_,_]     = win "DOUBLE" 3
    result _         = printf "YOU LOSE $%d\n" n >> return (-n)
    win msg d = printf "***%s***\nYOU WIN $%d\n" msg (n*d) >> return (n*d)

In order not to have to repeat ourselves in the main loop, we create a function that gets a valid bet.

prompt :: IO Int
prompt = do putStr "ENTER YOUR BET: "
            maybe prompt check . maybeRead =<< getLine where
    check bet | bet < 0   = prompt
              | bet > 100 = putStrLn "HOUSE LIMIT $100" >> prompt
              | otherwise = return bet

Playing the game shows the instructions and starts playing. After every pull of the lever, the current balance is shown. Quitting the game (by betting $0) prints the final balance.

main :: IO ()
main = instructions >> loop 0 where
    instructions = putStrLn "WELCOME TO THE CASINO\n\
        \BET IN INCREMENTS OF $1 FROM $1 TO $100\n\
        \BET $0 WHEN YOU ARE FINISHED"
    loop purse = prompt >>= \bet -> if bet == 0 then quit purse
        else fmap (+ purse) (pull bet) >>= \n -> status n >> loop n
    status n | n > 0     = printf "YOU HAVE $%d\n" n
             | n < 0     = printf "YOU OWE $%d\n" (-n)
             | otherwise = putStrLn "YOU ARE EVEN"
    quit total | total > 0 = printf "COLLECT $%d FROM THE CASHIER\n" total
               | total < 0 = printf "PLACE $%d ON THE KEYBOARD\n" (-total)
               | otherwise = putStrLn "YOU BROKE EVEN"

Here’s a sample game:

WELCOME TO THE CASINO
BET IN INCREMENTS OF $1 FROM $1 TO $100
BET $0 WHEN YOU ARE FINISHED
ENTER YOUR BET: 100
LEMON BELL BELL
***DOUBLE***
YOU WIN $300
YOU HAVE $300
ENTER YOUR BET: 100
BAR ORANGE PLUM
YOU LOSE $100
YOU HAVE $200
ENTER YOUR BET: 100
BELL PLUM BELL
***DOUBLE***
YOU WIN $300
YOU HAVE $500
ENTER YOUR BET: 100
BAR CHERRY BAR
***DOUBLE BAR***
YOU WIN $600
YOU HAVE $1100
ENTER YOUR BET: 0
COLLECT $1100 FROM THE CASHIER

If only real slot machines were this profitable 🙂

Programming Praxis – Two Integrals

January 11, 2011

In today’s Programming Praxis exercise, our task is to write functions to calculate the exponential and logarithmic integrals. Let’s get started, shall we?

The exponential integral is just executable math, with the only addition being a limit on the infinite sum.

ei :: Double -> Double
ei x = 0.5772156649015328606065 + log x +
       sum (takeWhile (> 1e-17) [x**k / k / product [1..k] | k <- [1..]])

The two logarithmic integrals can be expressed in terms of the exponential one, so they become trivial to implement.

li :: Double -> Double
li = ei . log

liOffset :: Double -> Double
liOffset x = li x - li 2

A test to see if everything works properly:

main :: IO ()
main = print . round $ liOffset 1e21

We get a result of 21127269486616088576, which starts to deviate from the mathematically correct solution at the 15th digit; close enough.

Programming Praxis – Dijkstra’s Algorithm

January 4, 2011

In today’s Programming Praxis, our task is to implement Dijkstra’s shortest path algorithm. Let’s get started, shall we?

Some imports:

import Data.List
import qualified Data.List.Key as K
import Data.Map ((!), fromList, fromListWith, adjust, keys, Map)

In order make the rest of the algorithm simpler, we convert the list of edges to a map that lists all the neighbors of each vertex.

buildGraph :: Ord a => [(a, a, Float)] -> Map a [(a, Float)]
buildGraph g = fromListWith (++) $ g >>=
               \(a,b,d) -> [(a,[(b,d)]), (b,[(a,d)])]

The algorithm follows the usual steps, albeit in a functional rather than the typical procedural style: start by giving all non-source vertices an infinite distance, then go through all the vertices in order of their distance from the source, relaxing all their neighbors.

dijkstra :: Ord a => a -> Map a [(a, Float)] -> Map a (Float, Maybe a)
dijkstra source graph =
    f (fromList [(v, (if v == source then 0 else 1/0, Nothing)) 
                | v <- keys graph]) (keys graph) where
    f ds [] = ds
    f ds q  = f (foldr relax ds $ graph ! m) (delete m q) where
              m = K.minimum (fst . (ds !)) q
              relax (e,d) = adjust (min (fst (ds ! m) + d, Just m)) e

Getting the shortest path is then simply a matter of tracing the path from the endpoint to the beginning.

shortestPath :: Ord a => a -> a -> Map a [(a, Float)] -> [a]
shortestPath from to graph = reverse $ f to where
    f x = x : maybe [] f (snd $ dijkstra from graph ! x)

A test to see if everything is working properly:

main :: IO ()
main = do let g = buildGraph [('a','c',2), ('a','d',6), ('b','a',3)
                             ,('b','d',8), ('c','d',7), ('c','e',5)
                             ,('d','e',10)]
          print $ shortestPath 'a' 'e' g == "ace"

As expected, the shortest route for the given graph is A-C-E.