zurück
;;; ===== Start- und Zielzustand ====================================
(define Start-Zustand (list 3 3 'links))
(define Ziel-Zustand (list 0 0 'rechts))
;;; ===== Zugriffsfunktionen ========================================
; Zugriffsfunktionen für die einzelnen Komponenten.
(define (Liegeplatz Zustand) (caddr Zustand))
(define (M-links Zustand) (car Zustand))
(define (K-links Zustand) (cadr Zustand))
(define (M-rechts Zustand) (- 3 (car Zustand)))
(define (K-rechts Zustand) (- 3 (cadr Zustand)))

;;; ===== Bedingungen ===============================================
; Es treten Bedingungen für links und für rechts auf. Ist das Boot
; links, müssen rechts die Bedingungen erfüllt sein und umgekehrt.
; Die Prüffunktionen liefern jeweils eine Liste mit dem Zustand.
;;; ----- links-OK --------------------------------------------------
(define
  (links-OK Zustand)
  (cond
    ((negative? (M-links Zustand)) ())
    ((negative? (K-links Zustand)) ())
    ((and
      (positive? (M-links Zustand))
      (> (K-links Zustand) (M-links Zustand))) ())
    (else (list Zustand))))

;;; ----- rechts-OK -------------------------------------------------
(define
  (rechts-OK Zustand)
  (cond
    ((negative? (M-rechts Zustand)) ())
    ((negative? (K-rechts Zustand)) ())
    ((and
      (positive? (M-rechts Zustand))
      (> (K-rechts Zustand) (M-rechts Zustand))) ())
    (else (list Zustand))))

;;; ===== Boote =====================================================
; Es werden die möglichen Boote definiert. Sie bekommen den aktuellen
; Zustand übergeben und geben eine Liste mit dem Zielzustand zurück.
;;; ----- Boot-1 ----------------------------------------------------
; Zwei Missionare nach rechts.
(define
  (Boot-1 Zustand)
  (list
   (- (M-links Zustand) 2)
   (K-links Zustand)
   'rechts))

;;; ----- Boot-2 ----------------------------------------------------
; Zwei Kannibalen nach rechts.
(define
  (Boot-2 Zustand)
  (list
   (M-links Zustand)
   (- (K-links Zustand) 2)
   'rechts))

;;; ----- Boot-3 ----------------------------------------------------
; Je einen nach rechts.
(define
  (Boot-3 Zustand)
  (list
   (sub1 (M-links Zustand))
   (sub1 (K-links Zustand))
  'rechts))

;;; ----- Boot-4 ----------------------------------------------------
; Einen Missionar nach links.
(define
  (Boot-4 Zustand)
  (list
   (add1 (M-links Zustand))
   (K-links Zustand)
   'links))

;;; ----- Boot-5 ----------------------------------------------------
; Einen Kannibalen nach links.
(define
  (Boot-5 Zustand)
  (list
   (M-links Zustand)
   (add1 (K-links Zustand))
   'links))

;;; ===== Nachfolger ================================================
; Generiert alle zulässigen Nachfolger eines Zustandes.
(define
  (Nachfolger Zustand)
;  (bkpt (links-OK (Boot-1 Zustand)) Zustand)
  (if
   (equal? (Liegeplatz Zustand) 'links)
   (append
    (links-OK (Boot-1 Zustand))
    (links-OK (Boot-2 Zustand))
    (links-OK (Boot-3 Zustand)))
   (append
    (rechts-OK (Boot-4 Zustand))
    (rechts-OK (Boot-5 Zustand)))))

;;; ===== Tiefensuche ===============================================
; Der Suchraum entfällt.
(define
  (Tiefensuche Start Ziel)

  (let
      t-s
    ((Alternativen (Nachfolger Start))
     (besucht (list Start)))
    (cond
      ((null? Alternativen) #f)

      ((equal? (car Alternativen) Ziel)
       (writeln (reverse (cons (car Alternativen) besucht)))
       (newline)
       #t)

      ((member (car Alternativen) besucht)
       (t-s
        (cdr Alternativen)
        besucht))

      (else
       (t-s
        (Nachfolger (car Alternativen) )
        (cons (car Alternativen) besucht))

       (t-s
        (cdr Alternativen)
        besucht)))))

;;; ----- Testaufruf: -----------------------------------------------------
(Tiefensuche Start-Zustand Ziel-Zustand)
Es gibt eine relativ hohe Zahl Lösungen bei dieser Variante. Das sieht völlig anders aus, wenn man das Problem in der "traditionellen" Variante behandelt. Auch hierzu eine Lösung: Wieder zunächst einige Vorbemerkungen : Bei der hier betrachteten Variante muss zu jeder Zeit auf jeder Seite die Zahl der Missionare mindes-tens so gross sein wie die der Kannibalen, zusätzlich tritt die Forderung auf, dass nur einer der Kanni-balen Fährmann sein kann. Die Gesamtzahl der Missionare, der Kannibalen und des Fährmanns muss hier ebenfalls vor und nach einem Transport jeweils konstant sein, so dass nur eine Seite verwaltet werden muss.
;;; ===== Start- und Zielzustand ====================================
;;;               Missionare Kannibalen Fährmann Boot
(define Start-Zustand (list 3 2 1 'links))
(define Ziel-Zustand (list 0 0 0 'rechts))
;;; ===== Zugriffsfunktionen ========================================
; Zugriffsfunktionen für die einzelnen Komponenten.
(define (Liegeplatz Zustand) (cadddr Zustand))
(define (M-links Zustand) (car Zustand))
(define (K-links Zustand) (cadr Zustand))
(define (F-links Zustand) (caddr Zustand))
(define (K+F-links Zustand) (+ (K-links Zustand) (F-links Zustand)))
(define (M-rechts Zustand) (- 3 (M-links Zustand)))
(define (K-rechts Zustand) (- 2 (K-links Zustand)))
(define (F-rechts Zustand) (- 1 (F-links Zustand)))
(define (K+F-rechts Zustand) (- 3 (K+F-links Zustand)))

;;; ===== Bedingungen ===============================================
; Es treten Bedingungen für links und für rechts gemeinsam auf.
;;; ----- OK --------------------------------------------------------
(define
  (OK Zustand)
  (cond
    ((negative? (M-links Zustand)) ())
    ((negative? (K-links Zustand)) ())
    ((negative? (F-links Zustand)) ())
    ((negative? (M-rechts Zustand)) ())
    ((negative? (K-rechts Zustand)) ())
    ((negative? (F-rechts Zustand)) ())
    ((zero? (M-links Zustand)) (list Zustand))
    ((zero? (M-rechts Zustand)) (list Zustand))
    ((> (K+F-links Zustand) (M-links Zustand)) ())
    ((> (K+F-rechts Zustand) (M-rechts Zustand)) ())
    (else (list Zustand))))

;;; ===== Boote =====================================================
; Es werden die möglichen Boote definiert. Sie bekommen den aktuellen
; Zustand übergeben und geben eine Liste mit dem Zielzustand zurück.
; Der Verschiebunsoperator ergibt sich aus der Richtung.
;;; ----- Boot-1 ----------------------------------------------------
; Zwei Missionare.
(define
  (Boot-1 Zustand)
  (list
   (+ (M-links Zustand)
      (if (equal? (Liegeplatz Zustand) 'links) -2 2))
   (K-links Zustand)
   (F-links Zustand)
   (if (equal? (Liegeplatz Zustand) 'links) 'rechts 'links)))

;;; ----- Boot-2 ----------------------------------------------------
; Kannibale mit Fährmann.
(define
  (Boot-2 Zustand)
  (list
   (M-links Zustand)
   (+ (K-links Zustand)
      (if (equal? (Liegeplatz Zustand) 'links) -1 1))
   (+ (F-links Zustand)
      (if (equal? (Liegeplatz Zustand) 'links) -1 1))
   (if (equal? (Liegeplatz Zustand) 'links) 'rechts 'links)))

;;; ----- Boot-3 ----------------------------------------------------
; Missionar und Kannibale.
(define
  (Boot-3 Zustand)
  (list
   (+ (M-links Zustand)
      (if (equal? (Liegeplatz Zustand) 'links) -1 1))
   (+ (K-links Zustand)
      (if (equal? (Liegeplatz Zustand) 'links) -1 1))
   (F-links Zustand)
   (if (equal? (Liegeplatz Zustand) 'links) 'rechts 'links)))

;;; ----- Boot-4 ----------------------------------------------------
;  Missionar und Fährmann.
(define
  (Boot-4 Zustand)
  (list
   (+ (M-links Zustand)
      (if (equal? (Liegeplatz Zustand) 'links) -1 1))
   (K-links Zustand)
   (+ (F-links Zustand)
      (if (equal? (Liegeplatz Zustand) 'links) -1 1))
   (if (equal? (Liegeplatz Zustand) 'links) 'rechts 'links)))

;;; ----- Boot-5 ----------------------------------------------------
; Ein Missionar.
(define
  (Boot-5 Zustand)
  (list
   (+ (M-links Zustand)
      (if (equal? (Liegeplatz Zustand) 'links) -1 1))
   (K-links Zustand)
   (F-links Zustand)
   (if (equal? (Liegeplatz Zustand) 'links) 'rechts 'links)))

;;; ----- Boot-6 ----------------------------------------------------
; Der Fährmann.
(define
  (Boot-6 Zustand)
  (list
   (M-links Zustand)
   (K-links Zustand)
   (+ (F-links Zustand)
      (if (equal? (Liegeplatz Zustand) 'links) -1 1))
   (if (equal? (Liegeplatz Zustand) 'links) 'rechts 'links)))

;;; ===== Nachfolger ================================================
; Generiert alle zulässigen Nachfolger eines Zustandes.
(define
  (Nachfolger Zustand)
;  (bkpt (links-OK (Boot-1 Zustand)) Zustand)
   (append
    (OK (Boot-1 Zustand))
    (OK (Boot-2 Zustand))
    (OK (Boot-3 Zustand))
    (OK (Boot-4 Zustand))
    (OK (Boot-5 Zustand))
    (OK (Boot-6 Zustand))))