;;; (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 '())