1 12687dd9 2023-08-04 jrmu ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 12687dd9 2023-08-04 jrmu ;; about the language level of this file in a form that our tools can easily process.
3 12687dd9 2023-08-04 jrmu #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")))))
4 12687dd9 2023-08-04 jrmu (define MC 3)
5 12687dd9 2023-08-04 jrmu (define BOAT-CAPACITY 2)
7 12687dd9 2023-08-04 jrmu (define-struct state (initial river final))
9 12687dd9 2023-08-04 jrmu ;A state is a structure
10 12687dd9 2023-08-04 jrmu ;(make-state i r f)
11 12687dd9 2023-08-04 jrmu ;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).
13 12687dd9 2023-08-04 jrmu ;The initial state is
14 12687dd9 2023-08-04 jrmu ;(make-state (list 3 3) 'initial (list 0 0))
15 12687dd9 2023-08-04 jrmu ;The final state (solved) is
16 12687dd9 2023-08-04 jrmu ;(make-state (list 0 0) 'final (list 3 3))
18 12687dd9 2023-08-04 jrmu ;A boat load is a list
20 12687dd9 2023-08-04 jrmu ;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 12687dd9 2023-08-04 jrmu ;(<= (+ m c) BOAT-CAPACITY)
23 12687dd9 2023-08-04 jrmu ;make-BOAT-LOADS : N -> (listof (list N N))
24 12687dd9 2023-08-04 jrmu ;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 12687dd9 2023-08-04 jrmu (define (make-BOAT-LOADS maxc)
27 12687dd9 2023-08-04 jrmu (rest ;;removes the first entry, which corresponds to no one in the boat
28 12687dd9 2023-08-04 jrmu (foldr append empty ;;converts the (listof (listof (list N N))) into (listof (list N N))
29 12687dd9 2023-08-04 jrmu (build-list (+ maxc 1)
31 12687dd9 2023-08-04 jrmu (build-list (+ (- maxc m) 1) (lambda (c) (list m c))))))))
33 12687dd9 2023-08-04 jrmu ;possible-successor : state -> (listof states)
34 12687dd9 2023-08-04 jrmu ;Given astate0, return a (listof states) of all possible successor states.
36 12687dd9 2023-08-04 jrmu (define (possible-successor astate0)
37 12687dd9 2023-08-04 jrmu (local ;;boat-loads represent the remaining boat-loads that have not been tried yet
38 12687dd9 2023-08-04 jrmu ((define (possible-successor-accu astate1 boat-loads)
40 12687dd9 2023-08-04 jrmu [(empty? boat-loads) empty]
43 12687dd9 2023-08-04 jrmu ((define sub-initial (sub-list (state-initial astate1)
44 12687dd9 2023-08-04 jrmu (first boat-loads)))
45 12687dd9 2023-08-04 jrmu (define sub-final (sub-list (state-final astate1)
46 12687dd9 2023-08-04 jrmu (first boat-loads)))
47 12687dd9 2023-08-04 jrmu (define add-initial (add-list (state-initial astate1)
48 12687dd9 2023-08-04 jrmu (first boat-loads)))
49 12687dd9 2023-08-04 jrmu (define add-final (add-list (state-final astate1)
50 12687dd9 2023-08-04 jrmu (first boat-loads)))
51 12687dd9 2023-08-04 jrmu (define initial-state (make-state add-initial
54 12687dd9 2023-08-04 jrmu (define final-state (make-state sub-initial
57 12687dd9 2023-08-04 jrmu (define remaining-states (possible-successor-accu astate1 (rest boat-loads))))
59 12687dd9 2023-08-04 jrmu [(and (symbol=? (state-river astate1) 'initial)
60 12687dd9 2023-08-04 jrmu (non-negative-list? sub-initial))
61 12687dd9 2023-08-04 jrmu (cons final-state
62 12687dd9 2023-08-04 jrmu remaining-states)]
63 12687dd9 2023-08-04 jrmu [(and (symbol=? (state-river astate1) 'final)
64 12687dd9 2023-08-04 jrmu (non-negative-list? sub-final))
65 12687dd9 2023-08-04 jrmu (cons initial-state
66 12687dd9 2023-08-04 jrmu remaining-states)]
67 12687dd9 2023-08-04 jrmu [else remaining-states]))])))
68 12687dd9 2023-08-04 jrmu (possible-successor-accu astate0 (make-BOAT-LOADS BOAT-CAPACITY))))
70 12687dd9 2023-08-04 jrmu ;op-pair : (number number -> number) (list number number) (list number number) -> (list number number)
71 12687dd9 2023-08-04 jrmu ;Performs operation element by element on two lists.
73 12687dd9 2023-08-04 jrmu (define (op-pair op list1 list2)
75 12687dd9 2023-08-04 jrmu [(empty? list1) empty]
76 12687dd9 2023-08-04 jrmu [else (cons (op (first list1) (first list2))
77 12687dd9 2023-08-04 jrmu (op-pair op (rest list1) (rest list2)))]))
79 12687dd9 2023-08-04 jrmu (define (add-list list1 list2)
80 12687dd9 2023-08-04 jrmu (op-pair + list1 list2))
81 12687dd9 2023-08-04 jrmu (define (sub-list list1 list2)
82 12687dd9 2023-08-04 jrmu (op-pair - list1 list2))
84 12687dd9 2023-08-04 jrmu ;non-negative-list? : (listof numbers) -> boolean
85 12687dd9 2023-08-04 jrmu (define (non-negative-list? alist)
86 12687dd9 2023-08-04 jrmu (andmap (lambda (x) (>= x 0)) alist))
88 12687dd9 2023-08-04 jrmu ;possible-successor/list : (listof states) -> (listof states)
89 12687dd9 2023-08-04 jrmu ;Given alos, determine all possible successor states (both legal and illegal states).
91 12687dd9 2023-08-04 jrmu (define (possible-successor/list alos)
93 12687dd9 2023-08-04 jrmu [(empty? alos) empty]
94 12687dd9 2023-08-04 jrmu [else (append (possible-successor (first alos))
95 12687dd9 2023-08-04 jrmu (possible-successor/list (rest alos)))]))
97 12687dd9 2023-08-04 jrmu ;legal-state? : state -> boolean
98 12687dd9 2023-08-04 jrmu ;Determines if a state is legal.
100 12687dd9 2023-08-04 jrmu (define (legal-state? astate)
102 12687dd9 2023-08-04 jrmu [(and (equal? (add-list (state-initial astate)
103 12687dd9 2023-08-04 jrmu (state-final astate)) (list MC MC))
104 12687dd9 2023-08-04 jrmu (or (zero? (first (state-initial astate)))
105 12687dd9 2023-08-04 jrmu (>= (first (state-initial astate))
106 12687dd9 2023-08-04 jrmu (second (state-initial astate))))
107 12687dd9 2023-08-04 jrmu (or (zero? (first (state-final astate)))
108 12687dd9 2023-08-04 jrmu (>= (first (state-final astate))
109 12687dd9 2023-08-04 jrmu (second (state-final astate))))) true]
110 12687dd9 2023-08-04 jrmu [else false]))
112 12687dd9 2023-08-04 jrmu ;legal-state/list : (listof states) -> (listof states)
113 12687dd9 2023-08-04 jrmu ;Returns all legal states in alos.
114 12687dd9 2023-08-04 jrmu (define (legal-state/list alos)
115 12687dd9 2023-08-04 jrmu (filter legal-state? alos))
117 12687dd9 2023-08-04 jrmu ;state-final? : state -> boolean
118 12687dd9 2023-08-04 jrmu ;Determines if a state is final.
120 12687dd9 2023-08-04 jrmu (define (state-final? astate)
121 12687dd9 2023-08-04 jrmu (and (equal? (list 0 0) (state-initial astate))
122 12687dd9 2023-08-04 jrmu (symbol=? 'final (state-river astate))
123 12687dd9 2023-08-04 jrmu (equal? (list MC MC) (state-final astate))))
125 12687dd9 2023-08-04 jrmu ;state-final/list : (listof states) -> (listof states)
126 12687dd9 2023-08-04 jrmu ;Returns the subset of final states from alos.
128 12687dd9 2023-08-04 jrmu (define (state-final/list alos)
129 12687dd9 2023-08-04 jrmu (filter state-final? alos))
131 12687dd9 2023-08-04 jrmu ;mc-solvable? : (listof states) -> boolean
132 12687dd9 2023-08-04 jrmu ;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 12687dd9 2023-08-04 jrmu ;mc-solvable?/list-accu : (listof states) (listof states) -> boolean
135 12687dd9 2023-08-04 jrmu ;mc-solvable?-accu : state (listof states) -> boolean
137 12687dd9 2023-08-04 jrmu ;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 12687dd9 2023-08-04 jrmu ;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 12687dd9 2023-08-04 jrmu (define (mc-solvable? alos0)
141 12687dd9 2023-08-04 jrmu (local ;previous accumulates all states necessary to go from alos0 to alos1, including
142 12687dd9 2023-08-04 jrmu ;the necessary state in alos0 but not including the states in alos1
143 12687dd9 2023-08-04 jrmu ((define (mc-solvable?/list-accu alos1 previous)
145 12687dd9 2023-08-04 jrmu [(empty? alos1) false]
146 12687dd9 2023-08-04 jrmu [else (or (mc-solvable?-accu (first alos1) previous)
147 12687dd9 2023-08-04 jrmu (mc-solvable?/list-accu (rest alos1) previous))]))
148 12687dd9 2023-08-04 jrmu (define (mc-solvable?-accu astate previous)
150 12687dd9 2023-08-04 jrmu [(equal? astate final-state) true]
151 12687dd9 2023-08-04 jrmu [(contains astate previous) false]
152 12687dd9 2023-08-04 jrmu [else (mc-solvable?/list-accu
153 12687dd9 2023-08-04 jrmu (legal-state/list (possible-successor astate))
154 12687dd9 2023-08-04 jrmu (append previous (list astate)))]))
155 12687dd9 2023-08-04 jrmu (define final-state (make-state (list 0 0) 'final (list 3 3))))
156 12687dd9 2023-08-04 jrmu (mc-solvable?/list-accu alos0 empty)))
158 12687dd9 2023-08-04 jrmu ;mc-solution : (listof states) -> (listof states) or false
159 12687dd9 2023-08-04 jrmu ;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 12687dd9 2023-08-04 jrmu ;mc-solution/list-accu : (listof states) (listof states) -> (listof states) boolean
162 12687dd9 2023-08-04 jrmu ;mc-solution-accu : state (listof states) -> (listof states) or boolean
164 12687dd9 2023-08-04 jrmu ;The algorithm is similar to mc-solvable?.
167 12687dd9 2023-08-04 jrmu (define (mc-solution alos0)
169 12687dd9 2023-08-04 jrmu ;previous accumulates all states necessary to go from alos0 to alos1, including
170 12687dd9 2023-08-04 jrmu ;the necessary state in alos0 but not including the states in alos1
171 12687dd9 2023-08-04 jrmu ((define (mc-solution/list-accu alos1 previous)
173 12687dd9 2023-08-04 jrmu [(empty? alos1) false]
174 12687dd9 2023-08-04 jrmu [(cons? (mc-solution-accu (first alos1) previous)) (mc-solution-accu (first alos1) previous)]
175 12687dd9 2023-08-04 jrmu [else (mc-solution/list-accu (rest alos1) previous)]))
176 12687dd9 2023-08-04 jrmu (define (mc-solution-accu astate previous)
178 12687dd9 2023-08-04 jrmu [(equal? astate final-state) (append previous (list astate))]
179 12687dd9 2023-08-04 jrmu [(contains astate previous) false]
180 12687dd9 2023-08-04 jrmu [else (mc-solution/list-accu
181 12687dd9 2023-08-04 jrmu (legal-state/list (possible-successor astate))
182 12687dd9 2023-08-04 jrmu (append previous (list astate)))]))
183 12687dd9 2023-08-04 jrmu (define final-state (make-state (list 0 0) 'final (list 3 3))))
184 12687dd9 2023-08-04 jrmu (mc-solution/list-accu alos0 empty)))
186 12687dd9 2023-08-04 jrmu ;contains : X (listof X) -> boolean
187 12687dd9 2023-08-04 jrmu ;Determines if alox contains x.
188 12687dd9 2023-08-04 jrmu (define (contains x alox)
189 12687dd9 2023-08-04 jrmu (ormap (lambda (an-x) (equal? x an-x)) alox))
191 12687dd9 2023-08-04 jrmu ;mc-solvable?-accu : state (listof states) -> boolean
194 12687dd9 2023-08-04 jrmu ;Tests: op-pair
195 12687dd9 2023-08-04 jrmu ;(op-pair + '(5 6 7)
196 12687dd9 2023-08-04 jrmu ; '(2 1 3))
197 12687dd9 2023-08-04 jrmu ;(op-pair - '(5 6 7)
198 12687dd9 2023-08-04 jrmu ; '(2 1 3))
200 12687dd9 2023-08-04 jrmu ;Tests: non-negative-list?
201 12687dd9 2023-08-04 jrmu ;(not (non-negative-list? '(5 2 -4 5 3)))
202 12687dd9 2023-08-04 jrmu ;(non-negative-list? '(4 1 2 1 4))
204 12687dd9 2023-08-04 jrmu ;Tests: possible-successor
205 12687dd9 2023-08-04 jrmu ;(define initial-state (make-state (list 3 3) 'initial (list 0 0)))
206 12687dd9 2023-08-04 jrmu ;(define second-state (make-state (list 2 2) 'final (list 1 1)))
207 12687dd9 2023-08-04 jrmu ;(define final-state (make-state (list 0 0) 'final (list 3 3)))
208 12687dd9 2023-08-04 jrmu ;(possible-successor initial-state)
209 12687dd9 2023-08-04 jrmu ;(possible-successor second-state)
211 12687dd9 2023-08-04 jrmu ;Tests: possible-successor/list
212 12687dd9 2023-08-04 jrmu ;(possible-successor/list (possible-successor initial-state))
214 12687dd9 2023-08-04 jrmu ;Tests : legal-state?
215 12687dd9 2023-08-04 jrmu ;(map legal-state? (possible-successor/list (possible-successor/list (possible-successor initial-state))))
216 12687dd9 2023-08-04 jrmu ;(map legal-state? (legal-state/list (possible-successor/list (possible-successor/list (possible-successor initial-state)))))
218 12687dd9 2023-08-04 jrmu ;Tests : state-final?
219 12687dd9 2023-08-04 jrmu ;(not (ormap state-final? (legal-state/list (possible-successor/list (possible-successor/list (possible-successor initial-state))))))
220 12687dd9 2023-08-04 jrmu ;(state-final? final-state)
222 12687dd9 2023-08-04 jrmu ;Tests : mc-solution
223 12687dd9 2023-08-04 jrmu ;(mc-solution (list initial-state))
