1  module Main where
   2  
   3  import Data.Set(Set,fromList,toList,union,member)
   4  import Control.Monad(forM_)
   5  import Data.Ord(comparing)
   6  import Data.Bits(bit,(.|.))
   7  import List(groupBy,sortBy)
   8  
   9  -- A direction, two ways to turn, and a way to move.
  10  -- In this world, positive x is to the east and positive y is to the south.
  11  
  12  -- Order is important. See fromEnum below.
  13  data Direction = North | South | West | East | End
  14                     deriving (Eq, Show, Ord, Enum)
  15  
  16  right North = East
  17  right East = South
  18  right South = West
  19  right West = North
  20  right End = End
  21  
  22  rev  = right . right
  23  left = right . rev
  24  
  25  move (x, y) North = (x, y - 1)
  26  move (x, y) East  = (x + 1, y)
  27  move (x, y) South = (x, y + 1)
  28  move (x, y) West  = (x - 1, y)
  29  
  30  -- A coordinate in the maze
  31  
  32  type Coord = (Int, Int)
  33  
  34  -- A set of directions gives us the doors of the room
  35  
  36  type Doors = Set Direction
  37  
  38  encDoorBit :: Int -> Char
  39  encDoorBit d = (['0' .. '9'] ++ ['a' .. 'f']) !! d
  40  
  41  doorsToChar :: Doors -> Char
  42  doorsToChar s = encDoorBit $ foldl1 (.|.) $ map (bit . fromEnum) (toList s)
  43  
  44  -- A room is a coordinate and some doors
  45  
  46  type Room = (Coord, Doors)
  47  
  48  room :: Coord -> Direction -> Direction -> Room
  49  room c d1 d2 = (c, fromList [d1, d2])
  50  
  51  roomX :: Room -> Int
  52  roomX ((x, _), _) = x
  53  
  54  roomDoors :: Room -> Doors
  55  roomDoors (_, d) = d
  56  
  57  -- Sort top-left to bottom-right
  58  
  59  sortRooms :: [Room] -> [Room]
  60  sortRooms = sortBy $ comparing (swap . fst) where
  61                swap (a, b) = (b, a)
  62  
  63  -- Take in a starting coordinate, entering direction, current direction,
  64  -- and a list of steps ("W" for walk to next room, "R" for turn right in
  65  -- place, "L" for turn left in place, and "Z" for the ending room).
  66  -- Return a list of rooms as they are encountered.
  67  
  68  walk :: Coord -> Direction -> Direction -> [Char] -> [Room]
  69  walk c e d []        = room c (rev e) End : []
  70  walk c e d ('W' : t) = room c (rev e) d   : walk (move c d) d d t
  71  walk c e d ('R' : t) =                      walk c e (right d) t
  72  walk c e d ('L' : t) =                      walk c e (left d) t
  73  walk c e d ('Z' : t) = room c (rev e) End : walk c End d t
  74  
  75  -- Take a path that contains coordinates and door directions and
  76  -- compress it to a single list where each coordinate exists only
  77  -- once, the start and end rooms don't exist at all, and each
  78  -- maze room has all doors associated with it.
  79  
  80  compress :: [Room] -> [Room]
  81  compress l = filter notEnd $ map combine $ groupBy firsts $ sortRooms l where
  82                 firsts x y = (fst x) == (fst y)
  83                 appSnd f (a, b) (c, d) | a == c = (a, f b d)
  84                 combine = foldl1 (appSnd union)
  85                 notEnd (c, s) = not $ member End s
  86  
  87  -- Take a list of rooms and return a two-dimensional
  88  -- list that lays that grid out so the rooms exist in
  89  -- the proper 2d location in the grid.
  90  
  91  layout :: [Room] -> [[Doors]]
  92  layout l = map (map roomDoors) $ every (width l) $ sortRooms l where
  93               xs      = map roomX
  94               width l = (maximum $ xs l) - (minimum $ xs l) + 1
  95               every n = takeWhile (not . null) . map (take n) . iterate (drop n)
  96  
  97  -- Take in the strings representing the path through a maze, like
  98  --
  99  --   solve "WW" "WW"
 100  --
 101  -- Return the maze as a multiline string with characters representing
 102  -- which sides of each room are doors.
 103  
 104  solve :: String -> String -> String
 105  solve f r = let path = walk (0, 0) End South (f ++ "ZRR" ++ r)
 106              in unlines $ map (map doorsToChar) $ layout $ compress $ path
 107  
 108  -- Main - read the paths from stdin and print the mazes to stdout.
 109  
 110  main = do t <- getLine
 111            forM_ [1..(read t)] (\n -> do
 112              l <- getLine
 113              let (there : back : []) = words l
 114              putStrLn $ "Case #" ++ show n ++ ":"
 115              putStr $ solve there back)