Haskell Quiz/Housie/Solution Dolio
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] ++ ) 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