「六角形のテトロミノ」問題 ref: http://qiita.com/nobsun/items/4099ee005e300b3dbb0c

E13.hs

module E13 where

import Data.List
import Data.Maybe

type CubeCoord = (Int, Int, Int)

cubecoord :: Char -> Maybe CubeCoord
cubecoord 'a' = Just (0,0,0)
cubecoord 'b' = Just (1,-1,0)
cubecoord 'c' = Just (2,-2,0)
cubecoord 'd' = Just (3,-3,0)
cubecoord 'e' = Just (4,-4,0)
cubecoord 'f' = Just (0,-1,1)
cubecoord 'g' = Just (1,-2,1)
cubecoord 'h' = Just (2,-3,1)
cubecoord 'i' = Just (3,-4,1)
cubecoord 'j' = Just (-1,-1,2)
cubecoord 'k' = Just (0,-2,2)
cubecoord 'l' = Just (1,-3,2)
cubecoord 'm' = Just (2,-4,2)
cubecoord 'n' = Just (3,-5,2)
cubecoord 'o' = Just (-1,-2,3)
cubecoord 'p' = Just (0,-3,3)
cubecoord 'q' = Just (1,-4,3)
cubecoord 'r' = Just (2,-5,3)
cubecoord 's' = Just (-2,-2,4)
cubecoord 't' = Just (-1,-3,4)
cubecoord 'u' = Just (0,-4,4)
cubecoord 'v' = Just (1,-5,4)
cubecoord 'w' = Just (2,-6,4)
cubecoord _   = Nothing

diff :: CubeCoord -> CubeCoord -> CubeCoord
diff (x,y,z) (x',y',z') = (x'-x,y'-y,z'-z)

type Omino' = [CubeCoord]
type Omino  = [Omino']

type Table = [(Char, Omino)]

table :: Table
table = zip "BDIJLNOSYZ" (map omino omino's)

omino's :: [Omino']
omino's = map (mapMaybe cubecoord)
  ["afkg" -- B
  ,"fkgc" -- D
  ,"abcd" -- I
  ,"jkgc" -- J
  ,"afkl" -- L
  ,"fbch" -- N
  ,"fbkg" -- O
  ,"afgl" -- S
  ,"ajfg" -- Y
  ,"jfgc" -- Z
  ]

norm :: Omino' -> Omino'
norm = (zipWith diff <*> tail) . sort

omino :: Omino' -> Omino
omino = map norm . take 6 . iterate (map ccw)

ccw :: CubeCoord -> CubeCoord
ccw (x,y,z) = (-y,-z,-x)

type Problem = String
type Answer  = String

e13 :: Problem -> Answer
e13 p = maybe "-" ((:"") . fst)
      $ flip find table (elem o' . snd)
  where
    o' = norm $ mapMaybe cubecoord p

type Test = (Problem, Answer)
{- |
>>> test ( "glmq", "B" )
True    
>>> test ( "fhoq", "-" )
True    
>>> test ( "lmpr", "N" )
True    
>>> test ( "glmp", "Y" )
True    
>>> test ( "dhkl", "J" )
True    
>>> test ( "glpq", "D" )
True    
>>> test ( "hlmq", "O" )
True    
>>> test ( "eimq", "I" )
True    
>>> test ( "cglp", "S" )
True    
>>> test ( "chlq", "Z" )
True    
>>> test ( "glqr", "L" )
True    
>>> test ( "cdef", "-" )
True    
>>> test ( "hijk", "-" )
True    
>>> test ( "kpqu", "B" )
True    
>>> test ( "hklm", "B" )
True    
>>> test ( "mqrw", "B" )
True    
>>> test ( "nrvw", "B" )
True    
>>> test ( "abfj", "B" )
True    
>>> test ( "abcf", "B" )
True    
>>> test ( "mrvw", "D" )
True    
>>> test ( "ptuv", "D" )
True    
>>> test ( "lmnr", "D" )
True    
>>> test ( "hklp", "D" )
True    
>>> test ( "himr", "D" )
True    
>>> test ( "dhil", "D" )
True    
>>> test ( "hlpt", "I" )
True    
>>> test ( "stuv", "I" )
True    
>>> test ( "bglq", "I" )
True    
>>> test ( "glmn", "J" )
True    
>>> test ( "fghm", "J" )
True    
>>> test ( "cdgk", "J" )
True    
>>> test ( "lpst", "J" )
True    
>>> test ( "imrw", "J" )
True    
>>> test ( "dinr", "J" )
True    
>>> test ( "cdin", "L" )
True    
>>> test ( "eghi", "L" )
True    
>>> test ( "cdeg", "L" )
True    
>>> test ( "bgko", "L" )
True    
>>> test ( "eimr", "L" )
True    
>>> test ( "jotu", "L" )
True    
>>> test ( "kotu", "N" )
True    
>>> test ( "lqtu", "N" )
True    
>>> test ( "cdim", "N" )
True    
>>> test ( "klot", "N" )
True    
>>> test ( "kloq", "N" )
True    
>>> test ( "kmpq", "N" )
True    
>>> test ( "qrvw", "O" )
True    
>>> test ( "mnqr", "O" )
True    
>>> test ( "kopt", "O" )
True    
>>> test ( "mnpq", "S" )
True    
>>> test ( "bfko", "S" )
True    
>>> test ( "chin", "S" )
True    
>>> test ( "hmnq", "Y" )
True    
>>> test ( "nqrw", "Y" )
True    
>>> test ( "bchi", "Z" )
True    
>>> test ( "inrw", "Z" )
True    
>>> test ( "cfgj", "Z" )
True    
>>> test ( "jnpv", "-" )
True    
>>> test ( "flmp", "-" )
True    
>>> test ( "adpw", "-" )
True    
>>> test ( "eilr", "-" )
True    
>>> test ( "bejv", "-" )
True    
>>> test ( "enot", "-" )
True    
>>> test ( "fghq", "-" )
True    
>>> test ( "cjms", "-" )
True    
>>> test ( "elov", "-" )
True    
>>> test ( "chlm", "D" )
True    
>>> test ( "acop", "-" )
True    
>>> test ( "finr", "-" )
True    
>>> test ( "qstu", "L" )
True    
>>> test ( "abdq", "-" )
True    
>>> test ( "jkln", "-" )
True    
>>> test ( "fjkn", "-" )
True    
>>> test ( "ijmn", "-" )
True    
>>> test ( "flqr", "-" )
True
-}
test :: Test -> Bool
test (p,a) = e13 p == a