gistfile1.txt

;;;;; 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)))))