I'm relatively new to Haskell and I'd like to get feedback on the style of my program. Specifically:
- Coding Style: Can any parts be written in a more concise or more readable way?
- Misuse: Are there any parts that are generally should be avoided, or any typical beginner mistakes? (Basically the do's and don't's)
The program solves a puzzle that is also known as binoxxo: There is a
2n x 2n square grid that is partially filled with
O. The goal filling each cell of the grid with an
O such that the result satisfies three conditions:
- In each column and each row, the same symbol cannot occur more than twice in a row. (I.e.
OXXOXOis ok, however
- Each row and each column have exactly
- No two rows are equal and no two columns are equal.
(An online version can be found here.)
The following module consists of three parts: First we define the new type to describe the grid, with the type constructors
X,O and finally
E (for an empty cell). Then we have two functions:
isValid checks whether all three rules hold so far, and
backtrack which actually solves the puzzle. It does so by placing an
O in the first
E spot of the given puzzle checking the validity of the new grids, and if that succeeds, recursing a step deeper. This function finds all the possible solutions, but due to the lazy evaluation we can use
take 1 $ backtrack myBoard to get only one and finish a little bit quicker.
module Binoxxo (isValid, backtrack, exampleBoard, Cell (..), Board) where import Control.Applicative import Data.List data Cell = E | X | O -- E = empty deriving (Eq,Show) type Board = [[Cell]] exampleBoard = -- for solving: call "backtrack exampleBoard" [[X,X,E,E], [E,E,E,E], [O,E,E,X], [O,O,E,X]] -- backtracking backtrack :: Board -> [Board] backtrack b | isFull b = [b] --board has no more empty cells | otherwise = nub $ concat $ map backtrack validBoards where isFull b = not $ E `elem` concat b newBoards = generateAllBoards b :: [Board] validBoards = filter isValid newBoards generateAllBoards :: Board -> [Board] -- adds one new X/O in the position of a E generateAllBoards b = concat $ map assembleBoards (prefixRowSuffix b) where prefixRowSuffix :: [a] -> [([a],a,[a])]-- [1,2,3,4] -> [(,1,[2,3,4]), (,2,[3,4]), ([1,2],3,), ([1,2,3],4,)] prefixRowSuffix b = zip3 (inits b) b (drop 1 $ tails b) assembleBoards :: ([[Cell]],[Cell],[[Cell]]) -> [Board] assembleBoards (front,m,back) = take 2 -- we only need to place X and O in the first occurence of E, because one of them MUST be correct [front ++[f++[x]++b]++ back | (f,E,b)<-prefixRowSuffix m,x<-[X,O]] -- validity check (implement the three rules) isValid :: Board -> Bool isValid b = and $ [and . map checkNeighbours, checkDupli, and . map checkCount] -- each of these get applied to all normal and transposed board <*> [rows, cols] where rows = b :: Board cols = transpose b :: Board -- we cannot have three consecutive X or O checkNeighbours :: [Cell] -> Bool checkNeighbours (a:b:c:xs) = let this = not $ any ((&& a==b && b==c) . (c==)) [X,O] rest = checkNeighbours (b:c:xs) in this && rest checkNeighbours _ = True -- we cannot have two equal rows/columns checkDupli :: Board -> Bool checkDupli b = check $ filter (all (/=E)) b -- only check full rows for duplicates where check (x:xs) = (not $ x `elem` xs) && check xs check  = True -- if row is of length n, we can have at most n/2 X and O checkCount :: [Cell] -> Bool checkCount xs = notTooMany O && notTooMany X where len = length xs notTooMany xo = len >= 2 * length (filter (==xo) xs)