Welcome, guest! Login / Register - Why register?
Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)

Paste

Pasted as Scheme by Vroni ( 15 years ago )
; Eine Funktionsanwendung besteht aus
; - einem Funktionsnamen (string)
; - einer Argumentliste
(define-record-procedures fun-app
  make-fun-app fun-app?
  (fun-app-name fun-app-args))

; Ein Funktionsausdruck ist eins der folgenden:
; - eine Konstante (number)
; - eine Variable (string)
; - eine Funktionsanwendung (fun-app)
(define fun-exp
  (signature
   (mixed number
          string
          fun-app)))

(: make-fun-app (string (list-of fun-exp) -> fun-exp))
(: fun-app? (any -> boolean))
(: fun-app-name (fun-app -> string))
(: fun-app-args (fun-app -> (list-of fun-exp)))

;; Praedikate:

; Ist das Argument eine Konstante?
(: constant? (any -> boolean))
(define constant? (lambda (x) (number? x)))

; Ist das Argument eine Variable?
(: variable? (any -> boolean))
(define variable? (lambda (x) (string? x)))

; Ist das Argument die Summe zweier Funktion?
(: sum? (any -> boolean))
(define sum?
  (lambda (x)
    (if (fun-app? x) (string=? (fun-app-name x) "+") #f)))

; Ist das Argument das Produkt zweier Funktion?
(: prod? (any -> boolean))
(define prod?
  (lambda (x)
    (if (fun-app? x) (string=? (fun-app-name x) "*") #f)))

; Sind die beiden Argumente identische Variablen?
(: equal-variable? (any any -> boolean))
(define equal-variable?
  (lambda (v1 v2)
    (and (variable? v1)
         (variable? v2)
         (string=? v1 v2))))

;; Konstruktoren:

; Konstruiere aus zwei Teilfunktionen die Summe dieser Funktionen
(: sum (fun-exp fun-exp -> fun-exp))
(define sum
  (lambda (f1 f2)
    (cond ((and (constant? f1) (constant? f2)) (+ f1 f2))
          ((constant? f1) (if (= f1 0) f2 (make-fun-app "+" (list f1 f2))))
          ((constant? f2) (if (= f2 0) f1 (make-fun-app "+" (list f1 f2))))
          (else (make-fun-app "+" (list f1 f2))))))

; Konstruiere aus zwei Teilfunktionen das Produkt dieser Funktionen
(: prod (fun-exp fun-exp -> fun-exp))
(define prod
  (lambda (f1 f2)
    (cond ((and (constant? f1) (constant? f2)) (* f1 f2))
          ((constant? f1) (cond ((= f1 0) 0)
                                ((= f1 1) f2)
                                (else (make-fun-app "*" (list f1 f2)))))
          ((constant? f2) (cond ((= f2 0) 0)
                                ((= f2 1) f1)
                                (else (make-fun-app "*" (list f1 f2)))))
          (else (make-fun-app "*" (list f1 f2))))))

; Beispiel:
(: axb fun-exp)
(define axb (sum (prod "a" "x") "b"))


;; Selektoren:

; Berechne den ersten Operanden einer zusammengesetzten Funktion
(: operand1 (fun-exp -> fun-exp))
(define operand1
  (lambda (f) (n-th (fun-app-args f) 0)))

; Berechne den zweiten Operanden einer zusammengesetzten Funktion
(: operand2 (fun-exp -> fun-exp))
(define operand2
  (lambda (f) (n-th (fun-app-args f) 1)))

(define n-th list-ref) ; an Stelle der alten Definition

; Berechne die erste Ableitung einer Funkion:
(: derive (fun-exp string -> fun-exp))

(check-expect (derive 42 "x") 0)
(check-expect (derive "x" "x") 1)
(check-expect (derive "y" "x") 0)
(check-expect (derive (sum "x" 3) "x") 1)
(check-expect (derive (prod "x" "y") "x") "y")
(check-expect (derive axb "x") "a")
(check-expect (derive (diff "x" 3) "x") 1)
(check-expect (derive (quot "x" "y") "x") (quot 1 "y"))

(define derive
  (lambda (f v)
    (cond ((constant? f) 0)
          ((variable? f)
           (if (equal-variable? f v) 1 0))
          ((sum? f)
           (sum (derive (operand1 f) v)
                (derive (operand2 f) v)))
          ((diff? f)
           (diff (derive (operand1 f) v)
                (derive (operand2 f) v)))
          ((prod? f)
           (sum (prod (operand1 f)
                      (derive (operand2 f) v))
                (prod (operand2 f)
                      (derive (operand1 f) v))))
          ((quot? f)
           (quot (diff (prod (operand2 f)
                             (derive (operand1 f) v))
                       (prod (operand1 f)
                             (derive (operand2 f) v)))
                 (prod operand2 operand2))))))

; Konstruiere aus zwei Teilfunktionen die Differenz dieser Funktionen
(: diff (fun-exp fun-exp -> fun-exp))
(define diff
  (lambda (f1 f2)
    (cond ((and (constant? f1) (constant? f2)) (- f1 f2))
          ((constant? f1) (if (= f1 0) f2 (make-fun-app "-" (list f1 f2))))
          ((constant? f2) (if (= f2 0) f1 (make-fun-app "-" (list f1 f2))))
          (else (make-fun-app "-" (list f1 f2))))))

; Ist das Argument die Differenz zweier Funktionen?
(: diff? (any -> boolean))
(define diff?
  (lambda (x)
    (if (fun-app? x) (string=? (fun-app-name x) "-") #f)))

; Konstruiere aus zwei Teilfunktionen den Quotienten dieser Funktionen
(: quot (fun-exp fun-exp -> fun-exp))
(define quot
  (lambda (f1 f2)
    (cond ((and (constant? f1) (constant? f2)) (/ f1 f2))
          ((constant? f1) (cond ((= f1 0) 0)
                                (else (make-fun-app "/" (list f1 f2)))))
          ((constant? f2) (cond ((= f2 0) 0)
                                ((= f2 1) f1)
                                (else (make-fun-app "/" (list f1 f2)))))
          (else (make-fun-app "/" (list f1 f2))))))

; Ist das Argument das Produkt zweier Funktion?
(: quot? (any -> boolean))
(define quot?
  (lambda (x)
    (if (fun-app? x) (string=? (fun-app-name x) "/") #f)))

 

Revise this Paste

Your Name: Code Language: