-- 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))