プログラミングコンテスト: パネルの2分割 ref: http://qiita.com/items/3033

main.hs

type Point = (Int, Int)
type Pair = (Point, Point)
type Node = [Pair]

main :: IO ()
main =  do
  print $ length $ solve 8

plus                   :: Point -> Point -> Point
plus (x1, y1) (x2, y2) =  (x1+x2, y1+y2)

minus                   :: Point -> Point -> Point
minus (x1, y1) (x2, y2) =  (x1-x2, y1-y2)

move          :: Pair -> Point -> Pair
move (f, b) p =  (f `plus` p, b `minus` p)

moves                   :: Pair -> Pair -> [Pair]
moves (pf, pb) (qf, qb) =  map (move (pf, pb)) [f, r, l]
  where
    (dx, dy) = pf `minus` qf
    f = (dx, dy)
    r = (-dy, dx)
    l = (dy, -dx)

nexts            :: Node -> [Node]
nexts (p1:p0:ps) =  [p2:p1:p0:ps | p2 <- moves p1 p0]

exists :: Point -> [Pair] -> Bool
exists p = any (either p)
  where
    either p (pf, pb) = p == pf || p == pb

solve      :: Int -> [Node]
solve size =  solutions initial
  where
    center :: Point
    center =  (size `div` 2, size `div` 2)

    p0 :: Pair
    p0 =  (center, center)

    initial :: Node
    initial = [move p0 (0, 1), p0]

    atboundary        :: Point -> Bool
    atboundary (x, y) =  (x == 0) || (x == size) || (y == 0) || (y == size)

    solutions   :: Node -> [Node]
    solutions n
      | atboundary f = [n]
      | exists f ps  = []
      | otherwise    = [n'' | n' <- nexts n,
                              n'' <- solutions n']
      where
        (f,b):ps = n