ふたマスの領域の数 ref: http://qiita.com/nobsun/items/c29e0e56de478303259a

F01.hs

module F01 where

import Control.Arrow
import Numeric
import Data.Char
import Data.Function
import Data.List
import Text.Printf
import Debug.Trace

infixr ...
(...) :: Show b => (b -> c) -> (a -> b) -> (a -> c)
(f ... g) x = let y = g x in trace (show y) (f y)


type Board = [[Int]]

readBoard :: String -> Board
readBoard = map (map digitToInt)
          . map (printf "%08b" :: Int -> String)
          . map (fst . head  . readHex :: String -> Int)
          . words
          . map cnv
  where
    cnv '/' = ' '
    cnv c   = c

type Line = [(Int,(Int,Int))]

checkBoard :: Board -> [Line]
checkBoard = map unzipp
           . slice3
           . (twos:)
           . (++[twos])

twos :: [Int]
twos = replicate 8 2

slice3 :: [a] -> [(a,(a,a))]
slice3 (x:xs@(y:z:_)) = (y,(x,z)) : slice3 xs
slice3 _              = []

unzipp :: ([a],([a],[a])) -> [(a,(a,a))]
unzipp = uncurry zip . second (uncurry zip)

h2count :: Line -> (Int,Int)
h2count = count (0,0)
        . filter contline
        . filter ((2 ==) . length)
        . groupBy ((==) `on` fst)
  where
    count (zrs,ons) [] = (zrs,ons)
    count (zrs,ons) (((0,_):_):rs) = count (succ zrs,ons) rs
    count (zrs,ons) (((1,_):_):rs) = count (zrs,succ ons) rs
    contline [(x,(y,z)),(x',(y',z'))] = x /= y && x /= z && x' /= y' && x' /= z'

type Problem = String
type Answer  = String

f01 :: Problem -> Answer
f01 = showCount
    . foldr add (0,0)
    . map h2count
    . uncurry (++)
    . (checkBoard &&& checkBoard . transpose)
    . readBoard

showCount :: (Int,Int) -> String
showCount (x,y) = show x++","++show y

add :: (Int,Int) -> (Int,Int) -> (Int,Int)
add (x,y) (z,w) = (x+z,y+w)

{- |
>>> test ( "dc/bc/a7/59/03/d5/d4/ea", "2,3" )
True    
>>> test ( "ff/ff/ff/ff/ff/ff/ff/ff", "0,0" )
True    
>>> test ( "00/00/00/00/00/00/00/00", "0,0" )
True    
>>> test ( "cc/33/cc/33/cc/33/cc/33", "16,16" )
True    
>>> test ( "aa/aa/55/55/aa/aa/55/55", "16,16" )
True    
>>> test ( "ac/a3/5c/53/ca/3a/c5/35", "8,8" )
True    
>>> test ( "db/00/db/00/db/00/aa/aa", "0,13" )
True    
>>> test ( "24/24/db/24/24/db/24/24", "0,12" )
True    
>>> test ( "d7/d7/e9/f1/f7/de/60/56", "3,2" )
True    
>>> test ( "17/7d/64/9b/a5/39/53/a6", "2,2" )
True    
>>> test ( "bb/8f/18/fb/89/c2/c7/35", "1,2" )
True    
>>> test ( "6d/63/20/08/54/cd/32/4f", "2,2" )
True    
>>> test ( "a9/ca/cd/46/99/e6/f0/30", "2,2" )
True    
>>> test ( "5b/70/fd/45/e2/a1/ab/9a", "1,2" )
True    
>>> test ( "24/e4/a8/12/e1/a6/3f/f3", "2,1" )
True    
>>> test ( "79/32/2e/07/d5/10/e7/9d", "2,2" )
True    
>>> test ( "60/bc/ab/ec/1f/eb/63/2c", "4,2" )
True    
>>> test ( "a5/dd/92/4e/67/c6/dc/34", "6,1" )
True    
>>> test ( "aa/96/6d/67/d2/a8/ac/90", "3,2" )
True    
>>> test ( "95/72/7d/5c/47/dc/ef/99", "4,0" )
True    
>>> test ( "17/d6/6a/27/1f/25/26/b8", "2,1" )
True    
>>> test ( "f0/f3/76/c5/31/ca/6b/ae", "1,2" )
True    
>>> test ( "01/59/26/fa/8c/70/12/cd", "1,4" )
True    
>>> test ( "1a/c3/1f/0b/83/b6/81/0d", "0,5" )
True    
>>> test ( "4c/49/05/cf/54/bb/1f/da", "1,2" )
True    
>>> test ( "eb/7c/d5/09/2a/c2/14/6b", "0,7" )
True    
>>> test ( "b4/d3/4c/c4/ed/19/e8/63", "1,3" )
True    
>>> test ( "bd/bc/6d/60/9b/00/9a/32", "2,4" )
True    
>>> test ( "94/97/3f/e3/c7/06/15/c0", "2,2" )
True    
>>> test ( "5f/1d/67/16/b8/f7/0a/2a", "2,2" )
True    
>>> test ( "df/e6/f9/4f/59/e9/1f/ee", "3,0" )
True    
>>> test ( "5a/53/9a/9a/73/b4/37/07", "3,2" )
True    
>>> test ( "bd/87/7c/e7/c0/37/82/da", "2,3" )
True    
>>> test ( "3d/c0/13/ac/57/3d/15/78", "2,2" )
True    
>>> test ( "63/64/54/3a/40/28/4e/4e", "0,3" )
True    
>>> test ( "f6/81/c9/15/00/4c/a0/a8", "1,4" )
True    
>>> test ( "19/41/df/f8/e3/74/6b/9b", "4,2" )
True    
>>> test ( "d5/0b/dd/35/3b/d2/0b/6b", "1,5" )
True    
>>> test ( "08/b7/91/f3/6e/3c/74/a0", "0,0" )
True    
>>> test ( "b8/a8/b4/a6/93/2c/94/3f", "0,0" )
True    
>>> test ( "88/22/21/ee/dc/19/43/01", "0,0" )
True    
>>> test ( "e1/ee/35/bc/fc/00/8e/fe", "0,0" )
True    
>>> test ( "3c/42/63/5f/27/47/07/90", "0,0" )
True
-}

test :: (Problem,Answer) -> Bool
test (p,a) = f01 p == a