1 ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 ;; about the language level of this file in a form that our tools can easily process.
3 #reader(lib "htdp-advanced-reader.ss" "lang")((modname |32.2|) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp")))))
5 (define BOAT-CAPACITY 2)
7 (define-struct state (initial river final))
9 ;A state is a structure
11 ;where i, r are (list m c) where m, c are numbers, where m represents the number of missionaries, c the number of cannibals, on the respective side of the river; and r is a symbol (either 'initial or 'final).
14 ;(make-state (list 3 3) 'initial (list 0 0))
15 ;The final state (solved) is
16 ;(make-state (list 0 0) 'final (list 3 3))
18 ;A boat load is a list
20 ;where m represents the number of missionaries using the boat and c the number of cannibals. By definition, the sum of m and c must be less than or equal to BOAT-CAPACITY. In Scheme,
21 ;(<= (+ m c) BOAT-CAPACITY)
23 ;make-BOAT-LOADS : N -> (listof (list N N))
24 ;Determine the possible boat-loads given maxc (maximum-capacity) and return the possibilities as a (listof (list N N)) where the first number in each pair represents the number of missionaries, the second the number of cannibals.
26 (define (make-BOAT-LOADS maxc)
27 (rest ;;removes the first entry, which corresponds to no one in the boat
28 (foldr append empty ;;converts the (listof (listof (list N N))) into (listof (list N N))
29 (build-list (+ maxc 1)
31 (build-list (+ (- maxc m) 1) (lambda (c) (list m c))))))))
33 ;possible-successor : state -> (listof states)
34 ;Given astate0, return a (listof states) of all possible successor states.
36 (define (possible-successor astate0)
37 (local ;;boat-loads represent the remaining boat-loads that have not been tried yet
38 ((define (possible-successor-accu astate1 boat-loads)
40 [(empty? boat-loads) empty]
43 ((define sub-initial (sub-list (state-initial astate1)
45 (define sub-final (sub-list (state-final astate1)
47 (define add-initial (add-list (state-initial astate1)
49 (define add-final (add-list (state-final astate1)
51 (define initial-state (make-state add-initial
54 (define final-state (make-state sub-initial
57 (define remaining-states (possible-successor-accu astate1 (rest boat-loads))))
59 [(and (symbol=? (state-river astate1) 'initial)
60 (non-negative-list? sub-initial))
63 [(and (symbol=? (state-river astate1) 'final)
64 (non-negative-list? sub-final))
67 [else remaining-states]))])))
68 (possible-successor-accu astate0 (make-BOAT-LOADS BOAT-CAPACITY))))
70 ;op-pair : (number number -> number) (list number number) (list number number) -> (list number number)
71 ;Performs operation element by element on two lists.
73 (define (op-pair op list1 list2)
75 [(empty? list1) empty]
76 [else (cons (op (first list1) (first list2))
77 (op-pair op (rest list1) (rest list2)))]))
79 (define (add-list list1 list2)
80 (op-pair + list1 list2))
81 (define (sub-list list1 list2)
82 (op-pair - list1 list2))
84 ;non-negative-list? : (listof numbers) -> boolean
85 (define (non-negative-list? alist)
86 (andmap (lambda (x) (>= x 0)) alist))
88 ;possible-successor/list : (listof states) -> (listof states)
89 ;Given alos, determine all possible successor states (both legal and illegal states).
91 (define (possible-successor/list alos)
94 [else (append (possible-successor (first alos))
95 (possible-successor/list (rest alos)))]))
97 ;legal-state? : state -> boolean
98 ;Determines if a state is legal.
100 (define (legal-state? astate)
102 [(and (equal? (add-list (state-initial astate)
103 (state-final astate)) (list MC MC))
104 (or (zero? (first (state-initial astate)))
105 (>= (first (state-initial astate))
106 (second (state-initial astate))))
107 (or (zero? (first (state-final astate)))
108 (>= (first (state-final astate))
109 (second (state-final astate))))) true]
112 ;legal-state/list : (listof states) -> (listof states)
113 ;Returns all legal states in alos.
114 (define (legal-state/list alos)
115 (filter legal-state? alos))
117 ;state-final? : state -> boolean
118 ;Determines if a state is final.
120 (define (state-final? astate)
121 (and (equal? (list 0 0) (state-initial astate))
122 (symbol=? 'final (state-river astate))
123 (equal? (list MC MC) (state-final astate))))
125 ;state-final/list : (listof states) -> (listof states)
126 ;Returns the subset of final states from alos.
128 (define (state-final/list alos)
129 (filter state-final? alos))
131 ;mc-solvable? : (listof states) -> boolean
132 ;Determines if there is a solution for alos by generating successor states until a final state is reached. We use two auxiliary definitions, mc-solvable?/list-accu and mc-solvable?-accu:
134 ;mc-solvable?/list-accu : (listof states) (listof states) -> boolean
135 ;mc-solvable?-accu : state (listof states) -> boolean
137 ;First, we examine if alos is empty. Clearly, if it is empty, the problem cannot be solved. Next, we see if the first item on the list is the final-state. If it is, clearly the state is solved. Otherwise, we produce a list of legal successor states for (first alos), and we re-apply mc-solvable? on those new successor states. We use an accumulator to keep track of which states have already occurred. If a successor state is identical to a previous state, we return false (to prevent infinite loops). We use backtracking to end searches if a cycle is reached or if there are no legal successor states.
138 ;previous is an accumulator, a (listof states) that records which states have been previously accessed in order to get from alos0 to alos1. That is, alos1 is a list of successor states, and previous includes all the states from alos0 (previous includes a single state from alos0) up to alos1 (not inclusive) in order to obtain alos0.
140 (define (mc-solvable? alos0)
141 (local ;previous accumulates all states necessary to go from alos0 to alos1, including
142 ;the necessary state in alos0 but not including the states in alos1
143 ((define (mc-solvable?/list-accu alos1 previous)
145 [(empty? alos1) false]
146 [else (or (mc-solvable?-accu (first alos1) previous)
147 (mc-solvable?/list-accu (rest alos1) previous))]))
148 (define (mc-solvable?-accu astate previous)
150 [(equal? astate final-state) true]
151 [(contains astate previous) false]
152 [else (mc-solvable?/list-accu
153 (legal-state/list (possible-successor astate))
154 (append previous (list astate)))]))
155 (define final-state (make-state (list 0 0) 'final (list 3 3))))
156 (mc-solvable?/list-accu alos0 empty)))
158 ;mc-solution : (listof states) -> (listof states) or false
159 ;Determines a solution for alos0, which is a (listof states), if a solution is possible; returns false otherwise. mc-solution generates successor states until a final state is reached. We use two auxiliary definitions, mc-solution/list-accu and mc-solution-accu:
161 ;mc-solution/list-accu : (listof states) (listof states) -> (listof states) boolean
162 ;mc-solution-accu : state (listof states) -> (listof states) or boolean
164 ;The algorithm is similar to mc-solvable?.
167 (define (mc-solution alos0)
169 ;previous accumulates all states necessary to go from alos0 to alos1, including
170 ;the necessary state in alos0 but not including the states in alos1
171 ((define (mc-solution/list-accu alos1 previous)
173 [(empty? alos1) false]
174 [(cons? (mc-solution-accu (first alos1) previous)) (mc-solution-accu (first alos1) previous)]
175 [else (mc-solution/list-accu (rest alos1) previous)]))
176 (define (mc-solution-accu astate previous)
178 [(equal? astate final-state) (append previous (list astate))]
179 [(contains astate previous) false]
180 [else (mc-solution/list-accu
181 (legal-state/list (possible-successor astate))
182 (append previous (list astate)))]))
183 (define final-state (make-state (list 0 0) 'final (list 3 3))))
184 (mc-solution/list-accu alos0 empty)))
186 ;contains : X (listof X) -> boolean
187 ;Determines if alox contains x.
188 (define (contains x alox)
189 (ormap (lambda (an-x) (equal? x an-x)) alox))
191 ;mc-solvable?-accu : state (listof states) -> boolean
200 ;Tests: non-negative-list?
201 ;(not (non-negative-list? '(5 2 -4 5 3)))
202 ;(non-negative-list? '(4 1 2 1 4))
204 ;Tests: possible-successor
205 ;(define initial-state (make-state (list 3 3) 'initial (list 0 0)))
206 ;(define second-state (make-state (list 2 2) 'final (list 1 1)))
207 ;(define final-state (make-state (list 0 0) 'final (list 3 3)))
208 ;(possible-successor initial-state)
209 ;(possible-successor second-state)
211 ;Tests: possible-successor/list
212 ;(possible-successor/list (possible-successor initial-state))
214 ;Tests : legal-state?
215 ;(map legal-state? (possible-successor/list (possible-successor/list (possible-successor initial-state))))
216 ;(map legal-state? (legal-state/list (possible-successor/list (possible-successor/list (possible-successor initial-state)))))
218 ;Tests : state-final?
219 ;(not (ormap state-final? (legal-state/list (possible-successor/list (possible-successor/list (possible-successor initial-state))))))
220 ;(state-final? final-state)
223 ;(mc-solution (list initial-state))
