; Definitionen zum Ableiten von Funktionen

(define (deriv exp var)
  ; leitet exp nach var ab.

  ; Hilfspr„dikate  
  (define (constant? exp)
    (number? exp))
  (define (variable? exp)
    (symbol? exp))
  (define (same-variables? v1 v2)
    (= v1 v2))
    
  ; Invariante : var ist eine variable
  (invariant (variable? var))
  
  ; 'body' von deriv
  (cond ((constant? exp) 0)
        ((variable? exp) (if (same-variables? exp var) 1 0))
        (else (deriv-compound exp var))))

        
(define (deriv-compound exp var)
  (let ((op     (car exp))      ; Extrahieren des Operators
        (first  (cadr exp))     ; Extrahieren des ersten Operanden
        (second (caddr exp)))   ; Extrahieren des zweiten Operanden
       (cond ((= op '+) (make-sum (deriv first var)
                                    (deriv second var)))
             ((= op '-) (make-diff (deriv first var)
                                     (deriv second var)))
             ((= op '*) (make-sum (make-product first  (deriv second var))
                                    (make-product second (deriv first  var))))
             ((= op '/)
              (make-quotient (make-diff (make-product (deriv first var)
                                                      second)
                                        (make-product (deriv second var)
                                                      first))
                             (make-product second second)))
             
             ((= op '**)
              (make-product (deriv first var)    ; innere Ableitung
                            (make-product second ; * „užere Ableitung
                                          (make-power first
                                                      (make-diff second
                                                                 1)))))
             ;
             ; ******************************************
             ; *  Hier weitere Operatoren einf�gen !!!  *
             ; ******************************************
             ;
             (else (error "Unknown operand : " op)))))
             
;---------------------------------------------------------------------------
;
; Konstruktoren !!!
;   Die Hauptaufgabe der Konstruktoren ist das Bilden entsprechender Listen.
;   (MAKE-SUM a b) ist beispielsweise „quivalent zu (LIST '+ a b). Sind bei-
;   de Argumente (a und b) Zahlen, wird gleich die Summe zur�ckgegeben.  Zum
;   Beispiel ergibt (MAKE-SUM 3 4) NICHT (+ 3 4), sondern 7. In der gleichen
;   Weise werden noch verschiedene andere Vereinfachungen durchgef�hrt.
;
;   Beispiele:
;       (MAKE-SUM '(* 2 x) 0)           -->(* 2 x) ; nicht (+ (* 2 x) 0)
;       (MAKE-PRODUCT 0 '(+ x y))       -->0       ; nicht (* 0 (+ x y))

(define (make-sum f s)
  (cond ((and (number? f) (number? s)) (+ f s))
        ((and (number? f) (zero? f)) s)
        ((and (number? s) (zero? s)) f)
        ((= f s) (make-product 2 f))
        (else (list '+ f s))))
  
(define (make-diff f s)
  (cond ((and (number? f) (number? s)) (- f s))
        ((and (number? f) (zero? f)) (list '- s))
        ((and (number? s) (zero? s)) (list '- f))
        ((= f s) 0)
        (else (list '- f s))))
  
(define (make-product f s)
  (cond ((and (number? f) (number? s)) (* f s))
        ((number? f)
         (cond ((zero? f) 0)
               ((= f 1)   s)
               ((and (not (atom? s)) (= (car s) '*))
                (cond ((number? (cadr s))  (make-product (* f (cadr s))
                                                         (caddr s)))
                      ((number? (caddr s)) (make-product (* f (caddr s))
                                                         (cadr s)))
                      (else (list '* f s))))      
               (else      (list '* f s))))
        ((number? s)
         (cond ((zero? s) 0)
               ((= s 1)   f)
               ((and (not (atom? f)) (= (car f) '*))
                (cond ((number? (cadr f))  (make-product (* s (cadr f))
                                                         (caddr f)))
                      ((number? (caddr f)) (make-product (* s (caddr f))
                                                         (cadr f)))
                      (else (list '* f s))))      
               (else      (list '* s f))))
        ((= s f) (make-power f 2))
        (else             (list '* f s))))

(define (make-quotient f s)
  (cond ((and (number? f) (number? s)) (/ f s))
        ((number? f)
         (cond ((zero? f) 0)
               ((= f 1)   (list '/ s))
               (else      (list '/ f s))))
        ((number? s)
         (cond ((zero? s) (error "in make-quotient, division by zero"))
               ((= s 1)   f)
               (else      (list '/ f s))))
        ((= f s) 1)
        (else (list '/ f s))))

(define (make-power f s)
  (cond ((and (number? f) (number? s)) (exp f s))
        ((number? f)
         (cond ((zero? f) 0)
               ((= f 1)   1)
               (else (list '** f s))))
        ((number? s)
         (cond ((zero? s) 1)
               ((= s 1)   f)
               (else (list '** f s))))
        (else (list '** f s))))

;
; ********************************************************
; *  Hier weitere vereinfachende Konstruktoren einf�gen  *
; ********************************************************
;

;---------------------------------------------------------------------------

; generiere Testausdruck

(define expr '(/ (+ (* 3 x) 4) (* x y)))
; expr entspricht : (3x+4)/(x*y)

;---------------------------------------------------------------------------

; Bilden verschiedener Ableitungen

(define expr-dx1 (deriv  expr 'x))   
; expr-dx1 ist die erste Ableitung von expr nach x.
  
(define expr-dx2 (deriv expr-dx1 'x))
; expr-dx2 ist die zweite Ableitung von expr nach x oder
; die erste Ableitung von expr-dx1 nach x.

(define expr-dy1 (deriv expr 'y))
; expr-dy1 ist die erste Ableitung von expr nach y.

(define expr-dz1 (deriv expr 'z))
; expr-dz1 ist die erste Ableitung von expr nach z.
; Also ist expr-dz gleich Null !