;; Die ersten drei Zeilen dieser Datei wurden von DrScheme eingefügt. Sie enthalten Metadaten
;; über die Sprachebene dieser Datei in einer Form, die DrScheme verarbeiten kann.
#reader(lib "DMdA-vanilla-reader.ss" "deinprogramm")((modname kapitel-7) (read-case-sensitive #f) (teachpacks ()) (deinprogramm-settings #(#f write repeating-decimal #f #t none explicit #f ())))
; Kapitel 7

; Länge einer Liste berechnen
(: list-length ((list-of %a) -> natural))
(check-expect (list-length (list 2 3 4 5)) 4)
(check-expect (list-length empty) 0)
(check-expect (list-length (make-pair 1 empty)) 1)

(define list-length
  (lambda (lis)
    (cond
      ((empty? lis) 0)
      ((pair? lis) 
       (+ 1 
          (list-length (rest lis)))))))

; zwei Listen aneinanderhängen
(: concatenate ((list-of %a) (list-of %a) -> (list-of %a)))
(check-expect (concatenate (list 1 2 3) (list 4 5 6)) (list 1 2 3 4 5 6))
(check-expect (concatenate (list 1 2 3) empty) (list 1 2 3))
(check-expect (concatenate empty (list 1 2 3)) (list 1 2 3))
(check-expect (concatenate empty empty) empty)
(check-expect (concatenate (list 1 2 3) (list "vier" "fünf" "sechs")) (list 1 2 3 "vier" "fünf" "sechs"))

(define concatenate
  (lambda (lis-1 lis-2)
    (cond
      ((empty? lis-1) lis-2)
      ((pair? lis-1) 
       (make-pair (first lis-1)
                  (concatenate (rest lis-1) lis-2))))))

;;ein Pfahl wird durch eine Zahl zwischen 1 und 3 repräsentiert
(define peg (signature (one-of 1 2 3)))

; Ein Hanoi-Spielzug besteht aus
; - der Nummer für einen Pfahl
; - der Nummer für den Pfahl wohin der Zug gemacht werden soll
(: make-hanoi-move (peg peg -> hanoi-move))
(: hanoi-move? (any -> boolean))
(: hanoi-move-from (hanoi-move -> peg))
(: hanoi-move-to (hanoi-move -> peg))

(define-record-procedures hanoi-move
  make-hanoi-move hanoi-move?
  (hanoi-move-from hanoi-move-to))

; Hanoi-Puzzle lösen
(: hanoi (natural -> (list-of hanoi-move)))
(check-expect (hanoi 1) (list (make-hanoi-move 1 3)))
(check-expect (hanoi 3) (list (make-hanoi-move 1 3) (make-hanoi-move 1 2) (make-hanoi-move 3 2) (make-hanoi-move 1 3) (make-hanoi-move 2 1) (make-hanoi-move 2 3) (make-hanoi-move 1 3)))

(define hanoi
  (lambda (n)
    (if (= n 0)
        empty
        (append
         (renumber-moves (hanoi (- n 1)) 3 2)
         (make-pair
          (make-hanoi-move 1 3)
          (renumber-moves (hanoi (- n 1)) 1 2))))))

; die Züge in einer Hanoi-Folge umnumerieren
(: renumber-moves ((list-of hanoi-move) peg peg -> (list-of hanoi-move)))
(check-expect (renumber-moves (list (make-hanoi-move 1 2) (make-hanoi-move 2 1)) 2  3) (list (make-hanoi-move 1 3) (make-hanoi-move 3 1)))

(define renumber-moves
  (lambda (moves peg-1 peg-2)
    (cond
      ((empty? moves) empty)
      ((pair? moves)
       (make-pair (renumber-move (first moves) peg-1 peg-2)
                  (renumber-moves (rest moves) peg-1 peg-2))))))

; in einem Zug einen Pfahl mit einem anderen vertauschen
(: renumber-move (hanoi-move peg peg -> hanoi-move))
(check-expect (renumber-move (make-hanoi-move 1 2) 2 3) (make-hanoi-move 1 3))

(define renumber-move
  (lambda (move peg-1 peg-2)
    (make-hanoi-move
     (renumber-peg (hanoi-move-from move) peg-1 peg-2)
     (renumber-peg (hanoi-move-to move) peg-1 peg-2))))

; einen Pfahl mit einem anderen vertauschen
(: renumber-peg (number number number -> number))
(check-expect (renumber-peg 1 2 3) 1)
(check-expect (renumber-peg 2 2 3) 3)

(define renumber-peg
  (lambda (peg peg-1 peg-2)
    (cond
      ((= peg peg-1) peg-2)
      ((= peg peg-2) peg-1)
      (else peg))))

; (define hanoi
;   (lambda (n)
;     (if (= n 0)
;         empty
;         (let ((one-less (hanoi (- n 1))))
;           (append
;            (renumber-moves one-less 3 2)
;            (make-pair
;             (make-hanoi-move 1 3)
;             (renumber-moves one-less 1 2)))))))

; Materialvolumen eines Rohrs berechnen
(: pipe-volume (number number number -> number))
(check-within (pipe-volume 3 1 5) 78.53981625 0.1)
(check-within (pipe-volume 2 1 1) 9.424777 0.1)

(define pipe-volume
  (lambda (outer-radius thickness height)
    (let ((inner-radius (- outer-radius thickness)))
      (- (cylinder-volume outer-radius height)
         (cylinder-volume inner-radius height)))))

; Volumen eines Zylinders berechnen
(: cylinder-volume (number number -> number))
(check-within (cylinder-volume 1 1) pi 0.1)
(check-within (cylinder-volume 3 5) 141.37166925 0.1)

(define cylinder-volume
  (lambda (radius height)
    (* (circle-area radius) height)))

; Fläche eines Kreises berechnen
(: circle-area (number -> number))
(check-within (circle-area 2) 12.5663706 0.1)
(check-within (circle-area 4) 50.2654824 0.1)

(define circle-area
  (lambda (radius)
    (* pi (square radius))))

; Kreiskonstante
; pi : number
(define pi 3.14159265)

; Zahl quadrieren
(: square (number -> number))
(check-expect (square 0) 0)
(check-expect (square 3) 9)

(define square
  (lambda (x)
    (* x x)))

; Ein Titel besteht aus
; - einer Nummer für den Titel
; - einer Länge in Sekunden
(: make-title (number number -> title))
(: title? (any -> boolean))
(: title-number (title -> number))
(: title-size (title -> number))

(define-record-procedures title
  make-title title?
  (title-number title-size))

; Liste der Titel auf Appetite for Destruction
(: appetite (list-of title))
(define appetite
  (list (make-title 1 274)
        (make-title 2 203)
        (make-title 3 268)
        (make-title 4 264)
        (make-title 5 229)
        (make-title 6 406)
        (make-title 7 220)
        (make-title 8 232)
        (make-title 9 356)
        (make-title 10 197)
        (make-title 11 207)
        (make-title 12 373)))

; maximale Liste von Titeln berechnen, 
; die auf eine Kassettenhälfte passen
(: side-a-titles ((list-of title) number -> (list-of title)))
(check-expect (side-a-titles (list (make-title 1 10)) 10) (list (make-title 1 10)))
(check-expect (side-a-titles (list (make-title 1 10) (make-title 2 11)) 10) (list (make-title 1 10)))
(check-expect (side-a-titles (list (make-title 1 10) (make-title 2 11) (make-title 3 9)) 20) (list (make-title 2 11) (make-title 3 9)))

(define side-a-titles
  (lambda (titles side-size)
    (cond
      ((empty? titles) empty)
      ((pair? titles)
       (let ((first-size (title-size (first titles))))
         (if (> first-size side-size)
             (side-a-titles (rest titles) side-size)
             (let ((titles-1 (side-a-titles (rest titles) side-size))
                   (titles-2
                    (make-pair (first titles)
                               (side-a-titles
                                (rest titles) 
                                (- side-size first-size)))))
               (if (> (titles-size titles-1)
                      (titles-size titles-2))
                   titles-1
                   titles-2))))))))

; Gesamtlänge einer Liste von Titeln berechnen
(: titles-size ((list-of title) -> number))
(check-expect (titles-size (list (make-title 1 10))) 10)
(check-expect (titles-size (list (make-title 1 10) (make-title 2 11) (make-title 3 9))) 30)

(define titles-size
  (lambda (titles)
    (cond
      ((empty? titles) 0)
      ((pair? titles)
       (+ (title-size (first titles))
          (titles-size (rest titles)))))))