; \subsection{Ausdrücke}

(+ 3 4)
(- 27 19)
(* 13 6)
(/ 27 9)
(/ 10 6)
(/ 10 6.0)
(+ 2.7 10)

(+ 3 4 2 10)
(* 2 6 3)

(* (+ 2 
      (* 4 6))
   (+ 3 5 7))

(- 27 2 5 6)

; \subsection{Namen und Belegungen} 

(define size 2)
size
(* 5 size)
(+ (* 5 size) (* size size))

(define pi 3.14159)
(define radius 10)
(* pi (* radius radius))
(define circumference (* 2 pi radius))
circumference


; \subsection{Auswertung von Kombinationen von primitiven Prozeduren}

(* (+ 2 
      (* 4 6))
   (+ 3 5 7))


; \subsection{Benutzerdefinierte Prozeduren}

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

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

(square 3)
(square (+ 2 5))

(square + 2 5)


(square (square 3))

(define (sum-of-squares x y) (+ (square x) (square y)))

(define alt-sum-of-square (lambda (x y) (+ (square x) (square y))))
(alt-sum-of-square 3 4)

(sum-of-squares 3 4)


; \subsection{Bedingte Ausdrücke}

(define (abs x)
  (cond ((> x 0) x)
        ((= x 0) 0)
        ((< x 0) (- x))))

(abs -7)

(define (abs x)
  (cond ((< x 0) (- x))
        (else x)))

(define (abs x)
  (if (< x 0) 
      (- x)
      x))

; Man schreibe ein Scheme Programm, daß für drei gegebene Zahlen die
; Summe der Quadrate der beiden größten Zahlen zurückgibt.

; Erste Loesung:

(define (sum-of-squares x y)
  (+ (* x x) (* y y)))

(define (sum-max-squares a b c)
  (sum-of-squares (max a b c) (mean a b c)))

(define (mean a b c)
  (cond ((or (<= a b c) (<= c b a)) b)
        ((or (<= b a c) (<= c a b)) a)
        (else c)))      

(sum-max-squares 2 3 4)
(sum-max-squares 5 3 4)

(or #t #t #t #f)
(and #t #t #t #f)

(mean 7 3 5)
(mean 7 4 1)
(mean 2 9 5)

; Zweite Loesung:

(define (sum-max-squares a b c)
  (if (< a b)
      (if (< a c)
          (sum-of-squares b c)
          (sum-of-squares a b))
      (if (< b c)
          (sum-of-squares a c)
          (sum-of-squares a b))))

(sum-max-squares 2 3 4)
(sum-max-squares 5 3 4)

; Dritte Loesung:

(define (sum-max-squares a b c)
  (if (< a b)
      (sum-of-squares b (if (< a c)
                            c
                            a))
      (sum-of-squares a (if (< b c)
                            c
                            b))))

(sum-max-squares 2 3 4)
(sum-max-squares 5 3 4)


; \subsection{Primitive Rekursion und Iteration}

(define (factorial1 n)
  (if (= 0 n)
      1
      (* n (factorial1 (- n 1)))))

(trace factorial1)
(factorial1 6)
(untrace factorial1)

(define (factorial2 n)
  (fact-iter 1 1 n))

(define (fact-iter product counter max-count)
  (if (> counter max-count)
      product
      (fact-iter (* counter product)
                 (+ counter 1)
                 max-count)))

(trace fact-iter)
(factorial2 60)
(untrace fact-iter)


(define (fib n)
  (cond ((= 0 n) 0)
        ((= 1 n) 1)
        (else (+ (fib (- n 1))
                 (fib (- n 2))))))

(trace fib)
(fib 5)
(untrace fib)


; \subsection{Ungeschachtelte Rekursion} 

(define (fib n)
  (fib-iter 1 0 n))

(define (fib-iter res prev count)
  (if (= 0 count)
      prev
      (fib-iter (+ res prev) res (- count 1))))

(trace fib-iter)
(fib 100)
(untrace fib-iter)

(define (binom n k)
  (cond ((< n k) 0)
        ((= k 0) 1)
        (else (+ (binom (- n 1) (- k 1)) 
                 (binom (- n 1) k)))))

(trace binom)
(binom 4 3)
(untrace binom)


; \subsection{Geschachtelte Rekursion}

(define (ack x y)
  (cond ((= y 0) 0)
        ((= x 0) (* 2 y))
        ((= y 1) 2)
        (else (ack (- x 1) (ack x (- y 1))))))

(trace ack)
(ack 1 10)
(ack 2 4)
(ack 3 3)
(untrace ack)


; \subsection{Hoeherstufige Prozeduren}

(define (sum-integers a b)
  (if (> a b)
      0
      (+ a (sum-integers (+ a 1) b))))

(define (sum-sqares a b)
  (if (> a b)
      0
      (+ (square a) (sum-squares (+ a 1) b))))

(define (pi-sum a b)
  (if (> a b)
      0
      (+ (/ 1 (* a (+ a 2))) (pi-sum (+ a 4) b))))

(* 8.0 (pi-sum 1 100))
(* 8.0 (pi-sum 1 1500))

(define (sum summand-fct next-fct a b)
  (if (> a b)
      0
      (+ (summand-fct a)
         (sum summand-fct next-fct (next-fct a) b))))


; \subsection{Paare} 

(define x (cons 1 2))
(car x)
(cdr x)

(define x (cons 1 2))
(define y (cons 3 4))
(define z (cons x y))
(car (car z))
(car (cdr z))


; \subsection{Darstellung von Listen}

(define a (list 1 2 3 4))
a                        
(map square a)           


; \subsection{Symbole und die Notwendigkeit der Quotierung}

(define a 1)
(define b 2)
(list a b)  
(list 'a 'b)
(list 'a b) 

(car '(a b c))
(cdr '(a b c))

(define (binom-coeff n k)
  (list-ref (pasc-layer n) k))

(define (pasc-layer n)
  (if (zero? n)
      '(1)
      (let ((l (pasc-layer (- n 1))))
        (map + (cons 0 l) (append l '(0))))))

(trace pasc-layer)
(binom-coeff 7 3)
(untrace pasc-layer)

(define (apnd x y)
  (if (null? x)
      y
      (cons (car x) (apnd (cdr x) y))))

(trace apnd)
(apnd '(1 2 3) '(4 5 6 7))

(define (w b mm)
  (cond ((zero? b) 1)
        ((or (< b 0) (null? mm)) 0)
        (else (+ (w b (cdr mm)) (w (- b (car mm)) mm)))))

(define mm '(100 50 20 10 5 2 1))

(trace w)
(w 2 mm)
(untrace w)

(w 10 mm)
(w 100 mm)


(define (poly+ p q)    ;p, q (Darstellungen von) Polynome(n)
  (cond ((null? p) q)  ;Wenn p Nullpolynom, Ergebnis q
        ((null? q) p)  ;analog umgekehrt
        (else (let ((k (+ (car p) (car q)))
                       ;k Summe der konstanten Glieder
                    (s (poly+ (cdr p) (cdr q))))
                       ;s Summe der "verkuerzten" Polynome
                       ;[p/X] und [q/X] 
                       ;(dabei sei p = [p/X]*X + p(0))
                (if (and (null? s) (zero? k))
                    '()  ;wenn s und k null sind, ist das 
                         ;Nullpolynom das Ergebnis
                    (cons k s)))))) ;sonst k + s*X

; Man kann \texttt{poly-} analog definieren (Subtraktion von Polynomen).
; es ist nur das Zeichen $+$ in der Zeile \texttt{(else ...  )} durch
; $-$ zu ersetzen.

(define (poly*skal p a)  ;p Polynom, a Zahl
  (if (zero? a)
      '() ;ist a=0, muss das Nullpolynom () herauskommen
      (map (lambda (x) (* a x)) p)))
            ;sonst: jeden Koeffizienten mit a multiplizieren

(define (poly* p q)  ;p und q Polynome
  (if (null? p)
      '()       ;0*q=0
      (poly+ (poly*skal q (car p))
             (cons 0 (poly* (cdr p) q)))))
         ;sonst p = p0 + X*p1, und p*q = p0*q + X*(p1*q)

(define (polydivide p q)  ;p und q Polynome
  (if (null? q)
      (begin (newline)
             (display "Division durch Null!") 
             '(() ()))
           ;Wenn q=0 Warnung, zwei Nullpolynome als Wert
      (let* ((pr (reverse p)) ;pr=p umgedreht
             (qr (reverse q)) ;qr=q umgedreht
             (lkfq (car qr))  ;lkfq = Leitkoeffizient von q
             (l (polydivide1 (poly*skal pr (/ lkfq))
                             (poly*skal qr (/ lkfq)))))
                ;l wird an die Liste (a' r') gebunden
        (list (reverse (car l)) 
              (poly*skal (reverse (cadr l)) lkfq)))))
           ;jetzt wird das Ergebnis (a r) zusammengebaut: 
           ;a entsteht aus a' durch Umdrehen, r aus r' durch 
           ;Umdrehen und Multiplikation mit q0.

(define (polydivide1 p q) ;p, q umgedrehte Pol., q normiert
  (cond ((null? p) (list '() '())) ;p=0, dann a'=r'=0
        ((zero? (car p)) (polydivide1 (cdr p) q)) 
           ;fuehrende Null beseitigen
        ((< (length p) (length q)) (list '() p))
                   ;deg(p) < deg(q), dann a'=0, r'=p
        (else 
          (let ((l (polydivide1 
                     (polydivide2 (car p) (cdr p) (cdr q))
                      q)))
          ;polydivide2 subtrahiert das (car p)-fache von q 
          ;"von vorn" von p, l ist die Liste (a'' r') aus 
          ;dem Quotienten dieser Differenz mit q und dem Rest
          ;(der bereits der Rest von p mod q ist)
            (list (cons (car p) (car l)) (cadr l))))))
          ;Es ist a'=(Leitkoeff. von p)*X**n + a'', n passend

(define (polydivide2 a pl ql) 
          ;a Zahl, pl, ql Listen, length(pl)>=length(ql)
  (if (null? ql)
      pl     ;ql ist aufgebraucht, pl bleibt uebrig
      (cons (- (car pl) (* a (car ql))) 
            (polydivide2 a (cdr pl) (cdr ql)))))
             ;sonst vorne Subtrahieren 
             ;und an verarbeiteten Rest anhaengen

(define (polygcd p q)  ;p und q Polynome
  (if (null? q)
      p ;q=0, dann p
      (polygcd q (cadr (polydivide p q)))))  
      ;sonst ggT(q, p mod q)

; Als Ergänzung noch eine Funktion zur Ausgabe von Polynomen auf den 
; Bildschirm:

(define (polywrite p) ;p Polynom
  (if (null? p)
      (display 0)  ;Nullpolynom gibt 0
      (do ((n (- (length p) 1) (- n 1)) ;n aktueller Exponent
           (l (reverse p) (cdr l)) ;l Koeffizienten-Liste
                                   ;(absteigend)
           (flag #t #f)) ;Flag fuer Anfang (wegen Vorzeichen)
          ((null? l))    ;Koeffizienten abgearbeitet
          (if (not (zero? (car l))) ;Koeff.  muss /= 0 sein
              (begin (polywrite1 (car l) flag n) 
                       ;gibt ein Glied aus
                     (if (not (zero? n)) ;X^0 wird weggelassen
                         (begin (display "X")
                                (if (not (= n 1)) ;X^1 wird X
                                    (begin (display "^") 
                                           (display n)))))))))
  (newline))   ;Zeile abschliessen

(define (polywrite1 k flag n) ;k Zahl, n natuerliche Zahl
  (if (not flag) 
      (display " ")) ;wenn nicht am Anfang, ein Leerzeichen
  (if (or (not flag) (negative? k)) ;evtl. Vorzeichen ausgeben
      (display (if (negative? k) "- " "+ "))) 
  (if (or (not (= 1 (abs k))) (zero? n))
      (display (abs k)))) ;Betrag des Koeffizienten ausgeben


(define (pred x)
  (if (= 0 x) 0 (- x 1)))

(pred 17)

(define (dotminus x y)
  (if (= 0 y)
      x
      (pred (dotminus x (- y 1)))))

(dotminus 8 7)
(dotminus 8 8)
(dotminus 8 9)