Justitia test 7

Test7.hs

import Data.List 
original = 
    [ "..0...0.....1."
    , "1....0....0.11"
    , "...1...0......"
    , "1...0........."
    , "......0..1.0.0"
    , "1..11..1..1..."
    , "........0....."
    , "1.1..1...11..."
    , "1......1......"
    , "..0.1..1.0...1"
    , "..0..0....1..."
    , "1........1.00."
    , ".....00......0"
    , ".00......11..0"
    ] 

a = 
   [ "01010100101011"
   , "10101001010011" 
   , "01011010101100" 
   , "10100110100101" 
   , "01100101011010" 
   , "10011001101001" 
   , "01011010010101" 
   , "10100110011010" 
   , "10100101100101" 
   , "01011001100101" 
   , "01011010011010" 
   , "10100110011001" 
   , "01101001100110" 
   , "10010110011010" 
   ] 


b = 
    [ "01010100101011"
    , "10101001010011"
    , "01011010101100"
    , "10100110100101"
    , "01100101011010"
    , "10011001101001"
    , "01011010010101"
    , "10100110011010"
    , "10100101100110"
    , "01011001100101"
    , "01011010011010"
    , "10100110011001"
    , "01101001100110"
    , "10010110011010"
    ] 

{-| Checks if a line overlaps with another line on 
every position, except for when the value is Nothing
-} 
overlap incomplete option = 
    and $ zipWith (\x y -> x == y || x == '.') incomplete option


{-| Determines whether a complete board is valid. Used for brute-force
search
-} 
solvedValidBoard board = 
    uniqueRowsAndColumns && noThreeInARow 
  where 
        rows = board
        columns = transpose board

        -- rows and columns have to be unique
        uniqueRowsAndColumns = rows == nub rows && columns == nub columns

        -- there can not be 3 (or more) of the same value in a line
        patterns = [ replicate 3 '1', replicate 3 '0' ] 

        notInfixOf sublist list = not $ isInfixOf sublist list

        -- don't fear the monad!
        -- for all rows and columns, ensure that "111" nor "000" isInfixOf
        -- row or column
        noThreeInARow = and $ do 
                pat <- patterns
                (row, column) <- zip rows columns 
                return $ notInfixOf pat row && notInfixOf pat column 

main = do 
    putStrLn "the two solutions are distinct"
    print $ (/= 1) $ length $ nub [ a, b ] 

    putStrLn "A overlaps with the original input on every non-. position"
    print $ and $ zipWith overlap original a

    putStrLn "B overlaps with the original input on every non-. position"
    print $ and $ zipWith overlap original b

    putStrLn "A is a valid board"
    print $ solvedValidBoard a 

    putStrLn "B is a valid board"
    print $ solvedValidBoard b