;;; Konstruktion, Vorlesung vom 30.11.2000
;;; K9 Funktionen höherer Ordnung
;;; K9.1 Funktionen als Parameter

; ERINNERUNG:
; (list-add l x) addiert x zu jedem Element von l
; DEFINITION
(define list-add
  (lambda (l x)
    (cond
     ((null? l)
      '())
     ((pair? l)
      (cons (+ x (car l))
	    (list-add (cdr l) x))))))










; SIGNATUR
; list-mult : list(number) number -> list(number)
; ERKLÄRUNG
; (list-mult l x) multipliziert x zu jedem Element von l
; DEFINITION
(define list-mult
  (lambda (l x)
    (cond
     ((null? l)
      '())
     ((pair? l)
      (cons (* x (car l))
	    (list-mult (cdr l) x))))))

; Die Definitionen von list-add und list-mult unterscheiden sich an 
; genau einer Stelle:      +    <===>    *
; ===> Parametrisiere über die Operation!






; SIGNATUR
; list-op : list(number) (number number -> number) number -> list(number)
; ERKLÄRUNG
; (list-mult l op x) ersetzt jedes Element y von l durch (op x y)
; DEFINITION
(define list-op
  (lambda (l op x)
    (cond
     ((null? l)
      '())
     ((pair? l)
      (cons (op x (car l))
	    (list-op (cdr l) op x))))))










; ALTERNATIVE DEFINITION
(define list-add
  (lambda (l x)
    (list-op l + x)))

; ALTERNATIVE DEFINITION
(define list-mult
  (lambda (l x)
    (list-op l * x)))

; Weitere Verallgemeinerung:
; Das feste Argument x kann in die Funktion herein gezogen werden.











; SIGNATUR
; list-map : (X -> Y) list(X) -> list(Y)
; ERKLÄRUNG
; (list-map f l) wendet f auf jedes Element von l an.
; BEISPIEL
; (list-map square '())
; (list-map square (list 2 4 3)) == (list 4 16 9)
; (list-map / (list 8 1 0.5)) == (list 0.125 1 2)
; DEFINITION
(define list-map
  (lambda (f l)
    (cond
     ((null? l)
      '())
     ((pair? l)
      (cons (f (car l))
	    (list-map f (cdr l)))))))

; vordefiniert als: map (in verallgemeinerter Form)




; ERINNERUNG:
(define list-length
  (lambda (l)
    (cond
     ((null? l) 0)
     ((pair? l) (+ 1 (list-length (cdr l)))))))

; DEFINITION:
(define list-sum
  (lambda (l)
    (cond
     ((null? l) 0)
     ((pair? l) (+ (car l) (list-sum (cdr l)))))))

;;; können nicht mit map definiert werden, aber abstrahiert zu
; MUSTER:
(define list-xxxx
  (lambda (l)
    (cond ((null? l) AAAA)
          ((pair? l) (BBBB (car l) (list-xxxx (cdr l)))))))



; SIGNATUR
; list-fold : (X Y -> Y) Y list(X) -> Y
; ERKLÄRUNG
; (list-fold c e l) "ersetzt" jedes Vorkommen von '() in l durch e
; und jedes Vorkommen von cons durch c und wertet den entstehenden
; Ausdruck aus.
; BEISPIEL
; (list-fold * 1 '()) == 1
; (list-fold * 1 (list 1 2 3)) == 6   
; (list-fold + 0 (list 1 2 3 4)) == 10          =^= list-sum
; (list-fold (lambda (e r) (+ r 1)) 0 '(madonna gerry)) == 2
; =^= list-length
; DEFINITION:
(define list-fold
  (lambda (c e l)
    (cond
     ((null? l)
      e)
     ((pair? l)
      (c (car l)
	 (list-fold c e (cdr l)))))))


; SIGNATUR
; integral : (number -> number) number number number -> number
; ERKLÄRUNG
; (integral f a b dx) liefert eine Approximation des Integrals von f
; zwischen a und b unter Verwendung der Schrittweite dx
; BEISPIEL
; (integral (lambda (x) (+ x 1)) 0 1 .001)   ~= 1.5
; (integral (lambda (x) (* x x)) 0 1 .001)   ~= 1/3
; DEFINITION
(define integral
  (lambda (f a b dx)
    (* dx (sum f (+ a (/ dx 2)) b dx))))











; SIGNATUR
; sum : (number -> number) number number number -> number
; ERKLÄRUNG
; (sum f a b dx) berechnet die Summe
; (+ (f a) (f (+ a dx)) (f (+ a dx dx)) ... (f c))
; wobei b-c < dx ist.
; BEISPIEL
; (sum (lambda (x) x) 1 10 1) == 55
; (sum acos 1 1 .0001) == (acos 1) == 0
; DEFINITION
(define sum
  (lambda (f a b dx)
    (letrec ((loop
	      (lambda (x0 r)
		(if (> x0 b)
		    r
		    (loop (+ x0 dx) (+ r (f x0)))))))
      (loop a 0))))





;;; Auswertungsregel (Erw. von Def K1)
;;; Der Wert von (letrec ((x1 e1) ... (xn en)) e) wird durch
;;; folgende Schritte bestimmt:
;;; 1. Werte e1 ... en zu v1 ... vn aus.
;;; 2. Ergebnis ist der Wert von e, wobei lokal die Definitionen 
;;;    x1 = v1, ..., xn = vn gelten

















;;; Alternative Schreibweise für sum:
(define sum
  (lambda (f a b dx)
    (let loop ((x0 a) (r 0))
      (if (> x0 b)
	  r
	  (loop (+ x0 dx) (+ r (f x0)))))))

;;; Auswertungsregel
;;; Der Wert von (let <name> ((x1 e1) ... (xn en)) e) wird durch
;;; folgende Schritte bestimmt:
;;; 1. Werte e1 ... en zu v1 ... vn aus.
;;; 2. Setze e' = e[ x1 := v1,  ..., xn := vn ]
;;; 3. Ergebnis ist der Wert von e' nach Ersetzen der Vorkommen 
;;;    von (<name> e1' ... en')
;;;    durch (let <name> ((x1 e1') ... (xn en')) e)







;;; K9.2 Funktionen als Ergebnisse

; SIGNATUR
; addx : number -> (number -> number)
; ERKLÄRUNG
; (addx n) liefert eine Funktion, die n zu ihrem Argument addiert.
; BEISPIEL
; ((addx 5) 6) == 11
; DEFINITION
(define addx
  (lambda (x)
    (lambda (y)
      (+ x y))))










; ALTERNATIVE DEFINITION
(define list-add
  (lambda (l x)
    (map (addx x) l)))

;;; Substitution der Definition von addx ergibt

(define list-add
  (lambda (l x)
    (map (lambda (y) (+ x y)) l)))













; SIGNATUR
; derive : (number -> number) number -> (number -> number)
; ERKLÄRUNG
; (derive f h) liefert eine Approximation an die Ableitung von f.
; BEISPIEL
; (derive (lambda (x) (* x x)) .001)       ~= (lambda (x) (* 2 x))
; ((derive (lambda (x) (* x x)) .001) 3)   ~= 6
; (derive (lambda (x) (* x x x)) .001)     ~= (lambda (x) (* 3 x x))
; ((derive (lambda (x) (* x x x)) .001) 3) ~= 27
; DEFINITION
(define derive
  (lambda (f h)
    (lambda (x)
      (/ (- (f (+ x h))
            (f x))
         h))))







; SIGNATUR
; curry : (X Y -> Z) -> X -> Y -> Z
; ERKLÄRUNG
; Wenn f eine zweistellige Funktion ist, so liefert (curry f) eine
; Funktion, die zunächst das erste Argument x für f nimmt, dann eine
; Funktion liefert, die das zweite Argument y für f nimmt, und als
; Ergebnis den Wert (f x y) liefert.
; BEISPIEL
; (curry +) =^= addx
; (((curry +) 5) 6) == 11
; (((curry quotient) 1972) 46) == 42
; DEFINITION
(define curry
  (lambda (f)
    (lambda (x)
      (lambda (y)
	(f x y)))))

; ALTERNATIVE DEFINITION
(define addx (curry +))



; SIGNATUR
; twice : (X -> X) -> (X -> X)
; ERKLÄRUNG
; (twice f) liefert eine Funktion, die f zweimal anwendet
; BEISPIEL
; ((twice (addx 5)) 1) == 11
; (((twice twice) (addx 5)) 1) == 21
; DEFINITION
(define twice
  (lambda (f)
    (lambda (x)
      (f (f x)))))











; SIGNATUR
; compose : (Y -> Z) (X -> Y) -> (X -> Z)
; ERKLÄRUNG
; (compose f g) liefert die Komposition der Funktionen f und g.
; BEISPIEL
; (compose (addx 1) square) == (lambda (x) (+ 1 (* x x)))
; DEFINITION
(define compose
  (lambda (f g)
    (lambda (x) (f (g x)))))













; SIGNATUR
; my-cons : X Y -> (X Y -> Z) -> Z
; my-car  : ((X Y -> X) -> X) -> X
; my-cdr  : ((X Y -> Y) -> Y) -> Y
; ERKLÄRUNG
; (my-cons x y) repräsentiert das Paar (x, y) als Funktion, die eine
; Projektionsfunktion als Argument erwartet. (my-car c) und (my-cdr c) 
; extrahieren die entsprechenden Komponenten.
; DEFINITION
(define my-cons
  (lambda (x y)
    (lambda (f) (f x y))))
(define my-car
  (lambda (c)
    (c (lambda (x y) x))))
(define my-cdr
  (lambda (c)
    (c (lambda (x y) y))))





;;; K9.3 Variable Argumentlisten und Primitive Rekursion

;;; Die nullstellige Nullfunktion.
(define zero
  (lambda ()
    0))

;;; Die einstellige Nachfolgerfunktion.
(define succ
  (lambda (n)
    (+ n 1)))

;;; Für jedes n in N und jedes 1 <= i <= n,
;;; die n-stellige Projektionsfunktion auf die i-te Komponente.
(define project
  (lambda (n i)
    (lambda n-tuple
      (list-ref n-tuple (- i 1)))))

;;; Die Variable n-tuple enthält die Liste aller Argumentwerte.



;;; Falls f in Prim(n) und g1, ..., gn in Prim(m),
;;; dann ist die Komposition f o [g1, ..., gn] in Prim(m).
(define compose
  (lambda (f . gs)
    (lambda m-tuple
      (apply f (map (lambda (gi) (apply gi m-tuple)) gs)))))

;;; (apply f '(v1 ... vn)) == (f v1 ... vn)
;;; apply ist vordefiniert.














;;; Falls f in Prim(n) und g in Prim(n+2),
;;; so ist h = PR(n)(f, g) in Prim(n+1).
(define primrec
  (lambda (f g)
    (letrec ((h
	      (lambda (n . xs)
		(if (zero? n)
		    (apply f xs)
		    (apply g (append xs
				     (list (- n 1)
					   (apply h (- n 1) xs))))))))
      h)))











;;; Beispiele:

;;; Addition
;; add (0,   x1) = x1
;; add (n+1, x1) = add (n, x1)+1

(define add
  (primrec (project 1 1)
	   (compose succ (project 3 3))))

;;; Vorgängerfunktion
;; pred (0)   = 0
;; pred (n+1) = n
(define pred
  (primrec zero (project 2 1)))

;;; Multiplikation
;; mult (0,   x1) = 0
;; mult (n+1, x1) = add (x1, mult (n, x1))
(define mult
  (primrec (lambda (x1) (zero)) (compose add (project 3 1) (project 3 3))))