# Haskell Quiz/Grid Folding/Solution Kuklewicz

### From HaskellWiki

< Haskell Quiz | Grid Folding

Revision as of 22:14, 27 October 2006 by ChrisKuklewicz (Talk | contribs)

-- Solution by Chris Kuklewicz <haskell@list.mightyreason.com> -- Posted at http://haskell.org/haskellwiki/Haskell_Quiz/Grid_Folding -- Original puzzle http://www.rubyquiz.com/quiz63.html -- Usage : -- myFold 2 "RB" -- myFold 16 "TBLRTBLR" -- -- This works not by bulding the whole [1..size*size] data structure -- and manipulating it, but by building a description of which -- oriented subsets of the paper (of type Bound) are above each other. -- -- The 'f' function uses the cut operation to split a Bound into two -- parts which 'f' then re-arranges (using swap), returning them in -- (above,below) order. The order of the new stack is created and -- maintained by using f_around and do_op. -- -- At the end of the operations each Bound should specify a single -- location, which is checked by decode. module Main(myFold) where import Data.List(foldl') type Bound = ((Int,Int),(Int,Int)) myFold :: Int -> [Char] -> [Int] myFold size ops = map decode (foldl' do_op wholePaper ops) where do_op bs op = foldl' f_around id bs $ [] where f_around acc b = let (above,below) = f op b in (above:) . acc . (below:) wholePaper = [((0,pred size),(0,pred size))] decode ((r1,r2),(c1,c2)) | r1 /= r2 || c1 /= c2 = error "Not enough folds" | otherwise = 1+size*r1+c1 f :: Char -> Bound -> (Bound,Bound) f op (rs,cs) = let (r1,r2) = cut rs (c1,c2) = cut cs in case op of 'T' -> ((swap r1,cs),(r2,cs)) 'B' -> ((swap r2,cs),(r1,cs)) 'L' -> ((rs,swap c1),(rs,c2)) 'R' -> ((rs,swap c2),(rs,c1)) _ -> error $ op:" is an unknown character" where swap (x,y) = (y,x) cut (x,y) | x == y = error $ op:" Cannot fold again" | otherwise = let l = (x + y - 1) `div` 2 h = (x + y + 1) `div` 2 in if x < y then ((x,l),(h,y)) else ((x,h),(l,y))