blob: e1162d6c4c191fe367aaa33f7e75c3d6cb770a0a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
#|
|| SICP Section 4.3.2
|| Logic Puzzles
||
|| Baker, Cooper, Fletcher, Miller, and Smith live on
|| different floors of a building that has only five
|| floors. Baker does not live on the top floor.
|| Cooper does not live on the bottom floor. Fletcher
|| does not live on either the top or the bottom
|| floor. Miller lives on a higher floor than does
|| Cooper. Smith does not live on a floor adjacent to
|| Fletcher's. Fletcher does not live on a floor
|| adjacent to Cooper's. Where does everyone live?
||
|| (From Dinesman, 1968)
|#
(define (multiple-dwelling)
(let ((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
(distinct?
(list baker cooper fletcher miller smith)))
(require (not (= baker 5)))
(require (not (= cooper 1)))
(require (not (= fletcher 5)))
(require (not (= fletcher 1)))
(require (> miller cooper))
(require
(not (= (abs (- smith fletcher)) 1)))
(require
(not (= (abs (- fletcher cooper)) 1)))
(list (list 'baker baker)
(list 'cooper cooper)
(list 'fletcher fletcher)
(list 'miller miller)
(list 'smith smith))))
(define (distinct? items)
(cond ((null? items) #t)
((null? (cdr items)) #t)
((member (car items) (cdr items)) #f)
(else (distinct? (cdr items)))))
#|
(init-amb)
;Value: done
(with-depth-first-schedule multiple-dwelling)
;Value: ((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
(amb)
;No more alternatives
|#
;;; From SICP Section 4.3.2
;;; Parsing natural language
(define (parse input)
(amb-set! *unparsed* input)
(let ((sent (parse-sentence)))
(require (null? *unparsed*))
sent))
(define *unparsed* '())
(define (parse-sentence)
(let* ((np (parse-noun-phrase))
(verb (parse-verb-phrase)))
(list 'sentence np verb)))
(define (parse-noun-phrase)
(define (maybe-extend noun-phrase)
(amb noun-phrase
(maybe-extend
(list 'noun-phrase
noun-phrase
(parse-prepositional-phrase)))))
(maybe-extend (parse-s-noun-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)))
(define (parse-s-noun-phrase)
(let* ((article (parse-word articles))
(noun (parse-word nouns)))
(list 's-noun-phrase article noun)))
(define (parse-prepositional-phrase)
(let* ((preposition
(parse-word prepositions))
(np (parse-noun-phrase)))
(list 'prep-phrase preposition np)))
(define (parse-word word-list)
(require (not (null? *unparsed*)))
(require (memq (car *unparsed*)
(cdr word-list)))
(let ((found-word (car *unparsed*)))
(amb-set! *unparsed* (cdr *unparsed*))
(list (car word-list) found-word)))
(define nouns
'(noun student professor cat class))
(define verbs
'(verb studies lectures eats sleeps))
(define articles
'(article the a))
(define prepositions
'(prep for to in by with))
#|
(init-amb)
;Value: done
(pp
(parse
'(the student with the cat sleeps in the class)))
(sentence
(noun-phrase
(s-noun-phrase (article the) (noun student))
(prep-phrase (prep with)
(s-noun-phrase (article the)
(noun cat))))
(verb-phrase
(verb sleeps)
(prep-phrase (prep in)
(s-noun-phrase (article the)
(noun class)))))
;Unspecified return value
(amb)
;No more alternatives
|#
#|
(init-amb)
;Value: done
(pp
(parse
'(the professor lectures
to the student with the cat)))
(sentence
(s-noun-phrase (article the) (noun professor))
(verb-phrase
(verb-phrase
(verb lectures)
(prep-phrase (prep to)
(s-noun-phrase (article the)
(noun student))))
(prep-phrase (prep with)
(s-noun-phrase (article the)
(noun cat)))))
;Unspecified return value
(amb)
(sentence
(s-noun-phrase (article the) (noun professor))
(verb-phrase
(verb lectures)
(prep-phrase
(prep to)
(noun-phrase
(s-noun-phrase (article the)
(noun student))
(prep-phrase (prep with)
(s-noun-phrase (article the)
(noun cat)))))))
;Unspecified return value
(amb)
;No more alternatives
|#
|
