hilbert

Aus ProgrammingWiki

Archivierte Version vom 2012-03-30T14:47:13+00:00. Aktuelle Version

(require-library 'sisc/libs/srfi/srfi-89)
(import srfi-89)

;; Selektoren
(define stream-car car)
(define stream-cdr
  (lambda (stm)
    (force (cdr stm))))

;; Konstruktoren
(define-syntax stream-cons
  (syntax-rules ()
    ((_ head tail) (cons head (delay tail)))))

;; Praedikat
(define stream?
  (lambda (stm)
    (and (pair? stm)(promise? (cdr stm)))))

;; Operationen mit streams
(define print-stream
  (lambda (stm n)
    (cond
      ((<= n 0) (printf "...~n"))
      (else
       (printf "~a, " (stream-car stm))
       (print-stream (stream-cdr stm) (- n 1))))))

;; Hilberthotel
(define baue-hilberthotel
  (lambda ()
    (stream-cons "#f" (baue-hilberthotel))
  )
)
(define baue-kleinbus
  (lambda (name count)
    (if (> count 0) 
        (append (baue-kleinbus name (- count 1)) (list (cons name count)))
        (list (cons name count))
    )
  )
)
(define baue-hilbertbus
  (lambda (name [start 0])
    (stream-cons (cons name start) (baue-hilbertbus name (+ start 1)))
  )
)
(define konvoimacher
  (lambda (name [abteilung 0])
    (stream-cons (baue-hilbertbus (string-append name (number->string abteilung))) (konvoimacher name (+ abteilung 1)))
  )
)
(define einzelbuchung
  (lambda (value stream index)
    (if (<= index 0)
        (if (eq? (stream-car stream) "#f")
            (stream-cons value (stream-cdr stream))
            (error (string-append "Error in einzelbuchung: Dieses Zimmer ist schon durch " (stream-car stream) " belegt."))
        )
        (stream-cons (stream-car stream) (einzelbuchung value (stream-cdr stream) (- index 1)))
    )
  )
)
(define kleingruppenbuchung
  (lambda (list stream)
    (if (null? list)
        stream
        (if (eq? (stream-car stream) "#f")
            (stream-cons (car list) (kleingruppenbuchung (cdr list) (stream-cdr stream)))
            (stream-cons (stream-car stream) (kleingruppenbuchung list (stream-cdr stream)))
        )
    )
  )
)
(define check-in
  (lambda (bus-stream hotel-stream)
    (if (eq? (stream-car hotel-stream) "#f")
        (stream-cons (stream-car bus-stream) (check-in (stream-cdr bus-stream) (stream-cdr hotel-stream)))
        (stream-cons (stream-car hotel-stream) (check-in bus-stream (stream-cdr hotel-stream)))
    )
  )
)
(define gehe-in-gerade
  (lambda (hotel-stream)
    (stream-cons (stream-car hotel-stream) (stream-cons "#f" (gehe-in-gerade (stream-cdr hotel-stream))))
  )
)
(define zeig-mir
  (lambda (stream [n null] [m null])
    (if (stream? stream)
        (if (stream? (stream-car stream))
            (begin ;; konvoi
             (if (<= n 0)
                 (if (<= m 0)
                     (printf "...~n")
                     (begin
                      (printf "..., ")
                      (zeig-mir stream 0 (- m 1))
                     )
                  )
                 (begin
                  (print-stream (stream-car stream) m)
                  (zeig-mir (stream-cdr stream) (- n 1) m)
                 )
             )
            )
            (print-stream stream n) ;; hotel oder bus
        )
        (display stream);; alles andere, zB kleinbus (liste)
    )
  )
)

;; berechnung der Umkehrfunktion der Paarungsfunktion
(define helper-f
  (lambda (i)
    (/ (* (+ i 1) i) 2)
  )
)
(define helper-q
  (lambda (i)
    (letrec (
      (helfer
       (lambda (zaehler)
         (if (<= (helper-f zaehler) i)
             (helfer (+ zaehler 1))
             zaehler
         )
       )
      ))
      (- (helfer 0) 1)
    )
  )
)

(define zimmer
  (lambda (nr stream)
    (if (<= nr 0)
        (stream-car stream)
        (zimmer (- nr 1) (stream-cdr stream))
    )
  )
)

(define konvoi->kette
  (lambda (konvoi [index 0])
    (letrec (
      (hole-person
       (lambda (busse bus-nr platz-nr)
         (if (<= bus-nr 0)
             (zimmer platz-nr (stream-car busse)) ;; zimmer-funktion hat gleiches Prinzip :-)
             (hole-person (stream-cdr busse) (- bus-nr 1) platz-nr)
         )
       )
      ))
      (let ((j (helper-q index)))
        (let ((y (- index (helper-f j))))
          (let ((x (- j y)))
            (stream-cons (hole-person konvoi x y) (konvoi->kette konvoi (+ index 1)))
          )
        )
      )
     )
  )
)

(define hilberthotel (baue-hilberthotel))
(zeig-mir hilberthotel 11)

(printf "~nEinzelbuchungen:~n")
(force (set! hilberthotel (einzelbuchung "Otto Grundmann" hilberthotel 3)))
(force (set! hilberthotel (einzelbuchung "Hella Milkel" hilberthotel 2)))
(force (set! hilberthotel (einzelbuchung "Heribert Wuischke" hilberthotel 7)))
(zeig-mir hilberthotel 12)

(printf "~nKleingruppe reist an:~n")
(define kleinbus815 (baue-kleinbus 815 8))
(zeig-mir kleinbus815)
(printf "~nZimmerbelegung nach Check-In:~n")
(force (set! hilberthotel (kleingruppenbuchung kleinbus815 hilberthotel)))
(zeig-mir hilberthotel 15)

(printf "~ngroooßer Hilbertbus kommt angefahren:~n")
(define bus3813 (baue-hilbertbus 3813))
(zeig-mir bus3813 8)
(printf "Zimmerbelegung nach Check-In:~n")
(force (set! hilberthotel (check-in bus3813 hilberthotel)))
(zeig-mir hilberthotel 20)

(printf "~nTelefonanruf: groooßer Hilbertbus 33 kündigt sich an:~n")
(define bus33 (baue-hilbertbus 33))
(zeig-mir bus33 8)
(printf "Jeder Gast zieht in ein gerades Zimmer:~n")
(force (set! hilberthotel (gehe-in-gerade hilberthotel)))
(zeig-mir hilberthotel 30)
(printf "Bus 33 kommt: Zimmerbelegung nach Check-In:~n")
(force (set! hilberthotel (check-in bus33 hilberthotel)))
(zeig-mir hilberthotel 30)

(printf "~nMacrohard macht Betriebsausflug mit folgenden Bussen (eine Zeile = 1 Bus):~n")
(define k1 (konvoimacher "MH"))
(zeig-mir k1 4 8)

(printf "~nPassagiere treten in folgender Reihenfolge zum Check-In an:~n")
(zeig-mir (konvoi->kette k1) 20)
(printf "Zimmerbelegung nach Check-In:~n")
(force (set! hilberthotel (gehe-in-gerade hilberthotel)))
(force (set! hilberthotel (check-in (konvoi->kette k1) hilberthotel)))
(zeig-mir hilberthotel 42)

(printf "~nWere wohnt in Zimmer 234?~n")
(zeig-mir (zimmer 234 hilberthotel))

hilbert

Suche