zurück

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)