; missionaries and cannibals problem & BFS
;
; This is the code that we completed in class on 9/10/02 for the
; missionaries and cannibals problem and breadth first search. I've
; tidied up the comments a bit, but otherwise, it's the same code you
; saw run in class.
;
(define start-state '(left 3 3 0 0))
(define goal-state '(right 0 0 3 3))
(define boat-side first)
(define l-miss second)
(define l-cann third)
(define r-miss fourth)
(define r-cann fifth)
; node: ( )
; root node: ( ())
(define node:state first)
(define node:parent second)
(define start-node (list start-state '()))
(define (mc-goal? n)
(equal? (node:state n) goal-state))
; given a node "n", return a list of all the child nodes
;
(define (mc-children n)
; generate child states
(let ((child-states (mcs-boat-trip
(node:state n))))
; turn those states into nodes
(map (lambda (s)
(list s n))
child-states)))
; given a state "s" return a list of all the child states
;
(define (mcs-boat-trip s)
(if (equal? (boat-side s) 'left)
; if boat already on left...
(mcs-boat-trip-helper s)
; if boat on right
; switch boat and people to opposite side
; then switch back all results
(switch-all-sides
(mcs-boat-trip-helper
(switch-sides s)))))
; given a state "s" where the boat is assumed to be on the left side
; of the river, generate all the child states from sending a boat to
; the right side.
;
(define (mcs-boat-trip-helper s)
(remove-invalid (do-trip s
'((-2 0 2 0)
(0 -2 0 2)
(-1 0 1 0)
(0 -1 0 1)
(-1 -1 1 1)))))
; takes the state "s" and for each "additions list", makes the
; appropriate adjustment to the number of people on each side. (also
; moves the boat to the other side.)
(define (do-trip s additions-list)
(if (null? additions-list)
'()
(cons (list (if (equal? (boat-side s)
'left)
'right
'left)
(+ (l-miss s)
(first
(first additions-list)))
(+ (l-cann s)
(second
(first additions-list)))
(+ (r-miss s)
(third
(first additions-list)))
(+ (r-cann s)
(fourth
(first additions-list))))
(do-trip s (cdr additions-list)))))
; is a state "s" valid? (missionaries not outnumbered by cannibals)
(define (mc-valid? s)
(and (or (zero? (l-miss s))
(>= (l-miss s) (l-cann s)))
(or (zero? (r-miss s))
(>= (r-miss s) (r-cann s)))))
; take a list of states and remove any that are invalid states
(define (remove-invalid Lst)
(if (null? Lst)
'()
(if (mc-valid? (car Lst))
(cons (car Lst)
(remove-invalid (cdr Lst)))
(remove-invalid (cdr Lst)))))
; switch the people and the boat to the opposite river bank for a
; state "s"
;
(define (switch-sides s)
(list (if (equal? (boat-side s)
'left)
'right
'left)
(r-miss s)
(r-cann s)
(l-miss s)
(l-cann s)))
; switch sides for a list of states
;
(define (switch-all-sides Lst)
; this is one way to do it, using an "every" recursion pattern
; (if (null? Lst)
; '()
; (cons (switch-sides (car Lst))
; (switch-all-sides (cdr Lst)))))
; however, this does it much more simply
(map switch-sides Lst))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; breadth first search implementation
(define (bfs start-node
at-goal?
get-children)
(bfs-helper (list start-node)
at-goal?
get-children))
(define (bfs-helper Q at-goal? get-children)
(if (null? Q)
'no-path-to-goal
(let ((first-el (car Q)))
(if (at-goal? first-el)
first-el
(bfs-helper (append (cdr Q) ;add children to the back of the queue
(get-children
first-el))
at-goal?
get-children)))))