puzzle

2011-2012.hs

module Main where

import Data.Ratio
import Data.Tree

data Label = Label
  { f1     :: (Rational -> Rational)
  , accept :: Bool
  , f2     :: (Rational -> Rational)
  , value  :: Rational
  , disp   :: [String]
  }

initial = Node (Label (const 2011) False (const 2011) 2011 [""])
               [ Node (Label (const 2011) False (+7) 0 ["+7"]) center1
               ]

label1, label2, label3, label4 :: Label
label1 = Label (+7)         False (/2)          0 ["+7", "/2"]
label2 = Label (/2)         False (+7)          0 ["/2", "+7"]
label3 = Label (subtract 5) True  (*3)          0 ["-5", "*3"]
label4 = Label (*3)         True  (subtract 5) 0 ["*3", "-5"]

tree1, tree2, tree3, tree4 :: Tree Label
tree1 = Node label1 center2
tree2 = Node label2 center1
tree3 = Node label3 center4
tree4 = Node label4 center3

center1, center2, center3, center4 :: Forest Label
center1 = [ tree3, tree4, tree2 ]
center2 = [ tree3, tree4, tree1 ]
center3 = [ tree4, tree1, tree2 ]
center4 = [ tree3, tree1, tree2 ]

travel :: Tree Label -> [Label]
travel t = map rootLabel $
                      concat $ takeWhile (not . null) $
                      iterate (\ts -> concat $ map step ts) [t]

step :: Tree Label -> Forest Label
step (Node l sub) = map update sub
  where
    update (Node l' sub') = Node l'{ accept = (accept l') && ((f1 l') v == 2012)
                                   , value = ((f2 l').(f1 l')) v, disp = disp l ++ disp l'} sub'
    v = value l

main = (print . (\l -> concat (disp l) ++ " = " ++ show (value l))) $ head $ filter accept $ travel initial