Solution
[1]> (load "missionaries-cannibals.l")
;; Loading file missionaries-cannibals.l ...
;; Loaded file missionaries-cannibals.l
T
[2]> (mc)
*LEFT-BANK* (M M M C C C B)
*RIGHT-BANK* NIL
(b m c)
*LEFT-BANK* (M M C C)
*RIGHT-BANK* (B M C)
(b m)
*LEFT-BANK* (M M C C B M)
*RIGHT-BANK* (C)
(b c c)
*LEFT-BANK* (M M M)
*RIGHT-BANK* (C B C C)
(b c)
*LEFT-BANK* (M M M B C)
*RIGHT-BANK* (C C)
(b m m)
*LEFT-BANK* (M C)
*RIGHT-BANK* (C C B M M)
(b m c)
*LEFT-BANK* (M C B M C)
*RIGHT-BANK* (C M)
(b m m)
*LEFT-BANK* (C C)
*RIGHT-BANK* (C M B M M)
(b c)
*LEFT-BANK* (C C B C)
*RIGHT-BANK* (M M M)
(b c c)
*LEFT-BANK* (C)
*RIGHT-BANK* (M M M B C C)
(b m)
*LEFT-BANK* (C B M)
*RIGHT-BANK* (M M C C)
(b m c)
*LEFT-BANK* NIL
*RIGHT-BANK* (M M C C B M C)
good work!
NIL
[3]> (display-solution)
(B M C)
(B M)
(B C C)
(B C)
(B M M)
(B M C)
(B M M)
(B C)
(B C C)
(B M)
(B M C)
NIL
Code
Download
(defun mc ()
(establish-world)
(init-move-list)
(make-moves))
(defun establish-world ()
"Initializes the states of the left and right banks."
(setf *left-bank* '(M M M C C C B)
*right-bank* ()))
(defun init-move-list ()
"Initializes *move-list* to the empty-list."
(setf *move-list* ()))
(defun display-symbol-and-value (symbol)
"Prints a symbol and the value it is bound to."
(format t "~15A ~15A~%" symbol (eval symbol)))
(defun display-world ()
"Displays the current state of the world."
(mapcar #'display-symbol-and-value
'(*left-bank* *right-bank*)))
;;;;;;;;;;;;;;;
;;;; Moves ;;;;
;;;;;;;;;;;;;;;
(defun make-moves ()
"Enters a REPL of sorts."
(display-world)
(cond
((goalp)
(write-line "good work!")
nil)
((feast-state-p)
(write-line "yummy yummy yummy, I got Good in my tummy!!") ; wut?
nil)
(T
(let ((m (read)))
(if (applicable-p m)
(progn
(perform-move m)
(make-moves))
(progn
(write-line "move inapplicable")
nil))))))
(defun perform-move (move)
"Performs a move based from the current bank to the other bank."
(setf *move-list* (snoc move *move-list*))
(if (equal (current-bank) *left-bank*)
(move-lr move)
(move-rl move)))
(defun move-lr (ml)
"Moves a list of pieces from the left to the right bank."
(when (null ml) (return-from move-lr))
(move-lr-1 (car ml))
(move-lr (cdr ml)))
(defun move-lr-1 (move)
"Moves a single piece from the left to the right bank."
(setf *left-bank* (remove move *left-bank* :count 1))
(setf *right-bank* (snoc move *right-bank*)))
(defun move-rl (ml)
"Moves a list of pieces from the right to the left bank."
(when (null ml) (return-from move-rl))
(move-rl-1 (car ml))
(move-rl (cdr ml)))
(defun move-rl-1 (move)
"Moves a single piece from the right to the left bank."
(setf *right-bank* (remove move *right-bank* :count 1))
(setf *left-bank* (snoc move *left-bank*)))
;;;;;;;;;;;;;;;;;;;;;;
;;;; Counting Fns ;;;;
;;;;;;;;;;;;;;;;;;;;;;
(defun cannibal-count (l)
"Counts the number of cannibals in the given list."
(count 'C l))
(defun missionary-count (l)
"Counts the number of missionaries in the given list."
(count 'M l))
;;;;;;;;;;;;;;;;;;;;
;;;; Predicates ;;;;
;;;;;;;;;;;;;;;;;;;;
(defun goalp ()
"Returns T when the goal state has been reached."
(null *left-bank*))
(defun feast-state-p ()
"Returns T when the feast state has been reached."
(or (and (contains-missionaries-p *left-bank*)
(more-cannibals-p *left-bank*))
(and (contains-missionaries-p *right-bank*)
(more-cannibals-p *right-bank*))))
(defun more-cannibals-p (bank)
"Returns T if cannibals outnumber missionaries on the given bank."
(> (cannibal-count bank)
(missionary-count bank)))
(defun contains-missionaries-p (l)
"Returns T if the given list contains any missionaries, 'M."
(member 'M l))
(defun contains-boat-p (l)
"Returns T if the given list contains the boat 'B."
(member 'B l))
(defun applicable-p (move)
"Returns T if the given move is valid."
(let ((current-bank (current-bank))
(number-in-boat (1- (length move))))
(and (<= 1 number-in-boat 2) ; must have 1 or 2 people in boat
(contains-boat-p move) ; move must include boat
; must not move people who are not on the current bank
(>= (cannibal-count current-bank) (cannibal-count move))
(>= (missionary-count current-bank) (missionary-count move)))))
;;;;;;;;;;;;;;;;;;;;;;;;
;;;; State Checkers ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;
(defun current-bank ()
"Returns the current bank."
(if (contains-boat-p *left-bank*)
*left-bank*
*right-bank*))
(defun display-solution ()
"Displays the moves used in the last solution (or attempted solution)."
(dolist (m *move-list*)
(format T "~A~%" m)))
;;;;;;;;;;;;;;
;;;; Misc ;;;;
;;;;;;;;;;;;;;
(defun snoc (x the-list)
"Appends x to the-list."
(if (null the-list)
(list x)
(cons (car the-list)
(snoc x (cdr the-list)))))