Return Of イスカンダルのトーフ屋ゲーム

シリーズ(いつシリーズ化したんだ・笑)「イスカンダルのトーフ屋ゲーム」第3弾です。

まあ、今回は余談的に始めました。OOPスタイルでのSchemeでの「イスカンダルのトーフ屋ゲーム」の作成にかなり苦労したんで、フツーに関数型で書けばどうなるのか、自分で確かめてみたかったんですね。

作成自体は1日あれば終わったんですが、やっぱり慣れもあるし、ロジック的には同じの3回目だから、って事もあるんでしょうが、それでも「関数型で書く」ってのはやっぱ早いです。すぐ出来る。

加えるとテストがラクなんですよね。オブジェクトに対してメソッド呼び出して・・・ってのは、ぶっちゃけ、インタプリタでも書式がメンド臭いんで、結局「テストコード」を本体側に対して記述しないと色々とウザったい。
ある意味、テスト駆動開発ってOOP前提だよな、って気がしました。

なお、今回は原作者のページに置いてあるイスカンダルのトーフ屋ゲーム（ViViScript 版）～プロ仕様～の計算ロジックを参考にしてます。これ(と同じページに置いてあるオリジナル版)が原作者氏の書いたソースだ、って気づかなかったんですよね(笑)。実行形式が端末起動して遊べるようになってたから、まさか今公開してるのがエディタのマクロ言語で記述されてる、たぁ思いもよらなかったです(笑)。てっきりCかなんかで記述してると思い込んでました(爆)。

ってなわけで、初めましょうか。

ゲームに必要な大域変数の定義

まずはゲームに必要な大域変数を定義します。
関数型プログラミングではあまり大域変数使わない前提なのは確かなんですが、計算の過程に於いて、何らかのデータの「参照対象」が必要な場合があります。
重要なのは「参照の為に」定義するんであって、そのデータは絶対プログラム内では書き換えません。
まあ、そいつを引数で与えてやってもイイんですが、後に見ますが、スタイル的にはフツーのプログラミングに於ける「破壊的変更」を対象を新しく生成する事で避けてるんで、どうしても本体の引数が増えちゃうんですね。
ここで「大域変数」として定義した内容は、ゲーム全体に於いて使いまわされるけど、固定した値で変更する必要が生じないモノに限ってます。具体的には、

1. トーフのプロパティ(値段、製造コスト等)
2. Game-Overに達する目標金額

の二つです。今までの「イスカンダルのトーフ屋ゲーム」に於けるプログラミングを見てた人には、この二つはゲームを通して不変である、って事に気づくでしょう。
(ちなみに、ゲームに於いて表示される「文字列」も不変な故に大域変数対象になりますが、それは後にPrint部を作る際に定義しましょう。結局トータルでは3つの大域変数が必要となります。)

また、プログラム本体にこの手の「決まった数値」を埋め込むのは避けるべきだ、ってのも良く言われる事です。これらを関数の外側に出しておけば、ソースに手を入れて変更するのもラクですしね。

これら二つをトーフに於いては連想リスト、目標金額は単なる変数として定義します。

	;;;;; Game Over
	(define game-over 30000) ; ゲームオーバーの条件
	;;;;; トーフのデータ
	(define tofu '((price . 50) ; トーフの値段
	(cost . 40) ; トーフの製造コスト
	(sunny . 500) ; 晴れの時に売れる最大個数
	(cloudy . 300) ; 曇りの時に売れる最大個数
	(rainy . 100))) ; 雨の時に売れる最大個数

view raw game-over-value-and-tofu hosted with ❤ by GitHub

これで準備は万端です。ではまずはR->E->Pの順序に則って、まずはRead部から仕上げて行きましょうか。

Read (Parser 関数)

大まかなロジックは前回と全く同じなんですが、クラスに詰め込んだローカル関数を基本的には全部外に出してフツーの関数として再定義する事で、ソースは随分スッキリと読みやすくなります。
Common Lispに比べると、まあ、名前空間の衝突とか避ける為に、割にSchemeでは何でもかんでもローカル関数にしたがる傾向がありますが(実際、外人のCLerに「キミのコードはScheme臭い」って言われた事がある)、確かにローカル関数は場合によってはソースの可読性落としますね。
(ちなみに、基本的にはCLerはSchemer程ローカル関数は使わずに何でも大域的に定義したがるらしい。と言うのも「パッケージ機構」ってのがあって、名前空間の問題を仕様上回避するような仕掛けが施されている。反面そう言う大掛かりなシステムが"仕様上定義されてない"Schemeでは比較的神経質に関数を扱わざるを得ない。)
まあ、ケースバイケースなんですが、前回みたいに「ローカル関数の中にローカル関数定義」とかは多分やり過ぎなんで(笑)、そこまでするなら大域的に定義した方がスッキリするのは確かです。

なお、大まかな仕様は次の通りです。

1. Parser関数(以降Readとする)は6つの(!)引数を受け取り、その中のphase変数の値を見て挙動を変更する。
2. 変更される挙動とは...もういいやね、これ(笑)。
3. 基本的には、引数をそのまま6つの多値として返すが、入力値があった場合にはそれをpnに束縛する。

ではソースです。

	;;; Read
	(define (y-or-n? arg)
	; yes か no かに類する入力に対して
	; yes の場合は #t、 no の場合は #f を返す
	; 入力違反に対しては空リストを返す
	(letrec ((test
	; 入力されたシンボルを大文字シンボルに変換
	; yes に類する場合は #t
	; no に類する場合は #f
	; それら以外の場合は '() を返す
	(lambda (sym)
	(let ((upsym (string->symbol
	(string-upcase
	(symbol->string sym)))))
	(case upsym
	((Y YES) #t)
	((N NO) #f)
	(else '()))))))
	; body
	(if (symbol? arg)
	(test arg)
	'())))
	(define (input-integer arg limit)
	; 整数の入力しか受け付けない関数
	; 入力違反には空リストを返す
	(letrec ((test
	; 入力された整数が0からトーフを作れる
	; 最大値の間にあるか調べる
	; 最大値は環境を参照する
	; 入力違反には '() を返す
	(lambda (num)
	(if (<= 0 num limit)
	num
	'()))))
	; body
	(if (integer? arg)
	(test arg)
	'())))
	(define (parser phase player comp wr pn cn)
	; Read
	; 入力を受け取らなくても基本的には6つの値
	; phase、 player、 comp、 wr、 pn、 cn
	; を自動的に返し、これらは環境を参照してる
	; 入力は pn に束縛する
	(letrec-syntax ((iter
	; 出力用のループはローカルマクロでまとめてある
	(syntax-rules ()
	((_ (arg ...))
	(let loop ((i (arg ...)))
	(if (null? i)
	(loop (arg ...))
	(values phase player comp wr i cn)))))))
	(case phase
	((introduction instruction play-again?) (iter (y-or-n? (read))))
	((input-integer) (iter (input-integer (read) cn)))
	(else (values phase player comp wr pn cn)))))

view raw parser hosted with ❤ by GitHub

だいぶスッキリとして読みやすくなったのではないでしょうか。ローカル関数(letrec)も相変わらず使ってますが、やっぱ一つの関数内にネストが一個程度でやめておきたいもんですね。ローカル関数内ローカル関数は見た目には厳しすぎる。

ところで、実はここで前回までのプログラミングと大きく違う点があります。それは3つあって、

1. 環境を作る仕組みがない。
2. 環境は関数に引き渡される引数として表現される。
3. 従って、ReadにもPrintにも(言わせれば)環境が引数として渡される。

前にPython版から作り出した時、「環境はEvalのモンだしなぁ」ってこだわってたんですが、実はここに来てそんなこだわりは必要がない、って事に気づきました。以前はそこにこだわっていた為、クラス変数と言うポスト大域変数の書き換え、みたいな破壊的操作が必要になってたんですね。

しかしながら、ここに来て、環境を手渡しつつRead、Eval、Printの間でグルグル回す方が良いのではないか、と気づいた。つまり、どの環境の変数に対してどの関数が手を入れるのか明確にする方が大事な気がしてきたんです(言わばバケツリレー方式ですね・笑)。

基本的には環境に対して計算結果を返すのはEvalの役目です。それは変わりません。しかしRead部はどっちにしても入力値を手渡す、って限定に於いては環境に手を入れても良いのではないか。つまり、ここでは「入力情報」がある意味「環境」になっちゃった、って事ですね。

上にあげた6つの引数のうち、 pn ってのが入力値を保持する為の引数です。つまり、何らかの入力があった際には pn は Readが扱う、と言うルールが明確になったのです。

Eval (Interp関数)

前までだとやれこのデータをクラスで定義して・・・だったんですが、今回は全く必要がありません(笑)。サクサクと進みます(笑)。

Eval部も基本的には、前回の「ローカル関数だらけ」を分離したスタイルになっています。お陰で、Eval(Interp関数)が一体何を行ってるのか、明確になる。

1. Interp関数(Eval)は6つの引数を受け取る。
2. シンボルで表された変数phaseを見て適する関数を呼び出し、次のphaseを束縛する。
3. 変数 player はプレイヤーの持ち金である。加算減算が( calc 関数によって)返された場合は変数 player にその返り値を束縛する。
4. 変数 comp は対戦相手の持ち金である。加算減算が( calc 関数によって)返された場合は変数 comp にその返り値を束縛する。
5. 変数 wr は天気予報の値である。関数 weather-report の返り値を束縛する。
6. 変数 pn はReadが読み込んだ入力値である。計算に必要な場合、この値を見て評価するが、pn に対しては特に何も行わない。
7. 変数 cn は評価に於いて何らかのエクストラの情報が生じた場合(これは要するにPrintが要する情報になるが)この変数に評価結果を束縛する。
8. 以上の6つを多値による返り値として返す。

さて、こう見てみると、一応Read->Eval->Printループなんですが、内部的にはEvalがスタート地点で、Eval->Print->Readと言うカンジで回っていくのが分かるんじゃないでしょうか。あらゆるデータに関する「評価」は文字通りEval(interp関数)が行っているんです。

ではソースの方を。

	;;;;; Eval
	(define (comp-calc comp weather-report)
	; コンピュータが作るトーフの個数を天気予報から算出
	(letrec ((calc
	(lambda ()
	(cond ((>= (cdr (assq 'sunny weather-report)) 80) 500)
	((>= (cdr (assq 'rainy weather-report)) 20) 100)
	(else 300)))))
	; body
	(min (quotient comp (cdr (assq 'cost tofu))) (calc))))
	(define (weather-report prob1 prob2)
	; 天気予報を計算する関数
	; 返り値は連想リスト
	(let ((sunny (- 100 (max prob1 prob2)))
	(rainy (min prob1 prob2)))
	(let ((cloudy (- 100 sunny rainy)))
	`((sunny . ,sunny)
	(cloudy . ,cloudy)
	(rainy . ,rainy)))))
	(define (actual-weather weather-report tofu r)
	; 実際の天気を計算する関数
	; 天気予報を参照して計算する
	; 返り値は天気情報のシンボルと
	; 天気によるトーフの売上の最大値
	; の二つを多値として返す
	(cond ((< r (cdr (assq 'rainy weather-report)))
	(values 'rainy (cdr (assq 'rainy tofu))))
	((< r (+ (cdr (assq 'rainy weather-report))
	(cdr (assq 'cloudy weather-report))))
	(values 'cloudy (cdr (assq 'cloudy tofu))))
	(else
	(values 'sunny (cdr (assq 'sunny tofu))))))
	(define (calc seller n sold tofu)
	; トーフの売上から損益を計算する
	(+ seller (- (* (min sold n) (cdr (assq 'price tofu)))
	(* n (cdr (assq 'cost tofu))))))
	(define (test player comp game-over)
	; ゲームの勝者を計算する
	(letrec ((calc
	; プレイヤーの持ち金とコンピュータの持ち金から
	; 勝者を計算する
	(lambda ()
	(cond ((> player comp) 'you-win)
	((= player comp) 'even)
	(else 'you-lose)))))
	; body
	; 目標金額に達したかどうかチェックして真ならローカル関数
	; calc を呼び出す
	(and (or (>= player game-over) (>= comp game-over))
	(calc))))
	(define (interp phase player comp wr pn cn)
	; Eval
	; Read から与えられた6つの引数に従って評価を行うこのプログラムの心臓部
	; phase に対しては次のフェーズをセット
	; player と comp はそれぞれの持ち金を表す
	; wr は天気予報計算の結果を入れる変数
	; pn にはプレイヤーが入力した情報
	; cn には eval の評価値(もしあれば)
	; と、それぞれ束縛される
	; これらはその後、多値として Print に渡される
	(let-syntax ((initialize
	; コード中で初期化に必要なトコが3箇所あり、
	; メンドいんでローカルマクロ initialize として
	; まとめた
	(syntax-rules ()
	((_ player comp)
	(let ((prob0 (random-integer 100))
	(prob1 (random-integer 100)))
	(values 'input-integer player comp
	(weather-report prob0 prob1) pn
	(quotient player (cdr (assq 'cost tofu)))))))))
	; body
	(case phase
	((introduction) (if pn ; 'introduction 過程と 'instruction 過程は
	(values 'instruction player comp wr pn cn) ; 殆どコードが同じなんで、ローカルマクロにして
	(initialize player comp))) ; 纏めても良かったかもしんない。
	((instruction) (if pn
	(initialize player comp)
	(values phase player comp wr pn cn)))
	((input-integer) (let ((c (comp-calc comp wr)))
	(values 'opponent-turn player comp wr pn c)))
	((opponent-turn) (let ((prob (random-integer 100)))
	(let-values (((sym sold) (actual-weather wr tofu prob)))
	(values 'next-day (calc player pn sold tofu) (calc comp cn sold tofu) wr pn sym))))
	((next-day) (let ((fact (test player comp game-over)))
	(if fact
	(values 'show-winner player comp wr pn fact)
	(initialize player comp))))
	((show-winner) (values 'play-again? player comp wr cn pn))
	((play-again?) (if pn
	(initialize 5000 5000)
	(exit))) ; exit はRacket 実装依存
	(else (values 'introduction player comp wr pn cn)))))

view raw gistfile1.txt hosted with ❤ by GitHub

やっぱ分かりやすいと思います。Evalが必要とする個々の関数も全部小さいですし、ローカル関数で纏められすぎてるコードを読むよりゃやっぱラクですよねぇ。
一つあるトリックとしては、関数 actual-weather が多値を返してます。一つ目は一種フラグのシンボルで、このシンボルを使ってPrint関数が文字列情報をまとめた連想リストから適する表示形式を探してきます。つまり、変数 cn に束縛させるシンボルを返すと言うのが目的。二つ目はトーフデータが持つ「天気による最大売上個数」を連想リストから検索してて返してて、この結果はプレイヤーと対戦相手の「売上計算」に利用されてその後破棄されます。
このくらいですし、大したトリックでもないですね(笑)。まあ、多値利用しただけだった、ってばだけなんですが、意外と便利です(笑)。

Print 関数

さて、最後に Print 関数です。今回ははえぇなぁ(笑)。
最初に書きましたように、まずは表示に使うメッセージデータを連想リストとして纏めて大域変数としてまずは定義します。
実はこの辺、前回も指摘したんですが、SRFI-48で定義されてるFormatを使用すれば、書式の指定子込みでデータを作れるんで、もっと簡単になるでしょう。
今回もPrintが利用してる関数は、わざわざ整形演算を行う為に書いたモノが殆どで、format 前提なら殆ど本体だけで間に合う、って言っても過言じゃないと思います。

1. Print 関数は6つの引数を取る関数である。
2. ただし、印字を出力後、この6つの引数を多値としてそのまま返し、引数に対する操作は一切行わない(これがまさしく印字が副作用的性質である事の証明・笑)
3. 基本的には、phase 引数を見て適した文字列を連想リストとして設計された message データから検索してくる。
4. 出力に必要であれば、cn 変数を用いる。

これだけ、です。コードがそれにすれば分量が若干多いように見えますが、もう一度言いますが、SRFI-48でのformatとか利用すれば殆ど Print 関数本体だけで仕事をやっつけちゃえるのです。

(恐らく連想リストの設計さえも、phase と一対一対応で、理想的には phase を利用して検索して表示するだけ、までに構造的には絞り込めると思います。Lispのシンボルの有用性の証明になる気がします。)

ではソースです。

	;;;;; Print
	(define messages
	; ゲームで使われる文字列のデータ
	'((yen . " 円 ")
	(1000-yen . #\■)
	(empty-yen . #\□)
	(space . #\space)
	(introduction . "イスカンダルのトーフ屋ゲーム(Scheme 関数プログラミング 版)\n
	Copyright (c) 1978 - 2014 by Nobuhide Tsuda\n\n
	ルール説明しますか?[y/n]")
	(instruction . "ここはイスカンダル星。あなたはここでトーフ屋を経営し、\n
	地球への帰還費用を作り出さなくてはいけません。\n
	でもお向かいには、コンピュータが経営するトーフ屋があります。。。\n\n
	トーフの原価は1個40円、販売価格は50円です。\n
	1日に売れる個数は天候に左右されます。\n
	晴れると500個、くもりだと300個、雨のときは100個まで売れます。\n
	トーフは日持ちしないので、売れ残った分はすべて廃棄します。\n
	そこで、次の日の天気予報をよく見て、何個作るか決心してください。\n
	所持金5千円からはじめて早く3万円を超えた方が勝ちです。\n\n
	いいですか?[y/n]\n")
	(money . "\n所持金:\n")
	(player . "あなた")
	(comp . #("わたし" "わたしは "))
	(sunny . #("\n明日の天気予報: 晴れ " #\◎ " 晴れ \\(^o^)/ "))
	(cloudy . #( "% くもり " #\・ " くもり (~_~) "))
	(rainy . #("% 雨 " #\● " 雨 (;_;) "))
	(percent . "%")
	(howmany-tofus? . "\nトーフを何個作りますか?(1~")
	(kokka . ")")
	(makes . "個 作ります。\n")
	(next-day . "***** 次の日 *****")
	(weather . "今日の天気は")
	(period . ".")
	(is . " です。")
	(you-win . "\nあなたの勝ちです。")
	(even . "\n引き分けです。")
	(you-lose . "\nコンピュータの勝ちです。")
	(play-again? . "\nplay again ? [y/n]")
	))
	(define (show-money player comp data)
	; プレイヤーとコンピュータの持ち金の文字列整形
	; 本当はSRFIのformatを使えばもっと簡単に書ける
	(letrec ((calc
	; プレイヤーとコンピュータの持ち金の表示用文字列整形
	(lambda (name gold)
	(letrec ((format
	; 数値用文字列整形
	(lambda ()
	(cond ((> gold 9999) 1)
	((> gold 999) 2)
	((> gold 99) 3)
	(else 4))))
	(spaces
	; 数値を揃える為のスペース整形
	(lambda (num)
	(make-string num (cdr (assq 'space data)))))
	(calc
	; 持ち金のグラフィック部分の整形
	(lambda ()
	(let ((x (quotient gold 1000)))
	(let ((y (- 30 x)))
	(string-append
	(make-string x (cdr (assq '1000-yen data)))
	(make-string y (cdr (assq 'empty-yen data)))))))))
	; calc の body
	(string-append (spaces 2)
	(let ((n (cdr (assq name data))))
	(if (vector? n)
	(vector-ref n 0)
	n))
	(spaces 1)
	(spaces (format))
	(number->string gold)
	(cdr (assq 'yen data))
	(calc)
	"\n")))))
	; body
	(string-append (cdr (assq 'money data))
	(calc 'player
	player)
	(calc 'comp
	comp))))
	(define (show-weather-report wr data)
	; 天気予報表示の文字列整形
	; 本当はSRFIのformat を使うともっと簡単に書ける
	(letrec ((calc0
	; パーセンテージ表示用
	(lambda (keys)
	(let ((s0 (map (lambda (k)
	(vector-ref
	(cdr (assq k data)) 0)) keys))
	(s1 (map (lambda (k)
	(number->string
	(cdr (assq k wr))))
	keys)))
	(string-append (string-concatenate
	(map string-concatenate (zip s0 s1)))
	(cdr (assq 'percent data))
	"\n"))))
	(calc1
	; グラフィック表示用
	(lambda (keys)
	(let ((nums (map (lambda (k)
	(quotient
	(* (cdr (assq k wr)) 10) 25))
	keys)))
	(string-concatenate
	(map (lambda (k n)
	(make-string n
	(vector-ref (cdr (assq k data)) 1)))
	keys nums))))))
	; body
	(let ((keys '(sunny cloudy rainy)))
	(string-append (calc0 keys) (calc1 keys)))))
	(define (ask-howmany-tofu num data)
	; いくつトーフを作るのか尋ねる
	(string-append (cdr (assq 'howmany-tofus? data))
	(number->string num)
	(cdr (assq 'kokka data))))
	(define (computer-reply num data)
	; コンピュータの反応表示
	(string-append (vector-ref (cdr (assq 'comp data)) 1)
	(number->string num)
	(cdr (assq 'makes data))))
	(define (show-weather-is sym data)
	; 実際の天気を表示
	(let ((keys `(weather period period period ,sym is)))
	(map (lambda (k)
	(let ((v (cdr (assq k data))))
	(if (vector? v)
	(vector-ref v 2)
	v))) keys)))
	(define (show-winner key data)
	; 勝者を表示
	(cdr (assq key data)))
	(define (print phase player comp wr pn cn)
	; Print
	; 表示だけじゃなくって、 Eval から渡された6つの引数、
	; phase、 player、 comp、 wr、 pn、 cn を
	; そのまま返す
	(for-each (lambda (x)
	(sleep 0.5) ; Racket 実装依存
	(display x))
	(case phase
	((input-integer) `(,(string-append (show-money player comp messages)
	(show-weather-report wr messages)
	(ask-howmany-tofu cn messages))))
	((opponent-turn) `(,(computer-reply cn messages)))
	((next-day) (show-weather-is cn messages))
	((show-winner) `(,(show-winner cn messages)))
	(else `(,(cdr (assq phase messages))))))
	(values phase player comp wr pn cn))

view raw print hosted with ❤ by GitHub

とこれで、Read、Eval、Printの全てのパーツが「関数型プログラミングを使って」組みあがりました。(もっともHaskellな人達は簡単に出力を扱える事に違和感があるでしょうが・笑)
あとはREPLを組むだけ、ですね。

Read-Eval-Print-Loop

REPLは次のように末尾再帰な関数として書いて、実行時に適切な引数をREPL関数に渡す事でゲームが動きます。

	;;;;; REPL (Read-Eval-Print-Loop)
	(define (repl phase player comp wr pn cn)
	(let-values (((r0 r1 r2 r3 r4 r5) (parser phase player comp wr pn cn)))
	(let-values (((e0 e1 e2 e3 e4 e5) (interp r0 r1 r2 r3 r4 r5)))
	(let-values (((p0 p1 p2 p3 p4 p5) (print e0 e1 e2 e3 e4 e5)))
	(repl p0 p1 p2 p3 p4 p5))))) ; ここで末尾再帰
	(repl #f 5000 5000 #f 0 0) ; 初期状態を適当に渡して起動

view raw eval hosted with ❤ by GitHub

まあ、多値を6つも返す関数が3つもあるんで物凄い事になってるんですが(笑)、基本的には簡単ですね。関数REPLは末尾再帰で呼び出された際に、最終的にPrintが渡した値を引数として持って、延々と無限ループへと突入するわけです(笑)。Evalが(exit)命令を出すまでこの動きは止まりません(笑)。

なお、phase の初期値として #f を渡してるのは、初期状態で、 #f はParser 関数( Read ) 本体のcase 構文内で「else」として認識され、そのまま「何もせずに」 interp 関数に全引数を渡すからです。
続いて、interp 関数は phase = #f を見て、やはり本体の case 構文内で else として処理され、ここで初めて、phase にシンボル 'introduction が返り値の一つとして束縛されるわけです。
つまり、初期状態で phase に与える値はゲーム中で使われてないブツなら何でも良くって(あるいは意図的に「途中から」始める事も可能) 結果、伝統的で単純な #f を与えてみました。
ちなみにそうなると、最初の Read -> Print 間は全く何もしてないに等しくて、引数与えるのは「REPLをビックリさせて起動させる」に等しいです(笑)。また、先ほどにも書きましたが、内部的にはE->P->Rの順に処理が進んでいく、ってのは全くそのままの意味です。

非破壊的なゲーム構造

まあ、ちょっとしたシャレで始めたこのヴァージョンだったんですが、面白い事に気づきました。
実は、REPLで末尾再帰が呼び出される際に、与えられる引数はPrintの返り値です。
んで、実はこのプログラムの中では「一回も」普通のプログラミングで言う「代入」は行われていないんですね。つまり「直接変数を書き換える」と言う事は一切行っていない。
特にEvalの動作なんですが、

1. 引数を参照する
2. 基本的には「操作」は新しい値を「作る」
3. 他のケースでは「与えられた引数を参照して」(要するに)コピーしてる
4. 結果、返り値は元のデータではなく新しいデータである。

この「コピーして」「新しいデータを作る」ってのが言わば関数型プログラミングのキモなんですよね。じゃあ参照に使われた古い引数はどうなるのか、っつーと、参照されなくなった時点でGC(ガベージコレクタ)がやってきて回収・廃棄処分です(笑)。

これは実はReadにせよPrintにせよ、「コピーして新しいデータを作ってる」ってのは同じです。「書き換え」ではないんです。

まあ、こんなこたぁ関数型言語に詳しい人には釈迦に説法なんですが、ちと待てよ、と。こんな事が出来るなら恐らく「非破壊的に」データ生成し続けてゲームを作れるモデル、例えば理論的にはRPGなんかも作れるんじゃないか、って思ったんですね。で、多分それは可能でしょう。

以前、関数型プログラミングは机上の空論なんじゃないか、って実は失望してたんですが、ひょいとしたキッカケで実用上OKなんじゃないか、って思えるようになったのは大収穫でした。

つまり、上のREPLのような関数を設計して、参照する環境として引数(例えばRPGで言うとプレイヤー情報とか)を与えて、内部的にはコピーして元データには一切手をかけない。そうすれば「非破壊的なプログラム構造を持った」関数型による関数型の為の関数型のゲームが作成可能だ、って光明が見えたんですよね。

引き続きこのテーマを研究してみたいと思います。言い換えると、例えばOOPモデルでさえ(プログラミング言語の末尾再帰の最適化が保証されていれば)インスタンス変数を「書き換える」のではなくって「新しいインスタンスを」常に生成するモデルも可能だろう、って事ですから。

では今回の全ソースコードです。

	#lang racket
	;;;;; made on PLT Racket
	;;;;; Racket:
	;;;;; http://racket-lang.org/
	; Racket 実装依存
	; 他の処理系の場合、SRFI(Schemeの共有ライブラリ)を呼び出すには
	; Gauche: http://practical-scheme.net/gauche/index-j.html
	; (use srfi-1) ...
	; Guile: http://www.gnu.org/software/guile/
	; (srfi srfi-1) ...
	; 等に書き換える
	(require srfi/1 srfi/11 srfi/13 srfi/27)
	;;;;; 乱数の初期化
	(random-source-randomize! (make-random-source))
	;;;;; ダミーデータ
	;
	;(define player 5000)
	;(define comp 5000)
	;;;;; Game Over
	(define game-over 30000) ; ゲームオーバーの条件
	;;;;; トーフのデータ
	(define tofu '((price . 50) ; トーフの値段
	(cost . 40) ; トーフの製造コスト
	(sunny . 500) ; 晴れの時に売れる最大個数
	(cloudy . 300) ; 曇りの時に売れる最大個数
	(rainy . 100))) ; 雨の時に売れる最大個数
	;;;;; Print
	(define messages
	; ゲームで使われる文字列のデータ
	'((yen . " 円 ")
	(1000-yen . #\■)
	(empty-yen . #\□)
	(space . #\space)
	(introduction . "イスカンダルのトーフ屋ゲーム(Scheme 関数プログラミング 版)\n
	Copyright (c) 1978 - 2014 by Nobuhide Tsuda\n\n
	ルール説明しますか?[y/n]")
	(instruction . "ここはイスカンダル星。あなたはここでトーフ屋を経営し、\n
	地球への帰還費用を作り出さなくてはいけません。\n
	でもお向かいには、コンピュータが経営するトーフ屋があります。。。\n\n
	トーフの原価は1個40円、販売価格は50円です。\n
	1日に売れる個数は天候に左右されます。\n
	晴れると500個、くもりだと300個、雨のときは100個まで売れます。\n
	トーフは日持ちしないので、売れ残った分はすべて廃棄します。\n
	そこで、次の日の天気予報をよく見て、何個作るか決心してください。\n
	所持金5千円からはじめて早く3万円を超えた方が勝ちです。\n\n
	いいですか?[y/n]\n")
	(money . "\n所持金:\n")
	(player . "あなた")
	(comp . #("わたし" "わたしは "))
	(sunny . #("\n明日の天気予報: 晴れ " #\◎ " 晴れ \\(^o^)/ "))
	(cloudy . #( "% くもり " #\・ " くもり (~_~) "))
	(rainy . #("% 雨 " #\● " 雨 (;_;) "))
	(percent . "%")
	(howmany-tofus? . "\nトーフを何個作りますか?(1~")
	(kokka . ")")
	(makes . "個 作ります。\n")
	(next-day . "***** 次の日 *****")
	(weather . "今日の天気は")
	(period . ".")
	(is . " です。")
	(you-win . "\nあなたの勝ちです。")
	(even . "\n引き分けです。")
	(you-lose . "\nコンピュータの勝ちです。")
	(play-again? . "\nplay again ? [y/n]")
	))
	(define (show-money player comp data)
	; プレイヤーとコンピュータの持ち金の文字列整形
	; 本当はSRFIのformatを使えばもっと簡単に書ける
	(letrec ((calc
	; プレイヤーとコンピュータの持ち金の表示用文字列整形
	(lambda (name gold)
	(letrec ((format
	; 数値用文字列整形
	(lambda ()
	(cond ((> gold 9999) 1)
	((> gold 999) 2)
	((> gold 99) 3)
	(else 4))))
	(spaces
	; 数値を揃える為のスペース整形
	(lambda (num)
	(make-string num (cdr (assq 'space data)))))
	(calc
	; 持ち金のグラフィック部分の整形
	(lambda ()
	(let ((x (quotient gold 1000)))
	(let ((y (- 30 x)))
	(string-append
	(make-string x (cdr (assq '1000-yen data)))
	(make-string y (cdr (assq 'empty-yen data)))))))))
	; calc の body
	(string-append (spaces 2)
	(let ((n (cdr (assq name data))))
	(if (vector? n)
	(vector-ref n 0)
	n))
	(spaces 1)
	(spaces (format))
	(number->string gold)
	(cdr (assq 'yen data))
	(calc)
	"\n")))))
	; body
	(string-append (cdr (assq 'money data))
	(calc 'player
	player)
	(calc 'comp
	comp))))
	(define (show-weather-report wr data)
	; 天気予報表示の文字列整形
	; 本当はSRFIのformat を使うともっと簡単に書ける
	(letrec ((calc0
	; パーセンテージ表示用
	(lambda (keys)
	(let ((s0 (map (lambda (k)
	(vector-ref
	(cdr (assq k data)) 0)) keys))
	(s1 (map (lambda (k)
	(number->string
	(cdr (assq k wr))))
	keys)))
	(string-append (string-concatenate
	(map string-concatenate (zip s0 s1)))
	(cdr (assq 'percent data))
	"\n"))))
	(calc1
	; グラフィック表示用
	(lambda (keys)
	(let ((nums (map (lambda (k)
	(quotient
	(* (cdr (assq k wr)) 10) 25))
	keys)))
	(string-concatenate
	(map (lambda (k n)
	(make-string n
	(vector-ref (cdr (assq k data)) 1)))
	keys nums))))))
	; body
	(let ((keys '(sunny cloudy rainy)))
	(string-append (calc0 keys) (calc1 keys)))))
	(define (ask-howmany-tofu num data)
	; いくつトーフを作るのか尋ねる
	(string-append (cdr (assq 'howmany-tofus? data))
	(number->string num)
	(cdr (assq 'kokka data))))
	(define (computer-reply num data)
	; コンピュータの反応表示
	(string-append (vector-ref (cdr (assq 'comp data)) 1)
	(number->string num)
	(cdr (assq 'makes data))))
	(define (show-weather-is sym data)
	; 実際の天気を表示
	(let ((keys `(weather period period period ,sym is)))
	(map (lambda (k)
	(let ((v (cdr (assq k data))))
	(if (vector? v)
	(vector-ref v 2)
	v))) keys)))
	(define (show-winner key data)
	; 勝者を表示
	(cdr (assq key data)))
	(define (print phase player comp wr pn cn)
	; Print
	; 表示だけじゃなくって、 Eval から渡された6つの引数、
	; phase、 player、 comp、 wr、 pn、 cn を
	; そのまま返す
	(for-each (lambda (x)
	(sleep 0.5) ; Racket 実装依存
	(display x))
	(case phase
	((input-integer) `(,(string-append (show-money player comp messages)
	(show-weather-report wr messages)
	(ask-howmany-tofu cn messages))))
	((opponent-turn) `(,(computer-reply cn messages)))
	((next-day) (show-weather-is cn messages))
	((show-winner) `(,(show-winner cn messages)))
	(else `(,(cdr (assq phase messages))))))
	(values phase player comp wr pn cn))
	;;;;; Eval
	(define (comp-calc comp weather-report)
	; コンピュータが作るトーフの個数を天気予報から算出
	(letrec ((calc
	(lambda ()
	(cond ((>= (cdr (assq 'sunny weather-report)) 80) 500)
	((>= (cdr (assq 'rainy weather-report)) 20) 100)
	(else 300)))))
	; body
	(min (quotient comp (cdr (assq 'cost tofu))) (calc))))
	(define (weather-report prob1 prob2)
	; 天気予報を計算する関数
	(let ((sunny (- 100 (max prob1 prob2)))
	(rainy (min prob1 prob2)))
	(let ((cloudy (- 100 sunny rainy)))
	`((sunny . ,sunny)
	(cloudy . ,cloudy)
	(rainy . ,rainy)))))
	(define (actual-weather weather-report tofu r)
	; 実際の天気を計算する関数
	; 天気予報を参照して計算する
	(cond ((< r (cdr (assq 'rainy weather-report)))
	(values 'rainy (cdr (assq 'rainy tofu))))
	((< r (+ (cdr (assq 'rainy weather-report))
	(cdr (assq 'cloudy weather-report))))
	(values 'cloudy (cdr (assq 'cloudy tofu))))
	(else
	(values 'sunny (cdr (assq 'sunny tofu))))))
	(define (calc seller n sold tofu)
	; トーフの売上から損益を計算する
	(+ seller (- (* (min sold n) (cdr (assq 'price tofu)))
	(* n (cdr (assq 'cost tofu))))))
	(define (test player comp game-over)
	; ゲームの勝者を計算する
	(letrec ((calc
	; プレイヤーの持ち金とコンピュータの持ち金から
	; 勝者を計算する
	(lambda ()
	(cond ((> player comp) 'you-win)
	((= player comp) 'even)
	(else 'you-lose)))))
	; body
	(and (or (>= player game-over) (>= comp game-over))
	(calc))))
	(define (interp phase player comp wr pn cn)
	; Eval
	; Read から与えられた6つの引数に従って評価を行うこのプログラムの心臓部
	; phase に対しては次のフェーズをセット
	; player と comp はそれぞれの持ち金を表す
	; wr は天気予報計算の結果を入れる変数
	; pn にはプレイヤーが入力した情報
	; cn には eval の評価値(もしあれば)
	; と、それぞれ束縛される
	; これらはその後、多値として Print に渡される
	(let-syntax ((initialize
	; コード中で初期化に必要なトコが3箇所あり、
	; メンドいんで initialize とローカルマクロとして
	; まとめた
	(syntax-rules ()
	((_ player comp)
	(let ((prob0 (random-integer 100))
	(prob1 (random-integer 100)))
	(values 'input-integer player comp
	(weather-report prob0 prob1) pn
	(quotient player (cdr (assq 'cost tofu)))))))))
	; body
	(case phase
	((introduction) (if pn
	(values 'instruction player comp wr pn cn)
	(initialize player comp)))
	((instruction) (if pn
	(initialize player comp)
	(values phase player comp wr pn cn)))
	((input-integer) (let ((c (comp-calc comp wr)))
	(values 'opponent-turn player comp wr pn c)))
	((opponent-turn) (let ((prob (random-integer 100)))
	(let-values (((sym sold) (actual-weather wr tofu prob)))
	(values 'next-day (calc player pn sold tofu) (calc comp cn sold tofu) wr pn sym))))
	((next-day) (let ((fact (test player comp game-over)))
	(if fact
	(values 'show-winner player comp wr pn fact)
	(initialize player comp))))
	((show-winner) (values 'play-again? player comp wr cn pn))
	((play-again?) (if pn
	(initialize 5000 5000)
	(exit))) ; exit はRacket 実装依存
	(else (values 'introduction player comp wr pn cn)))))
	;;; Read
	(define (y-or-n? arg)
	; yes か no かに類する入力に対して
	; yes の場合は #t、 no の場合は #f を返す
	; 入力違反に対しては空リストを返す
	(letrec ((test
	; 入力されたシンボルを大文字シンボルに変換
	; yes に類する場合は #t
	; no に類する場合は #f
	; それら以外の場合は '() を返す
	(lambda (sym)
	(let ((upsym (string->symbol
	(string-upcase
	(symbol->string sym)))))
	(case upsym
	((Y YES) #t)
	((N NO) #f)
	(else '()))))))
	; body
	(if (symbol? arg)
	(test arg)
	'())))
	(define (input-integer arg limit)
	; 整数の入力しか受け付けない関数
	; 入力違反には空リストを返す
	(letrec ((test
	; 入力された整数が0からトーフを作れる
	; 最大値の間にあるか調べる
	; 最大値は環境を参照する
	; 入力違反には '() を返す
	(lambda (num)
	(if (<= 0 num limit)
	num
	'()))))
	; body
	(if (integer? arg)
	(test arg)
	'())))
	(define (parser phase player comp wr pn cn)
	; Read
	; 入力を受け取らなくても基本的には6つの値
	; phase、 player、 comp、 wr、 pn、 cn
	; を自動的に返し、これらは環境を参照してる
	; 入力は pn に束縛する
	(letrec-syntax ((iter
	; 出力用のループはローカルマクロでまとめてある
	(syntax-rules ()
	((_ (arg ...))
	(let loop ((i (arg ...)))
	(if (null? i)
	(loop (arg ...))
	(values phase player comp wr i cn)))))))
	(case phase
	((introduction instruction play-again?) (iter (y-or-n? (read))))
	((input-integer) (iter (input-integer (read) cn)))
	(else (values phase player comp wr pn cn)))))
	;;;;; REPL (Read-Eval-Print-Loop)
	(define (repl phase player comp wr pn cn)
	(let-values (((r0 r1 r2 r3 r4 r5) (parser phase player comp wr pn cn)))
	(let-values (((e0 e1 e2 e3 e4 e5) (interp r0 r1 r2 r3 r4 r5)))
	(let-values (((p0 p1 p2 p3 p4 p5) (print e0 e1 e2 e3 e4 e5)))
	(repl p0 p1 p2 p3 p4 p5)))))
	(repl #f 5000 5000 #f 0 0)

view raw TofuSellersInIscandarFn hosted with ❤ by GitHub