「あなたのスキルで飯は食えるか？　史上最大のコーディングスキル判定」をやってみた、その3

makeplex salon：あなたのスキルで飯は食えるか？ 史上最大のコーディングスキル判定 (1/2) - ITmedia エンタープライズ を解いてみた話の3回目。まだやってんのか！すいません、やってます（笑）

前回までのおはなし：

で、今回は勉強用にHaskellで作ってみた。アルゴリズムは以下のようなもの。

  1. 指定された手に1〜9までの牌のどれか1つを足す（ツモ）
  2. そこから頭を取った場合のすべての組み合わせを作る
  3. そこから面子を取った場合のすべての組み合わせを作る
  4. 手順3をあと3回繰り返す
  5. 与えた（ツモった）牌を消して、その部分を待ちにする
  6. 結果を文字列にして返す

これは最初の記事で「1. 作った（5時間）→考え方が間違っていて失敗」と書いた方法。しばらく考えたら間違いじゃなかったことがわかったので採用。

というわけで、まずはコード。

chin_itsu.hs：

module Main where

import Char
import Maybe
import Data.List

-- 手牌を表現する型
-- Te ツモ牌 面子 残りの牌
-- "1223344888999"で6をツモった場合を表す手
--   == Te 6 [] [1,2,2,2,0,1,0,3,3]
-- そこから8の刻子を決定した場合を表す手
--   == Te 6 [[8,8,8]] [1,2,2,2,0,1,0,0,3]
data Te = Te Int [[Int]] [Int] deriving (Show)

testData = ["1112224588899", "1122335556799",
             "1112223335559", "1223344888999", "1112345678999"]

main = do putStrLn $ concatMap searchAndFormat testData

searchAndFormat :: String -> String
searchAndFormat x = formatToShow x (search x)

formatToShow :: String -> String -> String
formatToShow src result = src ++ ":\n" ++ result ++ "\n\n"

-- 検索メイン部
-- 手牌を文字列で渡すと待ちの組み合わせを改行区切りで返す
-- ex. search "1223344888999" == "(123)(234)(888)(999)[4]\n(123)(44)..."
search :: String -> String
search s = intercalate "\n" $ fltr $ expand s
   where
     fltr = nub . sort . concatMap teToResult
     expand = mentsu . mentsu . mentsu . mentsu . header . tsumo

-- 1〜9の各牌を足した手牌を作成する
tsumo :: String -> [Te]
tsumo s = map (\x -> addPaiMakeTe x s) [1..9]

addPaiMakeTe :: Int -> String -> Te
addPaiMakeTe n s = Te n [] (strToIntList (intToDigit n : s))

strToIntList :: String -> [Int]
strToIntList s = map (\x -> length x - 1) (group (sort (s ++ "123456789")))

-- 頭、面子を決定し、組み合わせを返す
header :: [Te] -> [Te]
header xs = concatMap toitsu xs

mentsu :: [Te] -> [Te]
mentsu xs = concatMap (\x -> catMaybes [kohtsu x, juntsu x]) xs

-- 対子、刻子、順子を決定する
toitsu :: Te -> [Te]
toitsu te = map (\x -> toitsu1 x te) (toitsuIndexes r)
   where
     (Te t m r) = te

toitsu1 :: Int -> Te -> Te
toitsu1 i (Te t m r) = (Te t m' r')
   where
     m' = [i + 1, i + 1] : m
     r' = subToitsu i r

kohtsu :: Te -> Maybe Te
kohtsu (Te t m r) = case kohtsuIndex r of
                      Nothing -> Nothing
                      Just i  -> Just (Te t m' r')
                       where
                         m' = [i + 1, i + 1, i + 1] : m
                         r' = subKohtsu i r

juntsu :: Te -> Maybe Te
juntsu (Te t m r) = case juntsuIndex r of
                      Nothing -> Nothing
                      Just i  -> Just (Te t m' r')
                       where
                         m' = [i + 1, i + 2, i + 3] : m
                         r' = subJuntsu i r

-- 対子、刻子、順子の位置を返す
toitsuIndexes :: [Int] -> [Int]
toitsuIndexes xs = findIndices (\x -> x >= 2) xs

kohtsuIndex :: [Int] -> Maybe Int
kohtsuIndex = findIndex (\x -> x >= 3)

juntsuIndex :: [Int] -> Maybe Int
juntsuIndex p = elemIndex 3 (contCount p)

contCount :: [Int] -> [Int]
contCount xs = snd (foldr f (0, []) xs)
   where
     f x (c, ls) | x == 0    = (0, 0:ls)
                 | otherwise = (c + 1, (c + 1):ls)

-- 対子、刻子、順子を除去したリストを返す
subToitsu :: Int -> [Int] -> [Int]
subToitsu = subIndex 2

subKohtsu :: Int -> [Int] -> [Int]
subKohtsu = subIndex 3

subJuntsu :: Int -> [Int] -> [Int]
subJuntsu i xs = subIndex 1 i $ subIndex 1 (i + 1) $ subIndex 1 (i + 2) xs

subIndex :: Int -> Int -> [Int] -> [Int]
subIndex n i = mapZip (\ (i',x) -> if i' == i then x - n else x)

mapZip :: ((Int, a) -> a) -> [a] -> [a]
mapZip f xs = map f (zip [0..] xs)

-- 手牌から結果文字列を作成する
teToResult :: Te -> [String]
teToResult (Te t m r) = resultStrs t m

resultStrs :: Int -> [[Int]] -> [String]
resultStrs t ms = map (\x -> mentsuOf x ++ waitOf x) (waitAndMentsu t ms)
   where
     waitOf pair = waitStr (delete t (fst pair))
     mentsuOf pair = mentsuStr (snd pair)

waitAndMentsu :: Int -> [[Int]] -> [([Int], [[Int]])]
waitAndMentsu t ms = filter (\x -> t `elem` (fst x)) (oneAndOthers ms)

mentsuStr :: [[Int]] -> String
mentsuStr m = concatMap (\x -> "(" ++ (map intToDigit x) ++ ")") (sort m)

waitStr :: [Int] -> String
waitStr w = "[" ++ map intToDigit w ++ "]"

-- リストのある要素と残りリストの組み合わせを返す
-- ex. oneAndOthers [1,2,3,4]
--     == [(1,[2,3,4]),(2,[1,3,4]),(3,[1,2,4]),(4,[1,2,3])]
oneAndOthers :: [a] -> [(a, [a])]
oneAndOthers xs = zip xs (others xs)

others :: [a] -> [[a]]
others xs = map (\ (i,x) -> dropIndex i xs) (zip [0..] xs)

dropIndex :: Int -> [a] -> [a]
dropIndex i xs = [x | (i',x) <- zip [0..] xs, i' /= i]

なんだか無駄に長い気がする…。

実行結果：

>main
1112224588899:
(111)(222)(888)(99)[45]

1122335556799:
(123)(123)(55)(567)[99]
(123)(123)(555)(99)[67]
(123)(123)(567)(99)[55]

1112223335559:
(111)(222)(333)(555)[9]
(123)(123)(123)(555)[9]

1223344888999:
(123)(234)(888)(999)[4]
(123)(44)(888)(999)[23]
(234)(234)(888)(999)[1]

1112345678999:
(11)(123)(456)(789)[99]
(11)(123)(456)(999)[78]
(11)(123)(678)(999)[45]
(11)(345)(678)(999)[12]
(111)(234)(567)(99)[89]
(111)(234)(567)(999)[8]
(111)(234)(678)(999)[5]
(111)(234)(789)(99)[56]
(111)(345)(678)(999)[2]
(111)(456)(789)(99)[23]
(123)(456)(789)(99)[11]

ポイントはsearch関数の

expand = mentsu . mentsu . mentsu . mentsu . header . tsumo

の部分。ツモって、頭を取って、面子×4を取る関数を直列に接続している。取れない組み合わせは途中で消えていくので（catMaybes）、残ったものが解答になる。

「再帰のようなパターンを良しとしない本物の Haskell プログラマは fold を使います」ということなので、がんばって再帰を使わずに書いてみた。

ふつけるはWebサーバーのあたりで混乱して挫折したクチだけど、上記のコードを書いたらHaskellへの理解が深まったと思う。よし、自己満足（笑）