Haskell Quiz/Grid Folding/Solution Kuklewicz
< Haskell Quiz | Grid Folding
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
-- 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))