階乗とFibonacci計算機を机上シミュレート. ;; 再帰的な階乗計算を机上シミュレートする． (controller (assign continue (label fact-done)) fact-loop (test (op =) (reg n) (const 1)) (branch (label base-case)) ;; nと continue を退避し再帰呼び出し…

;; a 再帰的べき乗 (define (expt b n) (if (= n 0) 1 (* b (expt b (- n 1))))) (controller (assign continue (label expt-done)) expt-loop (test (op =) (reg n) (const 0)) (branch (label base-case)) (save continue) (save n) (assign n (op -) (reg…

１章でやったNewton法で求めるsqrt手続き． これをデータパス図で描き，レジスタ計算機言語で定義する． (define (sqrt n) (sqrt-iter 1.0 x)) (define (sqrt-iter guess x) (if (good-enough? guess x) guess (sqrt-iter (improve guess x) x))) (define (i…

5.01の反復的な階乗計算機をレジスト計算機言語使って記述する． (controller factorial (assign n (op read)) (assign product (const 1)) (assign counter (const 1)) test-b (test (op >) (reg counter) (reg n)) (branch (label factorial-done)) (assig…

簡略化して． (and (not A) B C)を(and B C (not A))に並び替えてからqevalしていく． 入れ子になっていた場合もqevalでまたcojoinに送られるので対処出来る． ただ問題文通りだと，必要な変数を満たす表明が現れたらすぐにnotを実行しなければいけないが，…

本文中のandはひとつ目の質問を満たす表明に対して次の質問を満たす表明をデータベースから探してくる． それを２つの質問をそれぞれ満たすストリームをまず作り， 矛盾がないようにそれらを組み合わせるconjoin特殊形式を実装する． (define (conjoin conju…

指定した質問を満足する項目がデータベースに一つしかないときに成功する特殊形式uniqueの実装． ;; streamの個数を調べる． (define (stream-length s) (let iter ((stream s) (count 0)) (if (stream-null? stream) count (iter (stream-cdr stream) (+ co…

;; negate, lisp-value, singleton-streamはflatten-streamを変更して直列にしても問題ないのではという問題 ;; 元のflatten-stream (define (flatten-stream stream) (if (stream-null? stream) the-empty-stream (interleave-delayed (stream-car stream) …

flatten-streamが明示的にdelayを使うのはなぜか． flatten-streamはストリームのストリームを引数にとる． 4.71と同じく引数のストリームの中に無限ストリームがあると評価が終わらずになにも印字されないため．

stream-appendだと最初のストリームが無限ストリームだった場合に次のストリームが評価されなくなる． なのでinterleaveにして交互に先頭の要素を評価することで，どちらかもしくは両方が無限ストリームの時に対応できるようにする．

;; 本文中のsimple-query (define (simple-query query-pattern frame-stream) (stream-flatmap (lambda (frame) (stream-append-delayed (find-assertions query-pattern frame) (delay (apply-rules query-pattern frame)))) frame-stream)) ;; 本文中のdi…

なかなか処理の流れがわからなかったのでコメントを多めにつけてみた． ;; 駆動ループ (define input-prompt ";;; Query input:") (define output-prompt ";;; Query result:") (define (prompt-for-input string) (newline) (newline) (display string) (ne…

call/ccの使い方はよくわかってないので自分で継続を渡します． (define (fib n) (fib/cc n (lambda (a b) (+ a b)))) (define (fib/cc n func) (cond ((= n 0) (func 0 0)) ((= n 1) (func 0 1)) (else (func (fib/cc (- n 1) func) (fib/cc (- n 2) func))…

4.4.4の論理型プログラミングの実装を評価すると以下のエラーが出ます． gosh> *** ERROR: Compile Error: cannot find "var" in ("/usr/local/Cellar/gauche/0.9.4/share/gauche-0.9/site/lib" "/usr/local/Cellar/gauche/0.9.4/share/gauche-0.9/0.9.4/lib…

本文中のadd-assertion!とadd-rules!のletの目的は何か． 問題文のadd-assertion!ではダメな理由を述べよ． ;; 本文中のadd-assertion! (define (add-assertion! assertion) (store-assertion-in-index assertion) (let ((old-assertions THE-ASSERTIONS)) (…

((great great grandson) adam Irad)のような質問ができるようにする． (rule (greatson-end ?x) (append-to-form ?u (grandson) ?x)) (rule ((grandson) ?x) (grandson ?x)) (rule ((great . ?rel) ?x ?y) (and (greatson-end ?rel) (son-of ?x ?z) (?rel ?z…

(define (my-reverse lst) (let iter ((lst lst) (result '())) (if (null? lst) result (iter (cdr lst) (cons (car lst) result))))) (rule (append-to-form () ?y ?y)) (rule (append-to-form (?u . ?v) ?y (?u . ?z)) (append-to-form ?v ?y ?z)) (rever…

フレームに質問の履歴をつけていく． 入力ストリームと出力ストリームの間で同じ質問(4.64でいう(outranked-by ?staff-person Boss)のような)があれば ループしていると判断して処理を中止するようにする．

重複したものをアキュムレートしてしまうのでこのままでは使えないことがわかった． 重複を削除するように変更すればよい．

(rule (wheel ?person) (and (supervisor ?middle-manager ?person) (supervisor ?x ?middle-manager))) wheelはまず?personにデータベースの先頭から人を束縛して，and以下を満たすかを試していく． なので Ben -> Oliver -> X alyssa -> Ben -> Oliver Fec…

(rule (outranked-by ?staff-person ?boss) (or (supervisor ?staff-person ?boss) (and (outranked-by ?middle-manager ?boss) (supervisor ?staff-person ?middle-manager)))) (outranked-by (Bitdiddle Ben) ?who) まずoutranked-byの?staff-personにBitd…

SはGの孫であるという規則の形式化 (rule (?son son-of ?dad) (or (son ?dad ?son) (and (wife ?dad ?mam) (son ?mam ?son)))) (rule (?grandson grandson-of ?granddad) (and (?parent son-of ?grandson) (?grandson son-of ?parent)))

;; last-pairに該当するルールを作る (rule (last-pair (?x) (?x))) (rule (last-pair? (?x . ?y) ?z) (last-pair? ?y ?z)) ;; 質問 (last-pair (3) (?x)) ;; ひとつ目の質問にマッチして ;; ?x=3となるので (last-pair (3) (3)) ;; と出力されるはず． ;; …

;; 先頭の２つの隣接関係 (rule (?x next-to ?y in (?x ?y . ?u))) ;; リストのcdrの隣接関係 ;; (1 2 3 4 5)だとvが1,zが(2 3 4 5).２行目で，zに対してもnext-toをやると読める． (rule (?x next-to ?y in (?v . ?z)) (?x next-to ?y in ?z)) ;; 質問 (?x …

最初の質問をすると近くに住む人の対になるので２つずつ表示される． (lives-near ?person-1 ?person2) ;; 例 (lives-near (Hacker Alyssa P) (Fect Cy D)) (lives-near (Fect Cy D) (Hacker Alyssa P)) これを防ぐために各人にIDを割り振る． ;; 例 (id (Bi…

(meeting accounting (Monday 9am)) (meeting administration (Monday 10am)) (meeting computer (Wednesday 3pm)) (meeting administration (Friday 1pm)) (meeting whole-company (Wednesday 4pm)) ;; a 金曜の朝に今日ある会議をすべて質問する (meeting …

ある人が，自分の勤める部署に勤める監督者がいない場合，その人をbig shotであるとする規則を定義する (rule (big-shot ?person) (and (job ?person (?division . rest)) (supervisor ?person ?boss) (job ?boss (?boss-division . rest2)) (not (same ?div…

;; jiroの仕事をtaroができるかどうか (rule (replacible ?person1 ?person2) (and (or (and (job ?person2 ?job2) (job ?person1 ?job2)) ;person2とperosn1の仕事が同じ (and (job ?person1 ?job1) (can-do-job ?job1 ?job2))) ;person1はperson2の仕事job…

;; 合成質問を形成する ;; a Ben Bitdiddleが監督している人すべての名前とその住所 (and (supervisor ?x (Bitdiddle Ben)) (address ?x ?y)) ;; b Ben Bitdiddleより給料が少ない人と，Ben Bitdiddleの給料 (and (salary (Bitdiddle Ben) ?Ben-amount) (sal…