;;; (magische Quadrate.scm) (require-library "breakpoint.scm") ;;; Albowski , 3'2001 ;;; Auf der Grundlage von 8 Damen ;;; ----------------------------------------------------------------- ; Es wird zwar prinzipiell mit dem Programm zur Tiefensuche ; gearbeitet, bei jeder neuen Besetzung n/2n/usw. wird aber geprüft, ; ob die Bedingungen (constraints) verletzt werden. Ist das der ; Fall, wird der Ast nicht weiter verfolgt. ;;; ----- maxZahl --------------------------------------------------- ; Die Angabe der Zeilen und Spalten des Quadrates regelt maxZahl. (define maxZahl 3) ;;; ----- 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. ;{4} Zunächst der Versuch, in die Tiefe zu gehen. Die Damen ; werden beginnend in der ersten Spalte nacheinander auf alle ; Spaltenpositionen gesetzt. ;{5} Zur nächsten Alternative. (define (Tiefensuche maxZahl) (letrec ((Gesamtzahl (* maxZahl maxZahl)) (Summe (/ (* maxZahl (add1 Gesamtzahl)) 2))) (let t-s ((Anzahl 0) (Quadrat ()) (Versuch Gesamtzahl)) (cond ((zero? Versuch) #f) ; erfolglos ((and (not (zero? Anzahl)) (member (car Quadrat) (cdr Quadrat))) ; war schon #f) ((and (not (zero? Anzahl)) (zero? (modulo Anzahl maxZahl)) ; Zeile voll (Zeilenfehler Summe maxZahl Quadrat)) #f) ((and ; in der letzten Zeile (>= (quotient (sub1 Anzahl) maxZahl) (sub1 maxZahl)) (Spaltenfehler Summe maxZahl Quadrat)) #f) ((= Anzahl Gesamtzahl) ; Quadrat voll (if (Diagonalenfehler Summe maxZahl Quadrat) #f (Darstellung Quadrat maxZahl))) ;;; Versuch in die Tiefe : ((t-s (add1 Anzahl) (cons Versuch Quadrat) Gesamtzahl)) (else ;;; Abbau der Alternativen : (t-s Anzahl Quadrat (sub1 Versuch))))))) ;;; ===== Zeilenfehler ============================================== ; Prüft die maxZahl ersten Elemente der Liste Quadrat. (define (Zeilenfehler Summe maxZahl Quadrat) (not (= Summe (apply + (list-tail (reverse Quadrat) (- (length Quadrat) maxZahl)))))) ;;; ===== Spaltenfehler ============================================= ; Prüft die Elemente der Liste Quadrat an den Positionen 1, 1+maxZahl ; usw. ; Dazu wird jeweils die maxZahl-te Restliste gebildet. (define (Spaltenfehler Summe maxZahl Quadrat) (not (= Summe (let loop ((Summe-ist 0) (Quadrat Quadrat)) (cond ((< (length Quadrat) (add1 maxZahl)) (+ Summe-ist (car Quadrat))) (else (loop (+ Summe-ist (car Quadrat)) (list-tail Quadrat maxZahl)))))))) ;;; ===== Diagonalenfehler ============================================= ; Prüft die Elemente der beiden Diagonalen. ; usw. ;;; Dazu wird einmal jeweils die maxZahl+1-te Restliste gebildet: (define (Hauptdiagonalenfehler Summe maxZahl Quadrat) (not (= Summe (let loop ((Summe-ist 0) (Quadrat Quadrat)) (cond ((< (length Quadrat) (add1 maxZahl)) (+ Summe-ist (car Quadrat))) (else (loop (+ Summe-ist (car Quadrat)) (list-tail Quadrat (add1 maxZahl))))))))) ;;; Andererseits wird beginnend beim maxZahl-ten Element jeweils die ;;; maxZahl-1-te Restliste gebildet: (define (Nebendiagonalenfehler Summe maxZahl Quadrat) (not (= Summe (let loop ((Summe-ist 0) (Quadrat (list-tail Quadrat (sub1 maxZahl)))) (cond ((< (length Quadrat) (add1 maxZahl)) (+ Summe-ist (car Quadrat))) (else (loop (+ Summe-ist (car Quadrat)) (list-tail Quadrat (sub1 maxZahl))))))))) ;;; Und die Zusammenfassung: (define (Diagonalenfehler Summe maxZahl Quadrat) (or (Hauptdiagonalenfehler Summe maxZahl Quadrat) (Nebendiagonalenfehler Summe maxZahl Quadrat))) ;;; ===== Darstellung =============================================== (define (Darstellung Quadrat maxZahl) (let loop ((Quadrat Quadrat)) (cond ((null? Quadrat) (newline)) ((zero? (modulo (sub1 (length Quadrat)) maxZahl)) (fuenf-Zeichen (car Quadrat)) (newline) (loop (cdr Quadrat))) (else (fuenf-Zeichen (car Quadrat)) (loop (cdr Quadrat)))))) ;;; ===== fuenf-Zeichen ========================================== (define (fuenf-Zeichen Zahl) (display (string-append (substring " " 0 (- 5 (string-length (number->string Zahl)))) (number->string Zahl)))) ;;;================================================================== (define ist-eins '(6 7 2 1 5 9 8 3 4)) (Tiefensuche 3)