Haskell Quiz/Tiling Turmoil/Solution Dolio
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 random monad to pick upper case letters for each of the L-tiles (which hopefully makes it possible to see which tiles are where).
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