;; Aufgabe 1


(define-struct pair (fst snd))

(define zip
  (lambda (l1 l2)
    (cond
     ((empty? l1) empty)
     ((cons? l1)
      (cond
       ((empty? l2) empty)
       ((cons? l2)
	(cons (make-pair (first l1) (first l2))
	      (zip (rest l1) (rest l2)))))))))

;; Aufgabe 3
;; (a)

(define number*-<
  (lambda (a b)
    (cond
     ((equal? a '-infty) 
      (not (equal? a '-infty)))
     ((number? a)
      (or (equal? b '+infty)
	  (< a b)))
     ((equal? a '+infty)
      #f))))
	
(define number*-min
  (lambda (a b)
    (if (number*-< a b)
	a
	b)))

;; (b)

(define-struct branch (left elem right))

(define number*-min-3
  (lambda (a b c)
    (number*-min a (number*-min b c))))

(define btree-min
  (lambda (t)
    (cond 
      ((empty? t) '+infty)
      ((branch? t)
       (number*-min-3 (btree-min (branch-left t))
		      (branch-elem t)
		      (btree-min (branch-right t)))))))

;; Aufgabe 4

;; (a)
;; Implementierung von Mengen als unsortierte Listen
;; (mit Wiederholungen)

(define set-union
  (lambda (s1 s2)
    (cond
      ((empty? s1) s2)
      ((cons? s1)
       (set-insert (first s1)
                   (set-union (rest s1) s2))))))

;; (b)
;; Implementierung von Mengen als aufsteigend sortierte Listen
;; (ohne Wiederholungen)

(define set-elem?
  (lambda (x s)
    (cond
      ((empty? s) #f)
      ((< x (first s)) #f)
      ((= x (first s)) #t)
      ((> x (first s)) (set-elem? x (rest s))))))

(define set-insert
  (lambda (x s)
    (cond
      ((empty? s) (list x))
      ((< x (first s)) (cons x s))
      ((= x (first s)) s)
      ((> x (first s)) (cons (first s) (set-insert x (rest s)))))))

(define set-union
  (lambda (s1 s2)
    (cond 
     ((empty? s1) s2)
     ((empty? s2) s1)
     (else
      (let ((x1 (first s1)) (x2 (first s2)))
	(cond 
	 ((= x1 x2) (cons x1 (set-union (rest s1) (rest s2))))
	 ((< x1 x2) (cons x1 (set-union (rest s1) s2)))
	 ((> x1 x2) (cons x2 (set-union s1 (rest s2))))))))))
  
;; (c)
;; Implementierung von Mengen als Suchbäume

(define set-elem? btree-member)

(define set-insert btree-insert)

(define set-union
  (lambda (s1 s2)
    (cond
      ((empty? s1) s2)
      ((branch? s1)
       (set-union (branch-right s1)
                  (set-union (branch-left s1)
                             (set-insert (branch-elem s1) s2)))))))

;; (d)
;; Implementierung von Mengen als charakteristische Funktion number -> boolean

(define set-empty
  (lambda (x)
    #f))

(define set-elem?
  (lambda (x s)
    (s x)))

(define set-insert
  (lambda (x s)
    (lambda (n)
      (or (= x n)
          (s n)))))

(define set-union
  (lambda (s1 s2)
    (lambda (n)
      (or (s1 n)
          (s2 n)))))
  
;; Aufgabe 5
;; (a)

(define-struct var  (name))
(define-struct null ())
(define-struct one  ())
(define-struct add  (rand1 rand2))
(define-struct mult (rand1 rand2))

(define derive
  (lambda (term var)
    (cond 
     ((var? term)  (if (equal? (var-name term) (var-name var))
		       (make-one)
		       (make-null)))
     ((null? term) (make-null))
     ((one? term)  (make-null))
     ((add? term)  (make-add (derive (add-rand1 term) var)
			     (derive (add-rand2 term) var)))
     ((mult? term) (let ((rand1 (mult-rand1 term))
			 (rand2 (mult-rand2 term)))
		     (make-add (make-mult rand1 (derive rand2 var))
			       (make-mult rand2 (derive rand1 var))))))))

;; (b)

(define-struct pair (fst snd))

(define lookup
  (lambda (fun arg)
    (cond
     ((empty? fun) (error "undefined" arg))
     ((cons? fun)
      (let ((p (first fun)))
	(if (equal? (pair-fst p) arg)
	    (pair-snd p)
	    (lookup (rest fun) arg)))))))

(define kata
  (lambda (t algebra env)
    (cond
     ((var? t)  (lookup env (var-name t)))
     ((null? t) (lookup algebra 'null))
     ((one? t)  (lookup algebra 'one))
     ((add? t)  (let ((op (lookup algebra 'add))
		      (v1 (kata (add-rand1 t) algebra env))
		      (v2 (kata (add-rand2 t) algebra env)))
		  (op v1 v2)))
     ((mult? t) (let ((op (lookup algebra 'mult))
		      (v1 (kata (mult-rand1 t) algebra env))
		      (v2 (kata (mult-rand2 t) algebra env)))
		  (op v1 v2))))))

(define algebra-numbers
  (list (make-pair 'null 0)
	(make-pair 'one  1)
	(make-pair 'add  +)
	(make-pair 'mult *)))

(define eval
  (lambda (term env)
    (kata term algebra-numbers env)))
	
(define algebra-pretty-print
  (list (make-pair 'null "0")
	(make-pair 'one  "1")
	(make-pair 'add  (lambda (r1 r2) (string-append "(" r1 "+" r2 ")")))
	(make-pair 'mult (lambda (r1 r2) (string-append "(" r1 "*" r2 ")")))))

(define pretty-print
  (lambda (term env)
    (kata term algebra-pretty-print env)))

;; Beispielsession

(define x (make-var 'x))
(define y (make-var 'y))

(define term (make-add (make-mult x y)
		       (make-mult (make-one) x)))
              
(define env-1 (list (make-pair 'x 10)
		    (make-pair 'y 3)))

(define env-2 (list (make-pair 'x "x")
		    (make-pair 'y "y")))

(pretty-print term env-2)
(pretty-print (derive term x) env-2)
(pretty-print (derive term y) env-2)
(eval term env-1)

;; Aufgabe 6

(define id (lambda (x) x))

(define list-map
  (lambda (f l)
    (cond
     ((empty? l) empty)
     ((cons? l)
      (cons (f (first l))
            (list-map f (rest l)))))))

(define filter2
  (lambda (p)
    (define g
      (lambda (xs)
	(cond 
	 ((empty? xs) empty)
	 ((cons? xs)
	  (let* ((x (first xs))
		 (ys (g (rest xs))))
	    (if (p x) (cons x ys) ys))))))
    g))

(define compose
  (lambda (f g)
    (lambda (x) (f (g x)))))

(define list-fold
  (lambda (c e l)
    (cond
     ((empty? l) e)
     ((cons? l)
      (c (first l)
         (list-fold c e (rest l)))))))

;; (a)

(define even-odd
  (lambda (l)
    (list-map (lambda (x) (if (even? x) 'even 'odd))
	      l)))

(even-odd (list 3147 42 234 4251 542 5 73 42519))

;; (b)

(define apply-all
  (lambda (list-of-procs value)
    (list-map (lambda (f) (f value))
	      list-of-procs)))

(apply-all (list reverse first rest) (list 1 2 3 4))

;; (c)

(define count-zeroes
  (compose list-length
           (filter2 (lambda (x) (= x 0)))))

(count-zeroes (list 3284 0 0 5478457 0 437 0 4764))

;; (d)

(define list-length
  (lambda (l)
    (list-fold (lambda (x a) (+ a 1))
               0
               l)))

(list-length (list 1 2 3 4 5 6 7 8))

;; (e)

(define apply-composition
  (lambda (list-of-procs value)
    (list-fold (lambda (proc a) (proc a))
               value
               list-of-procs)))

(apply-composition (list first rest reverse) (list 1 2 3 4))

;; oder ...

(define apply-composition-2
  (lambda (list-of-procs)
    (list-fold compose id list-of-procs)))

(define apply-composition 
  (lambda (list-of-procs v)
    ((apply-composition-2 list-of-procs) v)))

(apply-composition (list first rest reverse) (list 1 2 3 4))