exercise 4.32~34
最近進行が遅いorz。
まさに光陰なんとら。
・・・ていうか、このままだと4章終わんないよ(泣)
予定が潰れた一番の原因は某ゲームだが、そんなこと言っても始まらん。
それにゲームはゲームで楽しめたのだから、それを否定したくは無いしね。
exercise 4.32
cdrの部分だけでなくcarの部分も遅延されるので、遅延リストだけじゃなくて
木構造もできる。ということで実際に例を考えたのだがさっぱりおもしろい例
が思い浮かばん。
(define (make-tree entry left right) (cons entry (cons left (cons right '())))) (define (entry tree) (car tree)) (define (left tree) (car (cdr tree))) (define (right tree) (car (cdr (cdr tree)))) (define (add-tree t1 t2) (make-tree (+ (entry t1) (entry t2)) (add-tree (left t1) (left t2)) (add-tree (right t1) (right t2)))) (define sample-tree (make-tree 1 (add-tree sample-tree sample-tree) (add-tree sample-tree sample-tree)))
みたくすれば、自分自身を使って木構造ができてるのだが、例としてはさっぱり面白
くない。
うがー。何か良い例ないかなぁ。
くやしいけど思いつかんので次に移るか。
exercise 4.33
自分の例ではquoteに出会った場合、quoteされているオブジェクトが
a.シンボルの時 -> そのシンボルを返す。
b.ペアの時 -> consを用いた式に変換
(例: '(1 2) -> (cons 1 (cons 2 '())) )
というのをevalで判断している.つもり。
とりあえず以下がそのコード。これでええんかいな。
(define (quote->cons exp) (cond ((null? exp) (list 'quote ())) ((symbol? exp) (list 'quote exp)) ((not (pair? exp)) exp) (else (list 'cons (quote->cons (car exp)) (quote->cons (cdr exp)))))) (define (evalexp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) ;;ここらへんを変更 (let ((text (text-of-quotation exp))) ;;quoteとって (if (not (pair? text)) ;;ペアか判断。 text (eval (quote->cons text) env)))) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (eval (cond->if exp) env)) ((application? exp) ; clause from book (apply (actual-value (operator exp) env) (operands exp) env)) (else (error "Unknown expression type -- EVAL" exp))))
ちなみに実際にはevalとかapplyはちょこっと名前変えてます。
(gaucheで実行するため。そうしないとエラーになったり)
実行結果は以下。
gosh> (quote->cons '(1 2 3)) (cons 1 (cons 2 (cons 3 '()))) gosh> (quote->cons '(a b (c . d) e)) (cons 'a (cons 'b (cons (cons 'c 'd) (cons 'e '())))) gosh> (driver-loop) ;;; L-Eval input: (car '(1 2 3)) ;;; L-Eval value: 1
まぁ多分大丈夫でしょう。
exercise 4.34
この問題は結構悩んだ。もっと精進したいなぁ
まず無限リストを考慮しない場合、以下のようなコードになった。
cons-pair? -> オブジェクトがconsで作られた関数かチェック。(ここの部分
大丈夫なんだろか)
lazy-pair->pair -> lazy-pair,listをもとのschemeのリストに変換
(define (cons-pair? exp) (if (and (pair? exp) (pair? (cdr exp)) (pair? (cddr exp))) (equal? (list (car exp) (cadr exp) (caddr exp)) '(procedure (m) ((m x y)))) #f)) (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (actual-value input the-global-environment))) (announce-output output-prompt) (if (cons-pair? output) (display (lazy-pair->pair input)) (user-print output)))) (driver-loop)) (define (lazy-pair->pair exp) (let ((car (actual-value (list 'car exp) the-global-environment)) (cdr (actual-value (list 'cdr exp) the-global-environment))) (cons (if (cons-pair? car) (lazy-pair->pair (list 'car exp)) car) (if (cons-pair? cdr) (lazy-pair->pair (list 'cdr exp)) cdr))))
実行は省略。
さて、問題は無限リストな場合。
スマートな解放が思い浮かばんので、リストは決まった数までしか表示しない方向にした。
(以下の例だと10個)
もっとカッコよく解決したい・・・。
(define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (actual-value input the-global-environment))) (announce-output output-prompt) (if (cons-pair? output) (display (lazy-pair->pair input 10)) (user-print output)))) (driver-loop)) (define (lazy-pair->pair exp count) (if (= count 0) "..." (let ((car (actual-value (list 'car exp) the-global-environment)) (cdr (actual-value (list 'cdr exp) the-global-environment))) (cons (if (cons-pair? car) (lazy-pair->pair (list 'car exp) (- count 1)) car) (if (cons-pair? cdr) (lazy-pair->pair (list 'cdr exp) (- count 1)) cdr)))))
すごく・・・適当です。
とりあえず実行結果くらい晒しておく
gosh> (driver-loop) ;;; L-Eval input: (cons 1 2) ;;; L-Eval value: (1 . 2) ;;; L-Eval input: (cons 'a (cons 'b 'c)) ;;; L-Eval value: (a b . c) ;;; L-Eval input: (cons 1 (cons 2 (cons 3 '()))) ;;; L-Eval value: (1 2 3) ;;; L-Eval input: ones ;;; L-Eval value: (1 1 1 1 1 1 1 1 1 1 . ...) ;;; L-Eval input: integers ;;; L-Eval value: (1 2 3 4 5 6 7 8 9 10 . ...) ;;; L-Eval input: (solve (lambda (x) x) 1 0.1) ;;; L-Eval value: (1 1.1 1.2100000000000002 1.3310000000000002 1.4641000000000002 1.61051 1.7715610000000002 1.9487171 2.1435888100000002 2.357947691 . ...)
もっとうまくコードが書ければ良いのに・・・と思う今日この頃。
