Let's solve the Ball Clock puzzle. After reading the puzzle, I spend some time thinking about it. I quickly find that instead of running the full simulation until the clock returns to its original state, I can reuse the result of first 12 hour. What can we do to the first 12 hour result? We can build a table that tell which ball goes to which position after another 12 hour circle. Now we can run the simulation at 12 hour circle, more fast. But wait, can we do better? After some thinking, I finally find that actually We can find every ball's own circle (How many days does a ball return to its original position) and we get a list of circles. What's next? Right, find the Least Common Multiplier of all balls' circles. So here we have the Python version:

`def run_12h(balls):`

hour = []

five_min = []

min = []

for i in xrange(12*60):

ball, balls = balls[0], balls[1:]

if len(min) < 4:

min.append(ball)

else:

min.reverse()

balls.extend(min)

min = []

if len(five_min) < 11:

five_min.append(ball)

else:

five_min.reverse()

balls.extend(five_min)

five_min = []

if len(hour) < 11:

hour.append(ball)

else:

hour.reverse()

balls.extend(hour)

hour = []

balls.append(ball)

return balls

def shift_table(balls):

table = balls[:]

for i, ball in enumerate(balls):

table[ball] = i

return table

def circle(table):

def lookup(i):

old = i

count = 1

while(table[old] != i):

count += 1

old = table[old]

return count

return map(lookup, range(len(table)))

def gcd(x, y):

if y == 0:

return x

else:

return gcd(y, x % y)

def lcm(x, y):

return x*y/gcd(x,y)

def solve(n):

return reduce(lcm, circle(shift_table(run_12h(range(n)))))/2

if __name__ == '__main__':

print map(solve, range(27, 128))

It takes me about five minutes to hack the above Python code. As you may note, it is heavily influenced by the FP style. As a consequence, it gave me the correct answer the first time I run it:) I think the code is quite straight forward, So I just give some brief explanation. The `run_12h` function takes a ball clock and run it through 12 hour and then return the state. The `shift_table` function takes a state and builds a lookup table. (eg. The state tells us the 9th ball goes to 1 position, the 11th ball goes to 2 position, but what we really want is where does the 1st ball go, where does the 2nd ball go. It is just a *reverse* table of the state) The `circle` function takes a table and return a list of circles.

Now let's see my first Haskell program. I planed to translation the Python code to Haskell function by function. So let's start from the easy one.

`shiftTable :: [Int] -> Array Int Int`

shiftTable pattern = array (0, length pattern - 1) (zip pattern [0..])

circle :: (Num t, Ix i) => i -> Array i i -> t

circle i table = snd $ until ((i==) . (table!) . fst) ((table!) *** (+1)) (i, 1)

The `circle` function deserves some notes. At first, I wrote it using recursion. Then I find that the control structure is much the same as the buildin `until` function. But what I really want is how many times the function applies. After a day's thinking, I find that I can use a pair. And at first I wrote the function as a lambda: `\(i, n) -> (table ! i, n + 1)`. It has two problems: too long and not point free. As usual, I put `pl \(i, n) -> (table ! i, n + 1)` to lambdabot and expect some interesting result. The little cute bot never let me down: `(table !) *** (1 +)`. But the result make me both happy and sad. Happy for it was beautiful and a little shorter and sad for it use Arrow! Oh, my god! I met Arrow when I read about Functional Reactive Programming, but I didn't quite understand it at that time. The only thing I knew is that Arrow is a more generalized computation model than monad. As I even don't quite understand monad, so... But I say to my self, it's time to try again. After some googling, I encounter Playing with Arrows. It is about using Arrow in pure code. After reading this, I know that actually the `->` is made an instance of Arrow (Why not? at least the it looks like:), so every function in Haskell is an arrow. And finally I understand why Arrow is a generalized monad, because it can combine computation in a nonlinear way! So I learned a lot on the way:)

Then comes the hardest part. The `run_12h` function. I spend about three hours trying to translate the Python function into Haskell and finally I gave up. It's too ugly:(. Then another two hours, I came up with the following code:

`data BC = BC {track::[Int], hour::[Int], fiveMin::[Int], min::[Int]} deriving Show`

runMinute :: BC -> BC

runMinute (BC track h fm min) = let newTrack = tail track

ball = head track in

if length min < 4 then

BC newTrack h fm (ball:min)

else adjustFiveMin (BC (newTrack ++ min) h fm []) ball

adjustHour :: BC -> Int -> BC

adjustHour (BC t h _ _) ball = if length h < 11 then

BC t (ball:h) [] []

else BC (t ++ h ++ [ball]) [] [] []

adjustFiveMin :: BC -> Int -> BC

adjustFiveMin (BC t h fm _) ball = if length fm < 11 then

BC t h (ball:fm) []

else adjustHour (BC (t ++ fm) h [] []) ball

run12Hour :: Int -> [Int]

run12Hour n = track $ foldr ($) (BC [0..n-1] [] [] []) (replicate (12 * 60) runMinute)

Although not quite beautiful, I can't find better ways. Any ideas?

OK, the final part, We almost succeed!

`solve :: Int -> Int`

solve n = foldl1' lcm (map ((flip circle) . shiftTable . run12Hour $ n) [0..n-1]) `div` 2

That's it, but we are not at the end. Here comes a second question: If given a Ball Clock, can you tell at least how many minutes has passed? Think a moment. The solution is first run the clock to the nearest 12 hour, then use the result to find how many days have passed. Finally substract the minutes and you got the answer.

Until now, I realize that it's much easier to extend the Haskell version to solve the second question. I must say that I didn't intend to. (I even didn't know the second question when I wrote the program) It *really really really* is that Haskell force you think carefully at every step you solving the problem and makes it quite hard to write ugly code! Though learning Haskell does take some effort so as writing programs in Haskell, but now I'm quite convinced that "Learning Haskell at least makes you a better programmer in any other languages!".

Let's solve the second question then.

`circle' :: (Num t, Ix i) => i -> i -> Array i i -> t`

circle' start stop table = snd $ until ((stop==) . (table!) . fst) ((table!) *** (+1)) (start, 1)

runTo12 :: BC -> (BC, Int)

runTo12 bc = until (is12 . fst) (runMinute *** (+1)) (bc, 0) where

is12 (BC _ [] [] []) = True

is12 (BC _ _ _ _) = False

howManyMin :: BC -> Int

howManyMin bc = let (target, min) = first (elems . shiftTable . track) $ runTo12 bc

table = shiftTable $ run12Hour $ length target in

(foldl1' lcm $ map ($table) $ zipWith circle' [0..] target) * 12 * 60 - min

As a plus, we can redefine `circle` and `solve` in a much simpler way:

`circle1 :: (Num t, Ix i) => i -> Array i i -> t`

circle1 i table = circle' i i table

solve1 :: Int -> Int

solve1 n = (howManyMin $ BC [0..n-1] [] [] []) `div` (24 * 60)

That's the end. I must tell that it takes me quite a bit time to write this, because I just start to blog and English is not my native. So, any feedback is greatly appreciated.

## 4 comments:

If there was an untilM :: (Monad m) => (a -> m Bool) -> (a -> m a) -> a -> m a

function I would write circle like:

counting :: (Num n, MonadWriter (Sum n) m) => (a -> b) -> a -> m b

counting f a = tell (Sum 1) >> (return (f a))

circle :: (Num t, Ix i) => i -> Array i i -> t

circle i table = getSum . snd . runWriter $ untilM (return . (i ==) . (table!))

(counting (table!)) i

I tried to improve on the parts of the post you said you weren't so happy with. The biggest improvement I got was by using guards instead of if/then/else. Adding a Ball type helps make the function type signatures more meaningful, I think. I also used the field labels a bit more, but I don't think that really made as much of a difference in readibility as I'd hoped:

import Prelude hiding(min)

import Control.Arrow

import Data.List

import Array

type Ball = Int

data BC = BC {track, hour, fiveMin, min::[Ball]} deriving Show

runMinute :: BC -> BC

runMinute bc@(BC {track=(ball:rest), min=m})

| length m < 4 = bc {track=rest, min=(ball:m)}

| otherwise = adjustFiveMin (bc {track=(rest++m),min=[]}) ball

adjustHour :: BC -> Ball -> BC

adjustHour bc@(BC {track=t, hour=h}) ball

| length h < 11 = bc {hour=(ball:h)}

| otherwise = bc {track=(t ++ h ++ [ball]), hour=[]}

adjustFiveMin :: BC -> Ball -> BC

adjustFiveMin bc@(BC {track = t, fiveMin = fm}) ball

| length fm < 11 = bc {fiveMin = (ball:fm)}

| otherwise = adjustHour bc {track = (t++fm), fiveMin=[]} ball

run12Hour :: Int -> [Ball]

run12Hour n = track $ foldr1 (.) (replicate (12*60) runMinute) (BC [0..n-1] [] [] [])

I started playing around with making BC an instance of Enum, but without a predefined value for the total number of balls, it was pretty clumsy. I originally started out using an infinite track. It worked fine, but it didn't really turn out to be all that interesting.

numBalls = 27

bcToEnum :: Int -> BC

bcToEnum 0 = BC [0..numBalls] [] [] []

bcToEnum n = runMinute (bcToEnum (n-1))

bcFromEnum :: BC -> Int

bcFromEnum (BC t h fm m) = 60*(length h) + 5*(length fm) + length m

bcEnumFrom :: BC -> [BC]

bcEnumFrom = iterate runMinute

instance Enum BC where

succ = runMinute

toEnum = bcToEnum

fromEnum = bcFromEnum

enumFrom = bcEnumFrom

vineet, I'd use pattern matching and guard more often, thx.

logan capaldo, I'll play more with monad, or maybe learn some category theory...(actually I've read some, but my math is quite poor...)

very popular to u! ........................................

Post a Comment