SchemeTest

Aus ProgrammingWiki
;;Streambehandlung


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


;; Operationen mit streams

(define make-stream 
  (lambda (seed proc)
    (letrec 
      ((stream-builder
         (lambda (n)
           (stream-cons n (stream-builder (proc n))))))
      (stream-builder seed))))
  
(define stream-item
  (lambda (str k)
    (if (= k 0)
      (stream-car str)
      (stream-item (stream-cdr str) (- k 1)))))

(define stream-map
  (lambda (f str)
    (stream-cons
     (f (stream-car str))
     (stream-map f (stream-cdr str)))))

(define print-stream
  (lambda (stm n)
    (cond
      ((<= n 0) (display "...")(newline))
      (else
       (display (stream-car stm))
       (display ", ")
       (print-stream (stream-cdr stm) (- n 1))))))

(define nat_zahlen (make-stream 0 (lambda (n) (+ n 1))))

(define generiere_aufzaehlbare_menge
   (lambda (f)
      (stream-map f nat_zahlen )))

(define zeig-mir print-stream)

(define hilbert
  (lambda (n)
    #f))

(define baue-hilberthotel (generiere_aufzaehlbare_menge hilbert))

(define hilberthotel baue-hilberthotel)

(zeig-mir hilberthotel 11)

(define einzelbuchung
  (lambda (name stm pos)
    (if (not (equal? (stream-item stm pos) #f))
        (error "Fehler aufgetreten: Zimmer belegt.") 
        (cond
          ([and (= pos 0)(equal? (stream-item stm pos) #f)] (stream-cons name (stream-cdr stm)))
          (else (stream-cons (stream-car stm) (einzelbuchung name (stream-cdr stm) (- pos 1))))))))

(set! hilberthotel (einzelbuchung "Otto Grundmann" hilberthotel 3))

(zeig-mir hilberthotel 12)

(set! hilberthotel (einzelbuchung "Hella Milkel" hilberthotel 2))
;(set! hilberthotel (einzelbuchung "Heribert Wuischke" hilberthotel 3))
(set! hilberthotel (einzelbuchung "Heribert Wuischke" hilberthotel 7))

(zeig-mir hilberthotel 12)

(define baue-kleinbus1
  (lambda (name plaetze)
    (cond
      ([= plaetze 0] (list (cons name plaetze)))
      (else (cons (cons name plaetze) (baue-kleinbus1 name (- plaetze 1)))))))


(define umkehr
  (lambda (ls)
    (cond
      ([equal? (cdr ls) '()] (list (car ls)))
      (else (append (umkehr (cdr ls)) (list (car ls)))))))


(define baue-kleinbus
  (lambda (name plaetze)
    (umkehr (baue-kleinbus1 name plaetze))))

(define kleinbus815 (baue-kleinbus 815 8))

(write kleinbus815)
SchemeTest

Suche
