Tuesday, April 28, 2009

kenken parser

The parser for my kenken input format is simple and doesn't cope well with errors in the format. That's ok for me, as this was more or less an exercise in programming and not an attempt to build anything that anyone but me might use (and just became a blog post because, well, it was there).

In any case, I read in the file in one gulp using readFile, then pass that to the parse routine, so the parser is pure code. That gets passed to "parse" which breaks the input into lines (using "lines", natch), strips each input line of spaces and breaks the input into two parts at the first blank line. The size of the first list (the block of letters) is used to determine the size of the puzzle and then two helper functions are called, the first builds the list of cells and the second builds the list of constraints with the list of cells and the list of constraint definitions as its input.

Each of the lines in the block of cells is used to generate a Cell with the position derived using a counter passed to a recursive routine (I'd do it differently now, but rewriting would probably end up with my building a more robust parser and I'm not sure I want to do that).

Each constraint line is broken on the equals sign - the label for the constraint is the part before the equals, the target is the integer value of the list of digits and the operator (which must be present) is the last bit.

Without further ado, here is the parsing section of the solver (not all functions have types, but in later versions of this, the types are included pretty much everywhere).

parse :: String -> Puzzle
parse s = Puzzle {psize=size, origInput=plines, constraints=constraintList, pcells=cellList}
where
plines = map strip $ lines s
(cellLines, constraintLines) = break ([]==) plines
size = length cellLines
cellList = doCellLines 0 cellLines
constraintList = parseConstraintLines cellList $ tail constraintLines

doCellLines :: Int -> [String] -> [Cell]
doCellLines i [] = []
doCellLines i (l:ls) = let l1 = zip [0..] l
mkcell (xpos, y) = Cell { clabel=[y], cx=xpos, cy=i}
l2 = map mkcell l1
in l2 ++ (doCellLines (i+1) ls)

parseConstraintLines cells lines = map (parseConstraint cells) (filter ("" /=) lines)

parseConstraint cells l = Constraint {conlabel= label,
conop = op,
contarget = target,
concells = clist }
where
(label,rest) = break ('='==) l
(starget, op) = break (not.isDigit) $ tail rest
target = read starget
clist = filter (\c -> clabel c == label) cells
strip l = sl
where
sl = reverse $ dropWhile isSpace $ reverse $ dropWhile isSpace l

No comments: