View source for Haskell Quiz/Tiling Turmoil/Solution Dolio

[[Category:Haskell Quiz solutions|Tiling Turmoil]]

For large board, guess and check won't work. The important thing to realize is the following:

* A 1x1 board is trivially filled by the random square.

* On an NxN board, divide the board into quadrants. One quadrant contains the filled square. In the others, place an L-tile covering the center-most square of each quadrant. Now all the quadrants are instances of the problem for N/2.

The following code implements such an algorithm. It uses a * for the random filled square, and uses the [[New monads/MonadRandom|random monad]] to pick upper case letters for each of the L-tiles (which hopefully makes it possible to see which tiles are where).

<haskell>
module Main where
import Data.Char
import System.Random
import System
import MonadRandom

type Point  = (Int, Int)
type Region = (Point, Point)

combine :: [String] -> [String] -> [String] -> [String] -> [String]
combine q1 q2 q3 q4 = zipWith (++) q1 q2 ++ zipWith (++) q3 q4

partition :: Region -> [Region]
partition ((x1,y1),(x2,y2))
    | x1 == x2 || y1 == y2 = error "No partition."
    | otherwise = [((x1,      y1),      (x1 + dx, y1 + dy)),
                   ((x2 - dx, y1),      (x2,      y1 + dy)),
                   ((x1,      y2 - dy), (x1 + dx, y2     )),
                   ((x2 - dx, y2 - dy), (x2,      y2     ))]
 where
 dx = (x2 - x1) `div` 2
 dy = (y2 - y1) `div` 2

ul, ll, ur, lr :: Region -> Point
ul ((x1,y1),(x2,y2)) = (x1,y1)
ll ((x1,y1),(x2,y2)) = (x1,y2)
ur ((x1,y1),(x2,y2)) = (x2,y1)
lr ((x1,y1),(x2,y2)) = (x2,y2)

on :: Point -> Region -> Bool
on (x,y) ((x1,y1),(x2,y2)) = x1 <= x && x <= x2 && y1 <= y && y <= y2

solve :: Char -> Point -> Region -> Rand StdGen [String]
solve c p r@(tl,br)
    | tl == br  = return . return . return $ if p == tl then c else '#'
    | otherwise = do d <- getRandomR ('A', 'Z')
                     q1' <- nq q1 (lr q1) d
                     q2' <- nq q2 (ll q2) d
                     q3' <- nq q3 (ur q3) d
                     q4' <- nq q4 (ul q4) d
                     return $ combine q1' q2' q3' q4'
 where [q1, q2, q3, q4] = partition r
       nq q p' d = if p `on` q then solve c p q else solve d p' q

main = do (n:_) <- fmap (map read) getArgs
          x <- randomRIO (0, 2^n-1)
          y <- randomRIO (0, 2^n-1)
          evalRandIO (solve '*' (x,y) ((0,0),(2^n-1,2^n-1))) >>= mapM_ putStrLn
</haskell>