99 questions/Solutions/99

From HaskellWiki
Jump to navigation Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.

Given an empty (or almost empty) framework of a crossword puzzle and a set of words. The problem is to place the words into the framework.

p99.gif

The particular crossword puzzle is specified in a text file which first lists the words (one word per line) in an arbitrary order. Then, after an empty line, the crossword framework is defined. In this framework specification, an empty character location is represented by a dot (.). In order to make the solution easier, character locations can also contain predefined character values. The puzzle above is defined in the file p99a.dat, other examples are p99b.dat and p99d.dat. There is also an example of a puzzle (p99c.dat) which does not have a solution.

Words are strings (character lists) of at least two characters. A horizontal or vertical sequence of character places in the crossword puzzle framework is called a site. Our problem is to find a compatible way of placing words onto sites.

Hints: (1) The problem is not easy. You will need some time to thoroughly understand it. So, don't give up too early! And remember that the objective is a clean solution, not just a quick-and-dirty hack!

(2) Reading the data file is a tricky problem for which a solution is provided in the file p99-readfile.pl. See the predicate read_lines/2.

(3) For efficiency reasons it is important, at least for larger puzzles, to sort the words and the sites in a particular order. For this part of the problem, the solution of P28 may be very helpful.

Solution:

-- import Control.Monad
-- import Data.List
import Data.Ord (comparing)
import Data.Function (on)

type Coord     = (Int,Int)
type Word      = String
data Site      = Site {siteCoords :: [Coord], siteLen :: Int} deriving (Show,Eq)
data Crossword = Crossword {cwWords :: [Word], cwSites :: [Site]}  deriving (Show,Eq)

equaling = ((==) `on`)

-- convert the text lines from the file to the "Site" datatype, 
--   which contain the adjacent coordinates of the site and its length
toSites :: [String] -> [Site]
toSites lines = find (index_it lines) ++ find (transpose . index_it $ lines)
    where find       = map makePos . concatMap extractor
          extractor  = filter ((>1) . length) . map (filter ((=='.').snd)) . groupBy (equaling snd)
          index_it   = zipWith (\row -> zip [(col,row) | col <- [1..]]) [1..]
          makePos xs = Site {siteCoords = map fst xs, siteLen = length xs}

-- test whether there exist no two different letters at the same coordinate
noCollision :: [(String, Site)] -> Bool
noCollision xs = all allEqual groupedByCoord
    where groupedByCoord = map (map snd) . groupBy (equaling fst) . sortBy (comparing fst) . concatMap together $ xs
          allEqual []     = True
          allEqual (x:xs) = all (x==) xs

-- merge a word and a site by assigning each letter to its respective coordinate
together :: (Word, Site) -> [(Coord, Char)]
together (w,s) = zip (siteCoords s) w

-- returns all solutions for the crossword as lists of occupied coordinates and their respective letters
solve :: Crossword -> [[(Coord, Char)]]
solve cw = map (concatMap together) solution
    where solution = solve' (cwWords cw) (cwSites cw)

solve' :: [Word] -> [Site] -> [[(Word, Site)]]
solve' _     []     = [[]]
solve' words (s:ss) = if null possWords
                        then error ("too few words of length " ++ show (siteLen s))
                        else do try <- possWords
                                let restWords = Data.List.delete try words
                                more <- solve' restWords ss
                                let attempt = (try,s):more
                                Control.Monad.guard $ noCollision attempt
                                return attempt
    where possWords = filter (\w -> siteLen s == length w) words                       

-- read the content of a file into the "Crossword" datatype
readCrossword :: String -> Crossword
readCrossword = (\(ws,ss) -> Crossword ws (toSites (drop 1 ss))) . break (""==) . lines

This is a simplistic solution with no consideration for speed. Especially sites and words aren't ordered as propesed in (3) of the problem. Words of the correct length are naively tried for all blanks (without heuristics) and the possible solutions are then backtracked.

To test for collisions, all (Word, Site) pairs are merged to result in a list of (Coord, Char) elements which represent all letters placed so far. If all (two) characters of the same coordinate are identical, there exist no collisions between words.