puzzle

2011[2].hs

module Main where

import Data.Ratio
import Data.Tree

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

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

label1, label2, label3, label4 :: Label
label1 = Label (+7) (const False) (/2) 0 ["+7", "/2"]
label2 = Label (/2) (const False) (+7) 0 ["/2", "+7"]
label3 = Label (subtract 5) (== 2012)     (*3) 0 ["-5", "*3"]
label4 = Label (*3) (== 2012)     (/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 -> Forest Label
travel (Node l sub) = map rootLabel $
                      concat $ takeWhile (not . null) $
                      iterate (concatMap (subForest)) [t]