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