「Haskell入門ハンズオン #2」の当日用資料(3)

これまで学んできた知識を利用して、ぎりぎり「遊べる」迷路ゲームを作る。

仕様

• 標準出力に一画面ずつ出力することで、ゲームの「動き」を表現する
• 標難出力の一文字を1マスとする
• マスはスペースと'*'のどちらかであり、スペースは通れるところ(通路)とし、'*'は通れないところ(壁)とする
• キャラクターは'A'であらわす
• キャラクターの移動はつぎのキーで入力する
  • h: 左
  • j: 下
  • k: 上
  • l: 右
• 左上からはじめて、右下まで行ければゴールとする

さらに、ひとつ、ゲームの要素を追加する。

• 何回かは「壁」をすりぬけられるようにする
• hjklを大文字にしたHJKLを入力したとき、壁をすりぬけられる
• はじめ100ポイントあり、「すりぬけ」をするたびに10ポイント減算し、0ポイントになったら負けとする
• 迷路のフィールドは乱数演算によって生成する

モジュール構成

つぎの、ふたつのモジュールを作る。

• 関数mainを含むモジュール(maze.hs)
• モジュールField(Field.hs)

モジュールFieldで、迷路のデータの表現や、それに対してアクセスするための関数を定義する。

モジュールField

迷路をあらわすデータ構造

迷路を通路(False)と壁(True)からなる、リストのリストとして表現する。たとえば、つぎのようなフィールドを考える。

   **
*   *
**  *
***  

これは、つぎのようになる。

[       [False, False, False, True, True],
        [True, False, False, False, True],
        [True, True, False, False, True],
        [True, True, True, False, False] ]

キャラクターの位置を表現するには、(3, 5)のように座標で表現すればいい。しかし、ここでは、そうはしない。理由は、ここでは、説明しないが、フィールドをあらわすデータ構造に、現在位置の情報もうめこむ。そのために、それぞれのリストを、ふたつにわける。まずは、1行で考える。たとえば、つぎのようになっているとする。

* A *

このとき、この状態を、つぎのように表現する。

([False, True], [False, False, True])

キャラクターの左のマスは逆順で、ひとつめのリストとする。キャラクターのいるマスと、それより右のマスは、ふたつめのリストとする。キャラクターが右に移動したとする。

*  A*

データは、つぎのようになる。

([False, False, True], [False, True])

うしろのリストの先頭を取り、まえのリストの先頭に追加したかたちになる。さらに、たて方向にもおなじようにする。つぎのような状態を考える。

   **
* A *
**  *
***  

これは、つぎのようなデータになる。

(       [       ([False, False], [False, True, True]) ],
        [       ([False, True], [False, False, True]),
                ([True, True], [False, False, True]),
                ([True, True], [True, False, False]) ] )

モジュールFieldの作成

ファイルField.hsを、つぎのように作成する。

Field.hs

module Field where

import Data.Bool
import System.Random

モジュール宣言と必要なモジュールの導入をした。

フィールドの幅と高さ

フィールドの幅と高さとを定義しておく。

Field.hs

width = 40
height = 20

これをファイルField.hsに書き込もう。

関数toField

リストのリストを「現在位置を含むデータ構造」に変換する。はじめの「現在位置」は左上とする。ファイルField.hsに関数toFieldを定義する。

Field.hs

toField ls = ([], map (\l -> ([], l)) ls)

現在位置が左上なので、すべての行で左側は空リストになる。また、上にある行はないので、外側のタプルの、ひとつめの要素は、やはり空リストになる。

サンプルのフィールド

試しながら定義するための、サンプルのフィールドを用意する。

Field.hs

sample = [
        [False, False, False, True, True],
        [True, False, False, False, True],
        [True, True, False, False, True],
        [True, True, True, False, False] ]

これは、つぎのようなフィールドをあらわす。

   **
*   *
**  *
***  

関数toFieldでサンプルのフィールドを、「現在位地情報つきのフィールド」に変換する。

> :load Field.hs
> toField sample
([],[([False,False,False,True,True]),...

フィールドを表示する

フィールドを表示するために文字列化する。一行の左側を表示する関数showLを定義する。

Field.hs

showL = map (bool ' ' '*') . reverse

左側は要素が逆順になっているので、関数reverseでもとにもどす。そのうえで、すべての要素について、関数boolで、Falseなら' '、Trueなら'*'とする。右側を表示する関数showRは関数reverseを使わない。

Field.hs

showR = map (bool ' ' '*')

関数showLとshowRの定義をファイルField.hsに書き込む。つぎに、関数showLとshowRとを使って、1行を文字列化する関数showLineを定義する。

Field.hs

showLine (l, r) = showL l ++ showR r

これらを使ってフィールドを表示する関数showFieldを定義する。

Field.hs

showField (t, (l, _ : r) : b) = unlines $
        map showLine (reverse t) ++
        [showL l ++ "A" ++ showR r] ++
        map showLine b ++
        [replicate (width - 2) ' ' ++ "GOAL"]

tは上の行、lは左側、rは右側で、bは下の行を示す。最後に「GOAL」の表示も追加しておいた。サンプルのフィールドを表示してみよう。

> :reload
> putStr . showField $ toField sample
A  **
*   *
**  *
***  
                                      GOAL

フィールドを表示する関数putFieldを定義する。

Field.hs

putField = putStr . showField

試してみる。

> :reload
> putField $ toField sample
A  **
*   *
**  *
***  
                                      GOAL

キャラクターの移動

上下方向の移動

下方向に移動する関数downfを定義する。これは「壁か通路か」を判定せずに、壁であっても移動する関数だ。

Field.hs

downf (as, [h]) = (as, [h])
downf (as, h : bs) = (h : as, bs)

hが「現在いる行」である。「現在いる行」を「上の行」とすることで、下方向への移動を実現することができる。下の行がないときは、そのまま変化させない。試してみよう。

> putField . downf $ toField sample
   **
A   *
**  *
***  

キャラクター(A)が下に移動した(壁をすりぬけている)。GOALの表示は、ここでは省略する。上方向への移動関数を定義する。こちらも壁をすりぬける。

Field.hs

upf ([], hbs) = ([], hbs)
upf (a : as, hbs) = (as, a: hbs)

下方向への移動と、だいたいおなじだ。上の行(a)を現在の行にしている。試してみよう。

> :reload
> f = downf . downf $ toField sample
> putField f
   **
*   *
A*  *
***  
> putField $ upf f
   **
A   *
**  *
***  

左右方向の移動

左右方向の移動を実装するまえに、タプルの2要素に、おなじ変換をする関数を定義する。

Field.hs

mapTuple f (x, y) = (f x, f y)

試してみる。

> :reload
> mapTuple (map (\x -> x * 2)) ([1, 2, 3], [10, 20])
([2,4,6],[20,40])

関数mapTupleとmapとを組み合わせて、ふたつのリストの全要素に、おなじ変換をしている。右方向への移動関数rightfを定義する。

Field.hs

rightf = mapTuple . map $ \lhr -> case lhr of
        (_, [_]) -> lhr
        (ls, h : rs) -> (h : ls, rs)

「リストのタプル」の全要素に、「\lhr ->」以下の変換を適用している。「変換」は現在のマスを左に動かしている。試してみる。

> :reload
> putField . rightf $ toField sample
 A **
*   *
**  *
***  

左方向への移動関数leftfを定義する。

Field.hs

leftf = mapTuple . map $ \lhr -> case lhr of
        ([], _) -> lhr
        (l : ls, hrs) -> (ls, l : hrs)

試してみる。

> :reload
> f = rightf . rightf . rightf $ toField sample
> putField f
   A*
*   *
**  *
***  
> putField $ left f
  A**
*   *
**  *
***  

壁はすりぬけない

それぞれの移動の「壁をすりぬけないバージョン」を定義する。

Field.hs

[up, down, left, right] =
        map check [upf, downf, leftf, rightf]
        where check m f = case m f of
                (_, (_, True : _) : _) -> f
                f' -> f'

関数checkは移動さきが「壁」であったときに、移動しないようにする関数だ。リストリテラルパターンを使って、関数up, down, left, rightの4つを一気に定義している。試してみる。

> :reload
> f = toField sample
> putField $ down f
A  **
*   *
...
> putField $ right f
 A **
*   *
...

下方向への移動は「壁」なので、できない。右方向への移動は「通路」なので、できる。

フィールドの生成

ランダム関数を使ってフィールドを作る。つぎのような手順とする。

• ランダムなブール値の無限リストをつくる
• 先頭に4つのFalseを追加する
  • スタート地点から水平に4つを通路とするため
• width個ずつにわけて、リストのリストにする
• 先頭のheight個だけ取り出す

リストをn個ずつにわける関数divideを定義する。

Field.hs

divide _ [] = []
divide n xs = take n xs : divide n (drop n xs)

試してみる。

> :reload
> divide 3 [1, 2, 3, 4, 5, 6, 7]
[[1,2,3],[4,5,6],[7]]

整数値を引数としてフィールドを生成する関数fieldを定義する。

Field.hs

field = toField . take height . divide width
        . (\bs -> replicate 4 False ++ bs)
        . randoms . mkStdGen

試してみる。

> :reload
> putField $ field 8
(フィールドが表示される)

ゴールの判定

右下がゴールなので、ゴールを判定する関数goalは、つぎのようになる。

Field.hs

goal (_, [(_, [_])]) = True
goal _ = False

下に行がなく、右にマスがない状態だ。試してみる。

> :{
| f = rightf . rightf . rightf . rightf
|     . downf . downf . downf $ toField sample
| :}
> putField f
   **
*   *
**  *
*** A
> goal f
True
> goal $ upf f
False

メインモジュール

フィールドの用意と、キャラクターを動かすインターフェースができた。これらを使って、実際にゲームを動かしていく。

モジュールの導入

ファイルmaze.hsを、つぎのように用意する。

maze.hs

import Data.Bool
import Data.Char
import System.IO
import System.Environment

import Field

必要なモジュールを導入した。

コンパイルのテスト

仮の関数mainを用意しておく。

maze.hs

main = do
        putStrLn "dummy"

コンパイルしておこう。

% stack ghc -- -fno-warn-tabs maze.hs -o maze
% ./maze
dummy

はじめのポイント

100ポイントからはじめる。ポイントの初期値point0を定義する。

maze.hs

point0 = 100

キーの設定

キーと動きかたを関連づける関数moveを定義する。

maze.hs

move c = case c of
        'h' -> left
        'j' -> down
        'k' -> up
        'l' -> right
        'H' -> leftf
        'J' -> downf
        'K' -> upf
        'L' -> rightf
        _ -> \f -> f

大文字ならすりぬける。設定されていないキーでは、動かさない。

ゲーム画面の表示

ゲーム画面を表示する関数displayを定義する。

maze.hs

display p f = do
        putStrLn ""
        print p
        putField f

このあたりでコンパイルして、エラーをチェックしておく。

% stack ghc -- -fno-warn-tabs maze.hs -o maze
% ./maze
dummy

バッファリング

バッファリングを一時的に無効にする関数noBufferingを定義する。

maze.hs

noBuffering act = do
        bi <- hGetBuffering stdin
        hSetBuffering stdin NoBuffering
        act
        hSetBuffering stdin bi

まずは、「現在のバッファリングモード」を取得する。それから、バッファリングを無効にしてから、引数で取った動作(act)を実行し、バッファリングモードをもと(bi)にもどす。

ループ

「状態を更新しながら動作をくりかえす」関数loopを定義する。

maze.hs

loop s act = do
        ms' <- act s
        case ms' of
                Just s' -> loop s' act
                Nothing -> return ()

引数actで受け取った動作を実行する。その動作の結果はMaybe値ms'となる。ms'がJust値であるなら、なかみの「新しい状態」で、ループをくりかえす(loop s' act)。Maybe値ms'がNothing値だったら終了する(return ())。()はユニット値という特別な値であり、Haskellでは「意味のある値をかえさない」ときにしばしば利用される。

コンパイルエラーのチェック

ときどきコンパイルしてやることで、ケアレスミスをチェックすることができる。また、そのとき出力を変化させることで、コンパイルがエラー終了していないことを確認できる。関数mainで表示する文字を変更しておく。

maze.hs

main = do
        putStrLn "dummy 001"

コンパイルしてエラーをチェックする。

% stack ghc -- -fno-warn-tabs maze.hs -o maze
% ./maze
dummy 001

関数step

つぎに、キー入力したときの、ひとつのステップをあらわす関数stepを定義する。

maze.hs

step c p f = do
        display p' f'
        case (goal f', p' <= 0) of
                (_, True) -> do
                        putStrLn "YOU LOSE!"
                        return Nothing
                (True, False) -> do
                        putStrLn "YOU WIN!"
                        return Nothing
                (False, False) -> return $ Just (p', f')
        where
        p' = bool p (p - 10) (isUpper c)
        f' = move c f

まずwhere節をみよう。新しいポイントとフィールドとを作成し、それで変数p'とf'とを束縛している。do構文にもどり、うえからみていこう。まずは関数displayで新しい状態を表示する。そのあと、case文を使って「ゴールしたかどうか」「ポイントが0以下かどうか」をチェックする。ポイントが0以下なら「負け」であり、ゴールしていれば「勝ち」だ。どちらでもなければ、新しいポイントとフィールドをJust値にしてかえす。この関数stepは、関数loopの引数として使われることが想定されている。つまり、Just値をかえすということは、その値を「新しい状態」としてくりかえすことになる。

関数main

関数mainを定義する。

maze.hs

main = do
        n : _ <- getArgs
        let f0 = field $ read n
        display point0 f0
        noBuffering . loop (point0, f0) $ \(p, f) -> do
                c <- getChar
                case c of
                        'q' -> return Nothing
                        _ -> step c p f

まずは動作getArgsでコマンドライン引数を取得する。n : _というパターンにマッチさせることで、ひとつめの引数で変数nを束縛する。ここで、まだ説明していない構文要素が出てきたが、do記法のなかでletを使うと、ローカルな変数を定義することができる。ここではf0をフィールドの初期値として定義した。つぎに、はじめのポイントとフィールドを、関数displayで表示している。それから、ループにはいる。ループの全体を関数noBufferingの引数とすることで、ループ内ではバッファリングを行わないようにしている。関数loopの第1引数には「状態の初期値」が指定される。第2引数は「状態」を引数とする関数だ。do記法のなかで、まずはキー入力を取得している。case文では'q'キーでの終了をまずは処理したうえで、関数stepによって、ひとつずつのステップを実行させる。

コンパイルして、実行する

仮の関数mainは消しておく。コンパイルして、実行する。コマンドライン引数にあたえる数によって、異なるフィールドが選べる。

% stack ghc -- -fno-warn-tabs maze.hs -o maze
% ./maze 8