Re: [Haskell-cafe] A practical Haskell puzzle

From: Yitzchak Gale

To: haskell-cafe@haskell.org Cc: Heinrich Apfelmus ; Lennart Augustsson Sent: Wed, March 2, 2011 9:45:15 AM Subject: Re: [Haskell-cafe] A practical Haskell puzzle

Thanks to everyone for the nice solutions to this puzzle, here and on reddit:

http://www.reddit.com/r/haskell/comments/fu6el/a_practical_haskell_puzzle/

It seems nobody has provided a simple H98 solution. I misread your question as asking for the composition of arbitrary type-compatible subsets of the layers, like

runCompose [1,7,4,3] input

if it happens fun1 . fun7 . fun4 . fun3 is well typed. This is not easy to do without Dynamic. Now I see you just want contiguous layers, which is easy enough in H98. This code produces and uses a table of all allowed combinations. I think this makes it easier to understand why the code works (and is H98). It's just as easy to make a direct version that produces one requested composition in linear time, so I haven't worried whether lazy evaluation of this table works nicely. \begin{code} runLayers :: Int -> Int -> String -> String runLayers n m = (table !! (n-1)) !! (m-n) table :: [[String -> String]] table = close (extend fun1 (extend fun2 (extend fun3 (extend fun4 seed)))) \end{code} Here are some examples with this sequence of layers and transformations (exact type definition and function definitions at the end of the message). Layer1: (Int,Int) --(uncurry(+))--> Layer2: Int --(\x -> if even x then Left x else Right x)--> Layer3: Either Int Int --(either (2*) negate)--> Layer4: Int --(`quotRem`14)--> Layer5: (Int,Int) *Main> read (runLayers 2 4 (show (Layer2 "X" 12))) :: Layer4 Layer4 "fun3(fun2(X))" 24 *Main> read (runLayers 4 5 (show (Layer4 "Y" 15))) :: Layer5 Layer5 "fun4(Y)" (1,1) *Main> read (runLayers 1 5 (show (Layer1 "fullStack" (5,6)))) :: Layer5 Layer5 "fun4(fun3(fun2(fun1(fullStack))))" (0,-11) The table also include trivial slices, which might be useful to check the serialization: *Main> read (runLayers 3 3 "(Layer3 \"X\" (Left (12)))") :: Layer3 Layer3 "X" (Left 12) The key observation is that if all compositions of functions are followed by the appropriate initialization function, then all the functions starting at the same layer have the same type. With four layers, show . show . fun34 show . fun45 . fun34 all have type Layer3 -> String The table construction uses a type \begin{code} data Layered a = Layered [a -> String] [[String -> String]] \end{code} which stores all sequences beginning at layer "a" with the uniform type [a -> String], and already has all strictly later sequences in the table [[String->String]]. A partial sequences can be extended by precomposing another function, or converted to the unform type by precomposing the deserialization function. To ensure only one type parameter is exposed at a time, the extend function combines both steps. \begin{code} extend :: (Show a, Read b) => (a -> b) -> Layered b -> Layered a extend f (Layered gs tails) = Layered (show:[g . f | g <- gs]) ([g . read | g <- gs]:tails) \end{code} The final step just closes partial sequences to produce one table, and the seed is a trivial table. \begin{code} close :: (Read a) => Layered a -> [[String -> String]] close (Layered fs tails) = [f . read | f <- fs]:tails seed :: (Show a) => Layered a seed = Layered [show] [] \end{code} Exact definition of the layer types. \begin{code} data Layer1 = Layer1 String (Int,Int) deriving (Read, Show) data Layer2 = Layer2 String Int deriving (Read, Show) data Layer3 = Layer3 String (Either Int Int) deriving (Read, Show) data Layer4 = Layer4 String Int deriving (Read, Show) data Layer5 = Layer5 String (Int,Int) deriving (Read, Show) \end{code} \begin{code} fun1 (Layer1 s x) = Layer2 ("fun1("++s++")") (uncurry (+) x) fun2 (Layer2 s x) = Layer3 ("fun2("++s++")") (if even x then Left x else Right x) fun3 (Layer3 s x) = Layer4 ("fun3("++s++")") (either (2*) negate x) fun4 (Layer4 s x) = Layer5 ("fun4("++s++")") (x `quotRem` 14) \end{code}