三分's profile3fen's NotebookPhotosBlogListsMore ![]() | Help |
|
September 10 SICP 4.3.2Section 4.3.2 4.38 此处中译版出错:原文"Modify the multiple-dwelling procedure to omit the requirement that Smith and Fletcher do not live on adjacent floors." 翻译"增加斯迈尔和弗莱舍不住相邻层的要求。" 把omit翻译成了"增加"。 题目答案明显:去掉(require (not (= (abs (- fletcher smith)) 1)))这一句即可。 结果有5条: ((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5)) ((baker 1) (cooper 2) (fletcher 4) (miller 5) (smith 3)) ((baker 1) (cooper 4) (fletcher 2) (miller 5) (smith 3)) ((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1)) ((baker 3) (cooper 4) (fletcher 2) (miller 5) (smith 1)) 4.39 有关系。题目中一共会通过一系列require检测5^5种情况。改变require语句的顺序就可以调节每次检测的速度,也就是把限制性强、检测起来快的原则放在前面,其余放在后面。比如(require (distinct? (list baker cooper fletcher miller smith)))这条语句就应该放在后面。 通过实验验证:把current-inexact-milliseconds放入求解过程中,用来观测运行时间。 (define (multiple-dwelling) (let ((former-time (current-inexact-milliseconds)) (baker (amb 1 2 3 4 5)) (cooper (amb 1 2 3 4 5)) (fletcher (amb 1 2 3 4 5)) (miller (amb 1 2 3 4 5)) (smith (amb 1 2 3 4 5))) (require (not (= fletcher 5))) (require (not (= fletcher 1))) (require (not (= baker 5))) (require (not (= cooper 1))) (require (> miller cooper)) (require (not (= (abs (- smith fletcher)) 1))) (require (not (= (abs (- fletcher cooper)) 1))) (require (distinct? (list baker cooper fletcher miller smith))) (display (- (current-inexact-milliseconds) former-time)) (list (list 'baker baker) (list 'cooper cooper) (list 'fletcher fletcher) (list 'miller miller) (list 'smith smith)))) 结果: ;;;Starting a new problem 360.0 ;;;Amb-Eval value: ((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1)) 而原过程所需时间为500左右,猜测正确。 4.40 (define (multiple-dwelling) (let ((former-time (current-inexact-milliseconds)) (baker (amb 1 2 3 4 5))) (require (not (= baker 5))) (let ((cooper (amb 1 2 3 4 5))) (require (not (= cooper 1))) (let ((fletcher (amb 1 2 3 4 5))) (require (not (= fletcher 5))) (require (not (= fletcher 1))) (require (not (= (abs (- fletcher cooper)) 1))) (let ((miller (amb 1 2 3 4 5))) (require (> miller cooper)) (let ((smith (amb 1 2 3 4 5))) (require (not (= (abs (- smith fletcher)) 1))) (require (distinct? (list baker cooper fletcher miller smith))) (display (- (current-inexact-milliseconds) former-time)) (list (list 'baker baker) (list 'cooper cooper) (list 'fletcher fletcher) (list 'miller miller) (list 'smith smith)))))))) 这就和我们做题的思路比较像了——用判断条件直接排除掉一系列情况,而不是把所有情况列举出来一个个筛选。 效果也是很明显,47.0,比上一题中的360.0快了不少。 4.41 用的是第二章的那种map--filter方法: (define (situ n) (if (= n 1) (map list '(1 2 3 4 5)) (flat-map (lambda (x) (map (lambda(xx) (cons x xx)) (situ (- n 1)))) '(1 2 3 4 5)))) (filter (lambda (x) (let ((baker (car x)) (cooper (cadr x)) (fletcher (caddr x)) (miller (cadddr x)) (smith (car (cddddr x)))) (and (not (= baker 5)) (not (= cooper 1)) (not (= fletcher 1)) (not (= fletcher 5)) (> miller cooper) (not (= (abs (- smith fletcher)) 1)) (not (= (abs (- fletcher cooper)) 1)) (distinct? x)))) (situ 5)) 结果:((3 2 4 5 1)) 4.42 所谓一句真话一句假话,可以看做是两个条件异或求值为真。由于这道题存在异或关系的判断,所以还需要给求值器加入and or这两个special-form。 ;;======and or======= (define (analyze-and exp) (define (helper clauses) (if (null? clauses) (lambda(env succeed fail) (succeed true fail)) (lambda (env succeed fail) ((analyze (car clauses)) env (lambda (val fail2) (if (false? val) (succeed false fail2) ((helper (cdr clauses)) env succeed fail2))) fail)))) (helper (cdr exp))) (define (analyze-or exp) (define (helper clauses) (if (null? clauses) (lambda(env succeed fail) (succeed false fail)) (lambda (env succeed fail) ((analyze (car clauses)) env (lambda (val fail2) (if (true? val) (succeed true fail2) ((helper (cdr clauses)) env succeed fail2))) fail)))) (helper (cdr exp))) 这样就可以定义异或关系,通过和例子中相同的方法解答: (define (xor p1 p2) (or (and p1 (not p2)) (and (not p1) p2))) (define (liars) (let ((betty (amb 1 2 3 4 5)) (ethel (amb 1 2 3 4 5)) (joan (amb 1 2 3 4 5)) (kitty (amb 1 2 3 4 5)) (mary (amb 1 2 3 4 5))) (require (xor (= kitty 2) (= betty 3))) (require (xor (= ethel 1) (= joan 2))) (require (xor (= joan 3) (= ethel 5))) (require (xor (= kitty 2) (= mary 4))) (require (xor (= mary 4) (= betty 1))) (require (distinct? (list betty ethel joan kitty mary))) (list (list 'betty betty) (list 'ethel ethel) (list 'joan joan) (list 'kitty kitty) (list 'mary mary)))) 最后得到唯一解:((betty 3) (ethel 5) (joan 2) (kitty 1) (mary 4)) 4.43 这题比较复杂。那个multiple-dwelling问题只有一组关系:人和楼层。这里有两组关系:女儿与父亲,女儿名字与游艇所有者。这里我取的是女儿&游艇名字作为amb的对象,我感觉用父亲的名字也可以(父亲的女儿&父亲的游艇)。所以本题中某人,比如Ann,其值是一个list,(car Ann)为Ann的父亲,(cadr Ann)为游艇Ann的主人。为了方便,自己用数字给这5个父亲打标((Moore Downing Hall SB.Hood Parker) is (1 2 3 4 5))。 程序如下(好长): (define (girls-and-yachts) (define (father-of girl) (car girl)) (define (owner-of-the-yacht girl-name) (cadr girl-name)) (let ((Ann (list (amb 1 2 3 4 5) (amb 1 2 3 4 5)))) (require (distinct? (list (father-of Ann) (owner-of-the-yacht Ann)))) (require (= (father-of Ann) 1)) (let ((Gabrielle (list (amb 1 2 3 4 5) (amb 1 2 3 4 5)))) (require (distinct? (list (father-of Gabrielle) (owner-of-the-yacht Gabrielle)))) (require (= (owner-of-the-yacht Gabrielle) 4)) (let ((Lorna (list (amb 1 2 3 4 5) (amb 1 2 3 4 5)))) (require (distinct? (list (father-of Lorna) (owner-of-the-yacht Lorna)))) (require (= (owner-of-the-yacht Lorna) 1)) (let ((Rosalind (list (amb 1 2 3 4 5) (amb 1 2 3 4 5)))) (require (distinct? (list (father-of Rosalind) (owner-of-the-yacht Rosalind)))) (require (= (owner-of-the-yacht Rosalind) 3)) (let ((Melissa (list (amb 1 2 3 4 5) (amb 1 2 3 4 5)))) (require (distinct? (list (father-of Melissa) (owner-of-the-yacht Melissa)))) (require (= (owner-of-the-yacht Melissa) 2)) (require (= (father-of Melissa) 4)) (let ((girls (list Ann Gabrielle Lorna Rosalind Melissa))) (define (whose-father-is x girl-list) (cond ((null? girl-list) (list 0 0)) ((= (father-of (car girl-list)) x) (car girl-list)) (else (whose-father-is x (cdr girl-list))))) (require (= (father-of Gabrielle) (owner-of-the-yacht (whose-father-is 5 girls)))) (let ((the-fathers (map father-of girls)) (the-owners (map owner-of-the-yacht girls))) (require (distinct? the-fathers)) (require (distinct? the-owners)) (list (list 'Ann Ann) (list 'Gabrielle Gabrielle) (list 'Lorna Lorna) (list 'Rosalind Rosalind) (list 'Melissa Melissa)))))))))) 稍微绕了个弯的地方是最后一个条件"Gabrielle的父亲的游艇取的是Dr.Parker女儿的名字",需要寻找"Dr.Parker的女儿"。 结果为((Ann (1 5)) (Gabrielle (3 4)) (Lorna (2 1)) (Rosalind (5 3)) (Melissa (4 2))),也就是说Lorna的父亲是Colonel Downing。 如果去掉Ann姓Moore这个条件,也就是去掉(require (= (father-of Ann) 1)),会有两个结果: ((Ann (1 5)) (Gabrielle (3 4)) (Lorna (2 1)) (Rosalind (5 3)) (Melissa (4 2))) ((Ann (3 5)) (Gabrielle (1 4)) (Lorna (5 1)) (Rosalind (2 3)) (Melissa (4 2))) 4.44 记得视频中提到流的概念的时候举过八皇后的例子,说有两种策略,一是像构造一颗树那样一个一个的添加皇后,遇到错误后回溯;另一个就是把所有的可能都列举出来,然后筛选。当时采用的是流的方法,构造简单而且由于memo-proc的存在,使得速度上也不错。这次八皇后的解法使用了amb-eval的回溯机制,整个过程看起来更简单了。这个amb-eval写得实在是很巧妙……我只到了理解"鱼"的层次,离怎样想出amb-eval实现的方法这个"渔"的境界还很远。 (define (queens board-size) (define (safe? q position) (if (null? position) true (let ((old-queen (car position))) (and (not (= old-queen q)) (not (= (abs (- old-queen q)) (length position))) (safe? q (cdr position)))))) (define (adjoin-new-queen new-queen position) (append position (list new-queen))) (define (queen-cols q-ref) (if (= q-ref 0) '() (let ((old-position (queen-cols (- q-ref 1)))) (let ((n-q (an-integer-between 1 board-size))) (require (safe? n-q old-position)) (adjoin-new-queen n-q old-position))))) (queen-cols board-size)) 这里同样有当初ex 2.43中的那个关于效率的微妙问题: 如果把queen-cols写成这样: (define (queen-cols q-ref) (if (= q-ref 0) '() (let ((n-q (an-integer-between 1 board-size))) (let ((old-position (queen-cols (- q-ref 1)))) (require (safe? n-q old-position)) (adjoin-new-queen n-q old-position))))) 那么就得到了当初Louis Reasoner的奇慢的程序。原因也差不多: 起回溯作用的语句是an-integer-between,而回溯的时候是没必要每次都再求一遍old-position的。 4.45 这题轻松一下,玩玩小时候拼词组句的小游戏。 5个结果,搭配本人中文自然语言译本: ;;教授教学生,教授在教室里,教授带着猫 (sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb-phrase (verb-phrase (verb lectures) (prep-phrase (prep to) (simple-noun-phrase (article the) (noun student)))) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))) ;;教授教学生,教授在教室里,教室带着猫 (sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb-phrase (verb lectures) (prep-phrase (prep to) (simple-noun-phrase (article the) (noun student)))) (prep-phrase (prep in) (noun-phrase (simple-noun-phrase (article the) (noun class)) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))))) ;;教授教学生,学生在教室里,教授带着猫 (sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb-phrase (verb lectures) (prep-phrase (prep to) (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))))) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))) ;;教授教学生,学生在教室里,学生带着猫 (sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb lectures) (prep-phrase (prep to) (noun-phrase (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))))) ;;教授教学生,学生在教室里,教室带着猫 (sentence (simple-noun-phrase (article the) (noun professor)) (verb-phrase (verb lectures) (prep-phrase (prep to) (noun-phrase (simple-noun-phrase (article the) (noun student)) (prep-phrase (prep in) (noun-phrase (simple-noun-phrase (article the) (noun class)) (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))))))) 4.46 举例比如: (define (parse-simple-noun-phrase) (list 'simple-noun-phrase (parse-word articles) (parse-word nouns))) 如果amb求值顺序为从右至左,那么对于'(a cat)就会先去用名词匹配a,造成混乱。 4.47 想法是正确的,有时也能得出正确结果,但有时也会出现问题: 比如(parse '(the cat eats in the class)),第一次结果正确,但是当try-again时发生死循环。 如果(parse '(the cat haha)),问题就更突出些:新的parse-noun-phrase是个死胡同,一旦进去就再不会出来,即使发生明显的不匹配也不会出来。 观察parse-word过程: (define (parse-word word-list) (require (not (null? *unparsed*))) (require (memq (car *unparsed*) (cdr word-list))) (let ((found-word (car *unparsed*))) (set! *unparsed* (cdr *unparsed*)) (list (car word-list) found-word))) 起判断匹配与否的语句是(require (memq (car *unparsed*) (cdr word-list))),这样比如一个需要名词的地方出现了nouns里面没有的"haha",那么就会运行(amb)。 看一下本来的parse-verb-phrase: (define (parse-verb-phrase) (define (maybe-extend verb-phrase) (amb verb-phrase (maybe-extend (list 'verb-phrase verb-phrase (parse-prepositional-phrase))))) (maybe-extend (parse-word verbs))) 这里有否介词短语两种情况会调用parse-word来判断匹配情况,因为无论哪种情况首个单词都应该是动词,遇到"haha"都应该报错。 再看下Louis Reasoner同学的: (define (parse-verb-phrase) (amb (parse-word verbs) (list 'verb-phrase (parse-verb-phrase) (parse-prepositional-phrase)))) 看到了吧,这里parse-word是"可选的",所以遇到了"haha"就绕开,而后递归调用(parse-verb-phrase)再绕……程序就死掉了。 4.48 偷懒写个最简单的形容词部分: (define adjectives '(adj blue angry nice)) (define (parse-simple-noun-phrase) (amb (list 'simple-noun-phrase (parse-word articles) (parse-word adjectives) (parse-word nouns)) (list 'simple-noun-phrase (parse-word articles) (parse-word nouns)))) 测试: ;;;Amb-Eval input: (parse '(the angry cat eats in the blue class)) ;;;Starting a new problem ;;;Amb-Eval value: (sentence (simple-noun-phrase (article the) (adjs angry) (noun cat)) (verb-phrase (verb eats) (prep-phrase (prep in) (simple-noun-phrase (article the) (adjs blue) (noun class))))) 4.49 简单的修改: (define (parse-word word-list) (let ((new-word (an-element-of (cdr word-list)))) (list (car word-list) new-word))) 结果: the blue student studies the blue student studies for the blue student the blue student studies for the blue student for the blue student ...看来没有random-amb这东西真是不好玩 TrackbacksThe trackback URL for this entry is: http://3fen.spaces.live.com/blog/cns!19176E6323A90759!351.trak Weblogs that reference this entry
|
|
|