第9章 対話プログラム #9

9.9 練習問題

練習問題5は「グラフィック・ライブラリを用いて」とか書いてあって面倒なのでパス。Windowsで動かなかったりするし。

  1. ニムはボードを使うゲームである。ボードには、番号の付いた行が五つあり、はじめは星が以下のように並べてある。 
    1:*****
2:****
3:***
4:**
5:*
    二人のプレイヤーは、交互に行を一つ選び、その最後から一つ以上の星を取る。ボードから最後の星を取った方が勝ちである。ニムをHaskellで実装せよ。
    ヒント：それぞれの残っている星の数のリストでボードを定義せよ。ボードの初期値は [5,4,3,2,1] となる。

割と長くなったので解説を入れながら。

まず、入力のところを考える。 入力は"行番号 星の数"と入力してEnterを押す仕様にする。 せっかくなのでパーザーモナドを使う。

import Parsing

niminput :: Parser (Int,Int)
niminput =  do
  row <- nat
  space
  count <- nat
  return (row,count)

こんな感じで、パーズに成功したら(行番号,星の数)というタプルを返すことにする。

出力は、9.5の関数を一部使う。 zip関数で(行番号,星の数)というタプルのリストを作って、それぞれを表示する。

import NineFive

type Board = [Int]

display    :: Board -> IO ()
display xs =  seqn $ map displayline $ zip [1..length xs] xs

displayline :: (Int,Int) -> IO ()
displayline (row,count) = do
  putStr (show row ++ ":")
  putStrLn (replicate count '*')

星を取る関数の仕様はちょっと悩んだ。 入力が不正だと星を取れないというロジックを組み込まないといけない。 というわけで、(成否を表す真偽値,結果のボード)のタプルを返すようにしてみた。 Maybeモナドのほうがいいのかもしれないが、まだ教科書には出て来てないからな。

getstars :: Board -> (Int,Int) -> (Bool,Board)
getstars xs (row,count)
  | row == 0              = (False,xs)
  | count == 0            = (False,xs)
  | row > length xs       = (False,xs)
  | xs !! (row-1) < count = (False,xs)
  | otherwise             = (True,take (row-1) xs ++ [xs !! (row-1) - count] ++ drop row xs)

あとはIOモナドでグリグリと表示したり入力したり。

というわけで、回答はこちら。

module NineNineFive where

import Parsing
import NineFive

niminput :: Parser (Int,Int)
niminput =  do
  row <- nat
  space
  count <- nat
  return (row,count)

type Board = [Int]

display    :: Board -> IO ()
display xs =  seqn $ map displayline $ zip [1..length xs] xs

displayline :: (Int,Int) -> IO ()
displayline (row,count) = do
  putStr (show row ++ ":")
  putStrLn (replicate count '*')

getstars :: Board -> (Int,Int) -> (Bool,Board)
getstars xs (row,count)
  | row == 0              = (False,xs)
  | count == 0            = (False,xs)
  | row > length xs       = (False,xs)
  | xs !! (row-1) < count = (False,xs)
  | otherwise             = (True,take (row-1) xs ++ [xs !! (row-1) - count] ++ drop row xs)

turn :: Int -> Board -> IO ()
turn p b
  | all (==0) b = return ()
  | otherwise   = do {display b; input p b}

input :: Int -> Board -> IO ()
input p b = do
  putStr ("Player " ++ show p ++ ": ")
  xs <- getLine
  process p b $ parse niminput xs

process :: Int -> Board -> [((Int,Int),String)] -> IO ()
process p b []      = do {beep; input p b}
process p b [(r,_)] = check p $ getstars b r

check :: Int -> (Bool,Board) -> IO ()
check p (False, b) = do {beep; input p b}
check p (True , b) =
  if all (==0) b then
    putStrLn ("Player " ++ show p ++ " won!")
  else
    turn (chenge p) b

chenge   :: Int -> Int
chenge 1 =  2
chenge 2 =  1

nim :: IO ()
nim =  turn 1 [5,4,3,2,1]