指定した質問を満足する項目がデータベースに一つしかないときに成功する特殊形式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…

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…

データベースへの単純質問を示せ ;; a Ben Bitiddleに監督されているすべての人々 (supervisor ?x (Bitdiddle Ben)) ;; b 経理部門のすべての人々の名前と担当 (job ?x (accounting . ?type)) ;; c Slumervilleに住む人すべての名前と住所 (address ?x (Slum…

requireを特殊形式で実装する． (define (require? exp) (tagged-list? exp 'require)) (define (require-predicate exp) (cadr exp)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted…

permanent-set!でpairsに成功する組み合わせを束縛するが， (amb)で必ず失敗するので全ての成功する組み合わせをpairsに束縛する． 失敗継続が呼ばれ，if-failの第二引数のpairsが評価される． この時permanent-set!で束縛されているのでバックトラックで戻…

利用者が失敗を捉えることができるif-failを実装する． (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((assignment? exp) (analyz…

バックトラックで戻らないpermanent-set!の実装 ;; permanent-set! (define (analyze-permanent-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda (env succeed fail) (vproc env (lambda (val fa…

ランダムな順に探すrambを実装する． (use srfi-27) (define (random-car lst) (list-ref lst (random-integer (length lst)))) (define (rember item lst) (cond ((null? lst) '()) ((eq? (car lst) item) (cdr lst)) (else (cons (car lst) (rember item (…

(define true #t) (define false #f) ;; eval (define (ambeval exp env succeed fail) ((analyze exp) env succeed fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((v…

自然言語の構文解析用プログラムを少し改造するだけで文章の生成ができる． (define (an-element-of items) (require (not (null? items))) (amb (car items) (amb (cdr items)))) (define (parse-word word-list) (list (car word-list) (an-element-of (cd…