いまさら Haskell でボウリング

5 年ほど前の問題

ネットをさまよっていたら、 Haskell でボウリングのスコアを計算するという問題を見つけた。 5 年ほど前、ごいHaskell読書会 in 大阪で紹介されたボウリングのスコア計算のお題らしい ( akanehara/bowl-score.hs -- github )。この世界で 5 年前なんてもはや古代史に属する話題ではあるが、やってみた。

問題の詳細

さきのページをご参照ください akanehara/bowl-score.hs -- github。

解き方

今回の手法の特色

古代の問題を現代の技術で解いてみました、てなことはありません。大したことはないのですが、第 10 フレームの特別扱いを回避したことがちょっと Haskell っぽいなと自己満足。

スコアの計算

各フレームのスコアは下記のように計算できる
* オープンフレームなら、 (そのフレームの 2 投で倒したピン数)
* スペアなら (10 + 続く 1 投で倒したピン数)
* ストライクなら (10 + 続く2 投で倒したピン数)

この方法で全 10 フレームのスコアを加算すると、ゲームのスコアとなる。第 10 フレームをどのようにとらえるかにもよるが、ストライクの場合は最初の 1 投を、その他の場合は最初の 2 投をここでは最終フレームの投球とし、のこりの投球は単に後続の投球であると考えると、 第 10 フレームに特別扱いの必要なし。

プログラム

Frame

ストライク、スペア、オープンの別。stringToFrame は String の先頭を読み、続く投球の列と分割

bowling.hs

data Frame = Strike | Spare | Open Int Int deriving(Show)

stringToFrame :: [Char] -> (Frame,[Char])
stringToFrame ('X':cs) = (Strike,cs)
stringToFrame (_:'/':cs) = (Spare,cs)
stringToFrame (c0:c1:cs) = (Open (charToScore c0) (charToScore c1),cs)

スコア

charToScore では / を処理せず、 frameToScore にまかせている。

bowling.hs

--score
charToScore :: Char -> Int
charToScore 'X' = 10
charToScore '-' = 0
charToScore c = digitToInt c

frameToScore :: Frame -> [Char] -> Int
frameToScore Strike (_:'/':cs) = 20
frameToScore Strike cs = 10 + (sum . map charToScore . take 2 $ cs)
frameToScore Spare cs = 10 + (charToScore . head $ cs)
frameToScore (Open i1 i2) _ = i1 + i2

Game

(Frame、[Char]) の無限列とすることで、第 10 フレームの場合分けをなくした。
最初はびびって repeat '=' を足して無限列にしていたけど、そこは遅延評価が
うまくやってくれて、エラーは出ない。よく出来ている。

bowling.hs

readGame' :: [Char] -> [(Frame,[Char])]
readGame' cs =
  let f@(_,cs') = stringToFrame cs
  in f:readGame' cs'

readGame :: [Char] -> [(Frame,[Char])]
--readGame cs = take 10 $ readGame' (cs ++ repeat '-')
readGame cs = take 10 $ readGame' cs

bowlingScore = sum . map (uncurry frameToScore) . readGame

全体

bowling.hs

import Data.Char (digitToInt)

-- frame
data Frame = Strike | Spare | Open Int Int deriving(Show)

stringToFrame :: [Char] -> (Frame,[Char])
stringToFrame ('X':cs) = (Strike,cs)
stringToFrame (_:'/':cs) = (Spare,cs)
stringToFrame (c0:c1:cs) = (Open (charToScore c0) (charToScore c1),cs)

--score
charToScore :: Char -> Int
charToScore 'X' = 10
charToScore '-' = 0
charToScore c = digitToInt c

frameToScore :: Frame -> [Char] -> Int
frameToScore Strike (_:'/':cs) = 20
frameToScore Strike cs = 10 + (sum . map charToScore . take 2 $ cs)
frameToScore Spare cs = 10 + (charToScore . head $ cs)
frameToScore (Open i1 i2) _ = i1 + i2

readGame' :: [Char] -> [(Frame,[Char])]
readGame' cs =
  let f@(_,cs') = stringToFrame cs
  in f:readGame' cs'

readGame :: [Char] -> [(Frame,[Char])]
--readGame cs = take 10 $ readGame' (cs ++ repeat '-')
readGame cs = take 10 $ readGame' cs

bowlingScore = sum . map (uncurry frameToScore) . readGame

-- test and main
testCases = [
        ("9-9-9-9-9-9-9-9-9-9-",  90),
        ("X54----------------",   28),
        ("1/5-----------------",  20),
        ("1/5-2/-/8-----------",  56),
        ("------XX----------",    30),
        ("------XXX--------",     60),
        ("XXXXXXXXXXXX",          300),
        ("--------------------",  0),
        ("-------------------/5", 15),
        ("------------------X54", 19),
        ("5/5/5/5/5/5/5/5/5/5/5", 150)
    ]

printTest (testCase, result) = do
    putStrLn $ "test case: " ++ testCase
    putStrLn $ if (bowlingScore testCase) == result then "CLEAR" else "FAIL"

test = mapM_ printTest testCases

main :: IO ()
main = test

まとめ

第 10 フレームの場合分けがないとは言え、 web で見つけた他の方の答えにくらべてコードが短いわけでもないし、やっぱり自己満足ですな。

ボウリングのスコアの計算が合理的だということと、遅延評価の良さがわかりました。

references

Safx: ボウリングのスコアを計算するスクリプトをHaskellで書いてみた

akanehara/bowl-score.hs

ボウリングのスコア計算は難しい -- yashiganiの英傑になるまで死ねない日記