# Haskell Quiz/Housie/Solution Dolio

< Haskell Quiz | Housie

Jump to navigation
Jump to search

This solution uses a two pronged approach to the problem. Naively generating and testing books is too slow. However, if one looks only at whether spaces are empty or filled, the search space is sufficiently small to generate random candidates and search for a valid result among them. This search results in a template for the book, which can then be filled in (with some additional constraint checking) to get the final result.

Since the algorithm involves randomly guessing candidate results, it's possible for it to take a very long time. However, in practice, results usually appear in a matter of seconds.

This code makes use of the random monad.

```
module Main where
import Control.Monad
import Data.List
import MonadRandom
-- Some handy datatypes and aliases
type Card a = [[a]]
type Book a = [Card a]
data Slot = Filled | Vacant deriving (Eq)
-- Some general functions
combinations :: [a] -> [a] -> [[a]]
combinations xs [] = [xs]
combinations [] ys = [ys]
combinations (x:xs) (y:ys) = map (x:) (combinations xs (y:ys))
++ map (y:) (combinations (x:xs) ys)
splitAtM :: MonadPlus m => Int -> [a] -> m ([a], [a])
splitAtM _ [] = mzero
splitAtM n xs = return $ splitAt n xs
select :: MonadRandom m => [a] -> m (a, [a])
select xs = do i <- getRandomR (0, length xs - 1)
let (f, x:l) = splitAt i xs
return (x, f ++ l)
stream :: MonadRandom m => [a] -> m [a]
stream rs = map (rs !!) `liftM` getRandomRs (0, length rs - 1)
slice :: Int -> [a] -> [[a]]
slice n x@(_:tx) = take n x : slice n tx
-- Some problem-specific functions
rowTemplates :: [[Slot]]
rowTemplates = combinations (replicate 5 Filled) (replicate 4 Vacant)
bounds :: [(Int, Int)]
bounds = zip (1: [10, 20 .. 80]) ([9, 19 .. 79] ++ [90])
validateCol :: [Int] -> Bool
validateCol c = nc == (nub . sort $ nc)
where nc = filter (> 0) c
-- For creating an entire book
bookTemplates :: MonadRandom m => [[Slot]] -> m [[[Slot]]]
bookTemplates rs = (filter validateBookTemplate . slice 18) `liftM` stream rs
validateBookTemplate :: [[Slot]] -> Bool
validateBookTemplate b = and $ zipWith (==) fls bls
where
fls = map (length . filter (== Filled)) . transpose $ b
bls = map (length . uncurry enumFromTo) bounds
fillBook :: MonadRandom m => [[Slot]] -> m (Book Int)
fillBook bt = liftM (unfoldr (splitAtM 3) . transpose)
. mapM fill . zip bounds . transpose $ bt
where
fill (b,c) = do c' <- f (uncurry enumFromTo b) c
if all validateCol (unfoldr (splitAtM 3) c')
then return c'
else fill (b, c)
f _ [] = return []
f b (Vacant:xs) = liftM (0:) (f b xs)
f b (Filled:xs) = do (r, b') <- select b
liftM (r:) (f b' xs)
-- For output
intercalate s = concat . intersperse s
showCard = unlines . map (intercalate "|") . map (map showN)
where
showN n
| n == 0 = " "
| n < 10 = " " ++ show n
| otherwise = show n
showBook = intercalate "\n" . map showCard
main = bookTemplates rowTemplates >>= fillBook . head
>>= putStrLn . showBook
```