第四回 オフラインリアルタイムどう書く

[第四回 オフラインリアルタイムどう書く](http://atnd.org/events/32191)に行ってきました。お題は[テトロミノと呼ばれる図形の認識。](http://nabetani.sakura.ne.jp/hena/ord4tetroid/)

Haskellで書きました。与えられたパターンの回転・鏡像に対してすべてマッチングをかけるというもの。図形を変換した後で最も左上のブロックを原点に寄せています。

制限時間(1時間)に間に合いました。

```haskell:tetroid.hs
module Main where

import Control.Monad (mapM_)
import Control.Arrow ((***))
import Data.List (find, sort)
import Data.Maybe (maybe)
import Test.HUnit (Test(..), runTestTT, (~=?))

findTetroid :: [Int] -> Char
findTetroid = match . normalize . toCoord

toCoord :: [Int] -> [(Int, Int)]
toCoord = map (`divMod` 10)

normalize :: [(Int, Int)] -> [(Int, Int)]
normalize = toRelative . sort

toRelative :: [(Int, Int)] -> [(Int, Int)]
toRelative [] = error "toRelative: logic error"
toRelative ((x, y) : ps) = (0, 0) : map (subtract x *** subtract y) ps

match :: [(Int, Int)] -> Char
match ps = maybe '-' snd $ find (matchOne ps . fst) patterns

matchOne :: [(Int, Int)] -> [(Int, Int)] -> Bool
matchOne lhs rhs = any (== lhs)
  [ rhs
  , rotate rhs
  , rotate $ rotate rhs
  , rotate $ rotate $ rotate rhs
  , mirror rhs
  , mirror $ rotate rhs
  , mirror $ rotate $ rotate rhs
  , mirror $ rotate $ rotate $ rotate rhs
  ]

rotate :: [(Int, Int)] -> [(Int, Int)]
rotate = normalize . map (\(x, y) -> (y, -x))

mirror :: [(Int, Int)] -> [(Int, Int)]
mirror = normalize . map (\(x, y) -> (y, x))

patterns :: [([(Int, Int)], Char)]
patterns =
  [ ( [ (0, 0), (0, 1), (0, 2), (1, 2) ], 'L' )
  , ( [ (0, 0), (0, 1), (0, 2), (0, 3) ], 'I' )
  , ( [ (0, 0), (1, 0), (1, 1), (2, 0) ], 'T' )
  , ( [ (0, 0), (0, 1), (1, 0), (1, 1) ], 'O' )
  , ( [ (0, 0), (0, 1), (1, 1), (1, 2) ], 'S' )
  ]

--------

main :: IO ()
main = print =<< runTestTT (TestList $ map toTest testdata)

toTest :: ([Int], Char) -> Test
toTest (input, expected) = expected ~=? findTetroid input

testdata :: [([Int], Char)]
testdata =
  [ ([55,55,55,55], '-')
  , ([07,17,06,05], 'L')
  , ([21,41,31,40], 'L')
  , ([62,74,73,72], 'L')
  , ([84,94,74,75], 'L')
  , ([48,49,57,47], 'L')
  , ([69,89,79,68], 'L')
  , ([90,82,91,92], 'L')
  , ([13,23,03,24], 'L')
  , ([24,22,25,23], 'I')
  , ([51,41,21,31], 'I')
  , ([64,63,62,65], 'I')
  , ([49,69,59,79], 'I')
  , ([12,10,21,11], 'T')
  , ([89,99,79,88], 'T')
  , ([32,41,43,42], 'T')
  , ([27,16,36,26], 'T')
  , ([68,57,58,67], 'O')
  , ([72,62,61,71], 'O')
  , ([25,24,15,14], 'O')
  , ([43,54,53,42], 'S')
  , ([95,86,76,85], 'S')
  , ([72,73,84,83], 'S')
  , ([42,33,32,23], 'S')
  , ([66,57,67,58], 'S')
  , ([63,73,52,62], 'S')
  , ([76,68,77,67], 'S')
  , ([12,11,22,01], 'S')
  , ([05,26,06,25], '-')
  , ([03,11,13,01], '-')
  , ([11,20,00,21], '-')
  , ([84,95,94,86], '-')
  , ([36,56,45,35], '-')
  , ([41,33,32,43], '-')
  , ([75,94,84,95], '-')
  , ([27,39,28,37], '-')
  , ([45,34,54,35], '-')
  , ([24,36,35,26], '-')
  , ([27,27,27,27], '-')
  , ([55,44,44,45], '-')
  , ([70,73,71,71], '-')
  , ([67,37,47,47], '-')
  , ([43,45,41,42], '-')
  , ([87,57,97,67], '-')
  , ([49,45,46,48], '-')
  , ([63,63,52,72], '-')
  , ([84,86,84,95], '-')
  , ([61,60,62,73], '-')
  , ([59,79,69,48], '-')
  , ([55,57,77,75], '-')
  ]
```

こちらはブロック同士の距離の二乗(6つ)を比較するというもの。回転や鏡像を考える必要がないぶん短くコーディングできています。このアルゴリズムは勉強会後の飲み会で[鍋谷さん](http://qiita.com/users/Nabetani)に教えてもらいました。

```haskell:distance.hs
module Main where

import Data.Maybe (maybe)
import Data.List (find, sort)
import Test.HUnit (Test(..), runTestTT, (~=?))

findTetroid :: [Int] -> Char
findTetroid = match . toCoord

toCoord :: [Int] -> [(Int, Int)]
toCoord = map (`divMod` 10)

match :: [(Int, Int)] -> Char
match ps = maybe '-' snd $ find ((== dist) . fst) patterns
  where
    dist = findDist ps

findDist :: [(Int, Int)] -> [Int]
findDist = sort . map dist . combination

dist :: ((Int, Int), (Int, Int)) -> Int
dist ((x1, y1), (x2, y2)) = (x2 - x1) ^ 2 + (y2 - y1) ^ 2

combination :: [a] -> [(a,a)]
combination []     = []
combination (x:xs) = map ((,) x) xs ++ combination xs

patterns :: [([Int], Char)]
patterns =
  [ ([1,1,1,1,2,2], 'O')
  , ([1,1,1,2,2,4], 'T')
  , ([1,1,1,2,2,5], 'S')
  , ([1,1,1,2,4,5], 'L')
  , ([1,1,1,4,4,9], 'I')
  ]

--------

-- テストコードは省略

```