Scheme - Land of Scheme - テキストゲームのエンジンを作る(通り道を描写する)

Land of Lisp
(オライリージャパン)
M.D. Conrad Barski (著) 川合 史朗 (翻訳)
原書: Land of LISP
Learn to Program in Lisp, One Game at a Time!

開発環境

• OS X Yosemite - Apple (OS)
• Emacs(Text Editor)
• Scheme (プログラミング言語)
• kscheme, Gauche, GNU Guile (処理系)

Land of Lisp (M.D. Conrad Barski (著)、川合 史朗 (翻訳)、オライリージャパン)の5章(テキストゲームのエンジンを作る)、5.2(通り道を描写する)を Scheme で取り組んでみる。

5.2(通り道を描写する)

コード(Emacs)

(begin 
  (define print (lambda (x) (display x) (newline)))
  (newline)

  (define abs (lambda (x) (if (< x 0)
                              (* -1 x)
                              x)))
  (define square (lambda (x) (* x x)))
  (define average (lambda (x y) (/ (+ x y) 2)))
  (define assoc
    (lambda (obj alist)
      (if (null? alist)
          #f
          (let ((item (car alist)))
            (if (equal? obj (car item))
                item
                (assoc obj (cdr alist)))))))
  (define map
    (lambda (proc items)
      (if (null? items)
          (quote ())
          (cons (proc (car items))
                (map proc (cdr items))))))  
  (define sqrt
    (lambda (x)
      (define sqrt-iter
        (lambda (guess x)
          (if (good-enough? guess x)
              guess
              (sqrt-iter (improve guess x)
                         x))))
      (define good-enough?
        (lambda (guess x)
          (< (abs (- (square guess) x)) 0.001)))
      (define improve
        (lambda (guess x)
          (average guess (/ x guess))))
      (sqrt-iter 1.0 x)))

  ;; ここから
  (define *edges* (quote ((living-room (garden west door)
                                       (attic upstairs ladder))
                          (garden (living-room east door))
                          (attic (livving-room downstairs ladder)))))
  (define describe-path
    (lambda (edge)
      (quasiquote (There is a (unquote (caddr edge)) going (unquote (cadr edge))
                         from here.))))
  (print (describe-path (quote (garden west door))))

  (define describe-paths
    (lambda (location edges)
      (apply append (map describe-path (cdr (assoc location edges))))))
  (print (describe-paths (quote living-room) *edges*))

  (print (cdr (assoc (quote living-room) *edges*)))
  (print (map describe-path
              (quote ((garden west oor) (attic upstairs ladder)))))
  (print (map sqrt (list 1 2 3 4 5)))
  
  ;; Scheme では Common Lisp と違って、function オペレータを使う必要はない
  ;; Scheme では スコープ、変数の衝突、上書きに注意
  (print (map car (quote ((foo bar) (baz qux)))))  
  (print (let ((car cdr))
           (map car (quote ((foo bar) (baz qux))))))
  (print (let ((car cadr))
           (map car (quote ((foo bar) (baz qux))))))
  (print (map car (quote ((foo bar) (baz qux)))))
  
  (print (append (quote (mary had)) (quote (a)) (quote (little lamb))))
  (print (apply append (quote ((mary had) (a) (little lamb)))))

  (print (apply append (quote ((There is a door going west from here.)
                               (There is a ladder going upstairs from here.)))))
  (quote done))

入出力結果(Terminal(kscheme), REPL(Read, Eval, Print, Loop))

$ kscheme < sample2.scm
kscm> 
(There is a door going west from here.)
(There is a door going west from here. There is a ladder going upstairs from here.)
((garden west door) (attic upstairs ladder))
((There is a oor going west from here.) (There is a ladder going upstairs from here.))
(0.1e1 0.141421568627450980389e1 0.173214285714285714285e1 0.200000009292229466028e1 0.223606889564336372845e1)
(foo baz)
((bar) (qux))
(bar qux)
(foo baz)
(mary had a little lamb)
(mary had a little lamb)
(There is a door going west from here. There is a ladder going upstairs from here.)
done
kscm> $