Pyramide
;;; Gesucht wird eine Pyramide von Zahlen entsprechend dem
;;; PASCAL-schem Dreieck, allerdings mit Differenzen.
;;; Beispiel ( n = 3 ) : 6 2 5
;;; 4 3
;;; 1
;;; Diese Version liefert alle Lösungen !!!
;;;-----------------------------------------------------------
;;; ===== Hilfsfunktionen ====================================
(define
(alle-zahlen n)
(let
loop
((anzahl (/ (* n (add1 n)) 2)))
(cond
((zero? anzahl) ())
(else
(cons anzahl (loop (sub1 anzahl)))))))
;;; ===== fehlerhaft? ========================================
; untersucht, ob die Differenzen der Zeile gleich den Zahlen
; der unteren Zeile sind. #t wird nur dann zurückgegeben, wenn
; ein Fehler auftritt, nicht aber, wenn die Zeile noch nicht
; vollständig ist.
; ACHTUNG: Die Zeilen sind reversed zu übergeben!
(define
(fehlerhaft? zeile untere-zeile)
(cond
((null? zeile) #f)
((null? untere-zeile) #f)
((null? (cdr zeile)) #f)
((not
(or
(zero? (- (car untere-zeile) (- (car zeile) (cadr zeile))))
(zero? (- (car untere-zeile) (- (cadr zeile) (car zeile))))))
#t)
(else
(fehlerhaft? (cdr zeile) (cdr untere-zeile)))))
;;; ===== zeile-komplett-OK? =================================
; Die Zeile ist komplett und wegen der vorigen Abfrage OK,
; wenn sie um 1 länger ist als die untere Zeile.
(define
(zeile-komplett-OK? zeile untere-zeile)
(= 1 (- (length zeile)(length untere-zeile))))
;;; ===== entferne ===========================================
; entfernt das Element aus der Liste.
(define
(entferne element liste)
(cond
((null? liste) ())
((equal? element (car liste))
(cdr liste))
(else
(cons (car liste) (entferne element (cdr liste))))))
;;; ===== Suchfunktion =======================================
; n gibt die Anzahl der Ebenen an.
(define
(pyramide n)
(let
t-s?
((liste (alle-zahlen n))
(alternativen (alle-zahlen n))
(zeile ())
(untere-zeile ())
(alle-zeilen ()))
; (writeln "in t-s?" liste alternativen zeile untere-zeile)
(cond
((fehlerhaft? (reverse zeile) (reverse untere-zeile))
; Test liefert: Ast ist falsch. -->backtracking !
#f)
((zeile-komplett-OK? zeile untere-zeile)
(cond
((null? liste)
; Alle Zahlen sind vergeben, das Ergebnis kann ausgegeben werden.
(writeln (cons zeile alle-zeilen))
#t)
; sonst ist nach der nächsten Zeile zu suchen, ...
((t-s? liste liste () zeile (cons zeile alle-zeilen ))
#t)
; ... oder das Ergebnis war unzulässig
(else
#f)))
((null? alternativen)
; Alle Möglichkeiten versucht:
#f)
(else
; Nun muss das aktuell erste Element versucht werden.
(t-s?
(entferne (car alternativen) liste)
(entferne (car alternativen) liste)
(cons (car alternativen) zeile)
untere-zeile
alle-zeilen)
; Dann müssen die Alternativen bearbeitet werden:
(t-s?
liste
(cdr alternativen)
zeile
untere-zeile
alle-zeilen)))))
(require-library "breakpoint.scm")
(pyramide 3)