Archive for March, 2013

Programming Praxis – One Million Hits

March 29, 2013

In today’s Programming Praxis exercise, our goal is to print the number 1000000 in a creative way. Let’s get started, shall we?

I decided on trying to derive the number from a piece of text. I fairly quickly settled on summing the products of the ASCII values of adjacent pairs of characters, since it’s compact code and if you end up in the neighbourhood of one million with a fairly small piece of text. The next step was to find a piece of text that would get me close enough to 1000000 so that only minimal tweaking would be needed. After trying a few dozen quotes about programming, I stumbled on the one below, which gets us to 999965, only 35 short of the target. Now of course we could just add 35 to the result and call it a day, but that didn’t strike me as very elegant; I wanted to avoid numeric literals. After several failed attempts trying to use the number of words, xor-ing all the ASCII values and bunch of others I looked at the difference between the values of the first and last character, which turned out to be 36. Jackpot. Add a pred and we have ourselves a solution.

main :: IO ()
main = print . pred $ sum (zipWith (*) q (tail q)) + head q - last q
    where q = map fromEnum "Real programmers don't comment their code, \
                           \if it was hard to write, it should be hard \
                           \to understand and harder to modify."
Advertisements

Programming Praxis – Jumping Jack

March 22, 2013

In today’s Programming Praxis exercise, our goal is to determine the smallest amount of sequential numbers (starting from 1) needed to sum up to a given value, using the fact that each term may be either positive or negative. Let’s get started, shall we?

import Data.List
import Text.Printf

We use the same algorithm as the provided solution and the Stackoverflow topic where this exercise originated: find the smallest sum larger than our target number that has the same parity modulo 2 and flip the sign of terms totalling half the difference.

jack :: Int -> [Int]
jack n = snd $ head
  [ mapAccumR (\r x -> if x <= r then (r-x,-x) else (r,x)) (div (t-n) 2) [1..i]
  | (i,t) <- scanl (\(_,s) x -> (x, s+x)) (0,0) [1..]
  , t >= abs n, mod (t+n) 2 == 0]

A test to see if everything is working properly:

main :: IO ()
main = mapM_ putStrLn [printf "%3d %2d  %s" n (length j) (show j)
                      | n <- [-24..24], let j = jack n]

Programming Praxis – Buffon’s Needle

March 15, 2013

In today’s Programming Praxis exercise, our goal is to approximate pi by using Georges-Louis Leclerc’s method of dropping needles on a board. Let’s get started, shall we?

import Control.Applicative
import System.Random

We’re going to be needing two sets of random numbers; one for the position and one for the angle of the needles. In order to save some code and to stop Haskell complaining about ambiguous types we make a function to generate an infinite amount of numbers in the [0,1) range.

rnds :: IO [Double]
rnds = fmap randoms newStdGen

We approximate pi by dividing the total amount of needles dropped by the number of needles that hit a line.

buffon :: Int -> IO Double
buffon n = (fromIntegral n /) . sum . take n <$>
    (zipWith (\y t -> if y < sin (t*pi/2) / 2 then 1 else 0) <$> rnds <*> rnds)

Running the simulation reveals that this isn’t a very practical way of approximating pi: after one million needles it generally only has two correct digits.

main :: IO ()
main = print =<< buffon 1000000

Programming Praxis – An Array Of Two Symbols

March 12, 2013

In today’s exercise, our goal is to write a function that, given a list consisting of m of one symbol followed by n of another symbol, returns the starting index of the second group of symbols in O(log m) time. Let’s get started, shall we?

import qualified Data.Vector as V
import Test.QuickCheck

The basis idea is simple: starting at the first element, keep doubling the index until we encounter a symbol from the second group or we run past the end of the array. Repeat the process, only now looking at the subarray from the last m to the first n (or the end of the array). When this array has only two values (by definition an m and an n), we’ve found our answer.

Unlike the provided solution, we don’t use a binary search once we’ve found our bounds. We already have one O(log m) test, so why bother writing another?

search :: V.Vector Char -> Int
search xs = f 0 (V.length xs - 1) where
    f start end = case span ((xs V.! 0 ==) . (xs V.!)) . takeWhile (<= end) .
                       map (start +) $ 0 : iterate (*2) 1
                  of   ([_],[n]) -> n
                       (ms ,[] ) -> f (last ms) end
                       (ms ,n:_) -> f (last ms) n

To test if everything is working correctly, we use a few manual tests and quickCheck for an automated one.

test :: Property
test = forAll (choose (1,100)) $ \i ->
       forAll (choose (1,100)) $ \j ->
       search (V.fromList $ replicate i 'm' ++ replicate j 'n') == i

main :: IO ()
main = do print $ search (V.fromList "mn") == 1
          print $ search (V.fromList "mmmnn") == 3
          print $ search (V.fromList "mmmmmmnnnnnnnnnnn") == 6
          quickCheck test

Programming Praxis – Knight Moves

March 8, 2013

In today’s Programming Praxis exercise, our goal is to list all the potential ways a knight on a chess board can get from one position to another. Let’s get started, shall we?

import Data.Ix

A knight can move to 8 positions, assuming they fit on the board. Each move is a combination of moving one square in one direction and two in the other.

moves :: (Int, Int) -> [(Int, Int)]
moves (x,y) = [(x+dx,y+dy) | [dx,dy] <- combos [[-1,1],[-2,2]]
              , inRange (1,8) (x+dx), inRange (1,8) (y+dy)]
              where combos xs = sequence xs ++ sequence (reverse xs)

To find the possible paths to the target square we simply generate all possible sequences of n moves and take the ones that end in the desired position.

paths :: (Int, Int) -> (Int, Int) -> Int -> [[(Int, Int)]]
paths from to n = map reverse . filter (\(x:_) -> x == to) $
                  iterate (>>= \(x:xs) -> map (:x:xs) $ moves x) [[from]] !! n

A test to see of everything is working properly:

main :: IO ()
main = mapM_ print $ paths (8,8) (1,1) 6

Programming Praxis – Dutch National Flag

March 5, 2013

In today’s Programming Praxis exercise, our goal is to implement a sorting algorithm for lists with three different elements that works in linear time. Let’s get started, shall we?

import qualified Data.Vector as V

We’re only allowed to use index and swap operations. Swap isn’t defined in the Vector package, but is easy to express as a bulk update.

swap :: Int -> Int -> V.Vector a -> V.Vector a
swap i j a = a V.// [(i,a V.! j), (j,a V.! i)]

To sort the array, we keep track of where the next red and blue elements should be inserted, as well as the current index. When encountering red and blue elements, they are shifted to the correct location. If the element was blue, we have to test again since it could be anything. If it was red, the element that’s swapped to the current location will always be white, so we can move on. Once we reach the start of the group of blue elements at the end we can stop.

flag :: V.Vector Char -> V.Vector Char
flag xs = f (0, V.length xs - 1) xs 0 where
  f (r,b) a n = if n > b then a else case a V.! n of
    'R' -> f (r+1,b  ) (swap n r a) (n+1)
    'B' -> f (r,  b-1) (swap n b a) n
    _   -> f (r,  b  ) a            (n+1)

Some tests to see if everything is working properly:

test :: String -> Bool
test x = flag (V.fromList x) == V.fromList
  (filter (== 'R') x ++ filter (== 'W') x ++ filter (== 'B') x)

main :: IO ()
main = do print $ test ""
          print $ test "W"
          print $ test "R"
          print $ test "B"
          print $ test "RWB"
          print $ test "BWR"
          print $ test "RWBR"
          print $ test "WRBRBRBWRWBWBRBWRBWRBWRBWBBBRBRWBRWB"