Solve Ball Clock Puzzle in Python and Haskell

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.