## Blob

1 ;; The first three lines of this file were inserted by DrScheme. They record metadata2 ;; 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")))))4 (define MC 3)5 (define BOAT-CAPACITY 2)7 (define-struct state (initial river final))9 ;A state is a structure10 ;(make-state i r f)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).13 ;The initial state is14 ;(make-state (list 3 3) 'initial (list 0 0))15 ;The final state (solved) is16 ;(make-state (list 0 0) 'final (list 3 3))18 ;A boat load is a list19 ;(list m c)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 boat28 (foldr append empty ;;converts the (listof (listof (list N N))) into (listof (list N N))29 (build-list (+ maxc 1)30 (lambda (m)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 yet38 ((define (possible-successor-accu astate1 boat-loads)39 (cond40 [(empty? boat-loads) empty]41 [else42 (local43 ((define sub-initial (sub-list (state-initial astate1)44 (first boat-loads)))45 (define sub-final (sub-list (state-final astate1)46 (first boat-loads)))47 (define add-initial (add-list (state-initial astate1)48 (first boat-loads)))49 (define add-final (add-list (state-final astate1)50 (first boat-loads)))51 (define initial-state (make-state add-initial52 'initial53 sub-final))54 (define final-state (make-state sub-initial55 'final56 add-final))57 (define remaining-states (possible-successor-accu astate1 (rest boat-loads))))58 (cond59 [(and (symbol=? (state-river astate1) 'initial)60 (non-negative-list? sub-initial))61 (cons final-state62 remaining-states)]63 [(and (symbol=? (state-river astate1) 'final)64 (non-negative-list? sub-final))65 (cons initial-state66 remaining-states)]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)74 (cond75 [(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) -> boolean85 (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)92 (cond93 [(empty? alos) empty]94 [else (append (possible-successor (first alos))95 (possible-successor/list (rest alos)))]))97 ;legal-state? : state -> boolean98 ;Determines if a state is legal.100 (define (legal-state? astate)101 (cond102 [(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]110 [else false]))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 -> boolean118 ;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) -> boolean132 ;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) -> boolean135 ;mc-solvable?-accu : state (listof states) -> boolean136 ;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, including142 ;the necessary state in alos0 but not including the states in alos1143 ((define (mc-solvable?/list-accu alos1 previous)144 (cond145 [(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)149 (cond150 [(equal? astate final-state) true]151 [(contains astate previous) false]152 [else (mc-solvable?/list-accu153 (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 false159 ;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) boolean162 ;mc-solution-accu : state (listof states) -> (listof states) or boolean163 ;164 ;The algorithm is similar to mc-solvable?.167 (define (mc-solution alos0)168 (local169 ;previous accumulates all states necessary to go from alos0 to alos1, including170 ;the necessary state in alos0 but not including the states in alos1171 ((define (mc-solution/list-accu alos1 previous)172 (cond173 [(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)177 (cond178 [(equal? astate final-state) (append previous (list astate))]179 [(contains astate previous) false]180 [else (mc-solution/list-accu181 (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) -> boolean187 ;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) -> boolean194 ;Tests: op-pair195 ;(op-pair + '(5 6 7)196 ; '(2 1 3))197 ;(op-pair - '(5 6 7)198 ; '(2 1 3))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-successor205 ;(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/list212 ;(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)222 ;Tests : mc-solution223 ;(mc-solution (list initial-state))