Edited at

いまさら 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

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


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の英傑になるまで死ねない日記