cannibals.rkt

#lang racket

(require racket/match)

;; initial-state :: State
;; State = (Missionaries on left, Cannibals on left, Boat on left?)
(define initial-state '(3 3 #t))

;; goal-state :: State
(define goal-state '(0 0 #f))

;; valid :: State -> Bool
(define valid?
  (λ (state)
    (let* ([m   (car state)]
           [m-r (- 3 m)]
           [c   (second state)]
           [c-r (- 3 c)])
      (and (or (= m 0) (>= m c))
           (or (= m-r 0) (>= m-r c-r))
           (<= m 3)
           (<= c 3)
           (>= m 0)
           (>= c 0)))))

;; carry :: State -> Move -> (State | '())
(define carry
  (λ (state change)
    (match-let*
        ([(list m c b)           state]
         [(list m-delta c-delta) change]
         [(list move-op new-b)   (if b (list - #f) (list + #t))]
         [new-state              (list (move-op m m-delta) (move-op c c-delta) new-b)])
     (if (valid? new-state) new-state null))))

;; only 5 possible state changes:
;; state-change-{right,left} :: [(Missionaries, Cannibals)]
(define state-change-right '((2 0) (0 2) (1 1) (1 0) (0 1)))
(define state-change-left  '((0 1) (1 0) (1 1) (0 2) (2 0)))

;; try all 5 possibilities, or at least until reaching a next state
;; next-level :: State -> (State | #f)
(define next-level
  (λ (state choices)
    (match choices
      ['() #f]
      [_ (let* ([choice    (car choices)]
                [new-state (carry state choice)])
           (if (not (null? new-state))
               new-state
               (next-level state (cdr choices))))])))

;; bfs :: State -> State
(define bfs
  (λ (state)
    (let* ([b   (third state)]
           [res (next-level state (if b state-change-right state-change-left))])
      (if (or (not res) (equal? res goal-state))
          (list res)
          (cons state (bfs res))))))