vorige nächste
;;;                                            (8dame.scm)
;;;
;;; "Gute" Version fuer das Suchen einer Loesung.
;;;                                =====
;;; ----------------------------------------------------------
; Es wird zwar prinzipiell mit dem Programm zur Tiefensuche
; gearbeitet, bei jeder neuen Besetzung wird aber geprüft, ob
; die Bedingungen (constraints) verletzt werden. Ist das der
; Fall, wird der Ast nicht weiter verfolgt.
;;; ----- maxZahl --------------------------------------------
; Die Angabe der mit Damen besetzen Felder erfolgt mit den
; Zahlen von 1 .. maxZahl.
(define maxZahl 12)
;;; ----- Tiefensuche ----------------------------------------
; Zeile x Spalte x Liste von Zahlen --> boolean
; In der Damenliste wird die Spaltenposition der Damen geführt
; für Zeile 1 .. aktuell besetzte Zeile.
;{1} Zunächst wird geprüft, ob die Damenliste zulässig ist.
;{2} Es sind alle Zeilen gefüllt. Die Belegung muss wegen der
; vorigen Abfrage zulässig sein. Daher wird die Damenliste
; ausgegeben und #t zurückgegeben.
;{3} keine Alternativen mehr in der Zeile.
;{4} Zunächst der Versuch, in die Tiefe zu gehen. Die Damen
; werden beginnend in der ersten Spalte nacheinander auf alle
; Spaltenpositionen gesetzt.
;{5} Das geschieht hier beim Schritt in die Breite.
(define
   (Tiefensuche Zeile Spalte Damenliste)
   (cond
      ((not (zulaessig? Damenliste)) #f)                ;{1}
      ((> Zeile maxZahl)                                ;{2}
       (writeln (reverse Damenliste))
       #t)
      ((> Spalte maxZahl) #f)                           ;{3}
      (else                                             ;{4}
       (if
        (Tiefensuche
         (add1 Zeile)
         1
         (cons Spalte Damenliste))
        #t
        (Tiefensuche                                   ;{5}
         Zeile
            (add1 Spalte)
            Damenliste)))))

;;; ===== zulaessig? =========================================
; Eine Position ist zulässig, wenn
; <1> keine Zeile doppelt auftritt. Das ist durch den
; Algorithmus ausgeschlossen.
; <2> keine Spalte doppelt auftritt. Das ist bei diesem
; Algorithmus nur für die neu hinzugekommene Spalte zu unter-
; suchen.
; <3> kein Diagonalelement sich wiederholt. Das ist auch
; ebenfalls nur für die neu hinzugekommene Spalte zu unter-
; suchen.
(define
  (zulaessig? liste)
  (or
   (null? liste)                       ; noch keine gesetzt
   (null? (cdr liste))                 ; erst eine gesetzt
   (and
    (not
     (member (car Liste) (cdr Liste)))
    (links-oben-OK? Liste)
    (rechts-oben-OK? Liste))))

;;; ----- links-oben-OK? -------------------------------------
; Wenn die Koordinatendifferenz gleich ist, liegen die Punkte
; auf einer Diagonalen nach rechts unten, wenn sie umgekehrt
; gleich ist, liegen sie auf einer Diagonalen nach links unten.
(define
  (links-oben-OK? liste)
  (let
      loop
    ((aktuell (car liste))
     (Liste (cdr liste)))
    (cond
      ((zero? aktuell) #t)
      ((null? liste) #t)
      ((= (sub1 aktuell) (car liste)) #f)
      (else
       (loop (sub1 aktuell) (cdr liste))))))

;;; ----- rechts-oben-OK? ------------------------------------
; Wenn sie umgekehrt gleich ist, liegen sie auf einer
; Diagonalen nach rechts oben.
(define
  (rechts-oben-OK? liste)
  (let
      loop
    ((aktuell (car liste))
     (Liste (cdr liste)))
    (cond
      ((> aktuell maxZahl) #t)
      ((null? liste) #t)
      ((= (add1 aktuell) (car liste)) #f)
      (else
       (loop (add1 aktuell) (cdr liste))))))

;;;==============================================================
(require-library "breakpoint.scm")
(Tiefensuche 1 1 '())