Grundlagen der funktionsorientierten Programmierung mit SCHEME/Projekt CAS
Aus ProgrammingWiki
Wiki-Quelltext dieser Seite.
<language>Scheme</language>
== Einführung ==
Die Programmiersprache ''Lisp'' ist bereits zum Ende der 1950er Jahre mit den Ziel entwickelt worden, ''symbolische Ausdrücke'' verarbeiten zu können. Damit wurde die Grundidee der heutigen ''Computeralgebrasysteme (CAS)'' vorweggenommen.<br /><br />
Wenn wir Gleichungen äquivalent umformen, die erste Ableitung einer Funktion "berechnen" oder ihr unbestimmtes Integral angeben, so führen wir bei diesen Standardaufgaben des Mathematikunterrichtes ''keine'' numerischen Berechnung aus. Vielmehr suchen wir ein Ergebnis, das "lediglich" der Manipulation von Symbolen entspricht. Diese unterliegt allerdings strengen Regeln.<br /><br />
Mit Scheme, das wir der Familie der Lisp-Sprachen zuordnen können, wollen wir zwei grundlegende Aufgaben moderner CAS realisieren:
* das symbolische Differenzieren sowie
* das Vereinfachen von Termen.
Natürlich soll anschließend mit diesen Termen auch (numerisch) gerechnet werden.
'''Beispiel:'''<br />
(vereinfache-vollstaendig (ableitung '(+ (^ x 2) (/ 1 x)) 'x))
--> (+ (* 2 x) (/ -1 (^ x 2)))
(berechne (ableitung '(+ (^ x 2) (/ 1 x)) 'x) 'x 2)
--> 3 3/4
Ohne Einschränkungen der Leistungsfähigkeit wollen wir fordern, dass die mathematischen Ausdrücke aus
* atomaren Elementen (Symbole / Zahlen),
* einstelligen (''unären'') Operationen oder
* zweistelligen (''binären'') Operationen
bei beliebigen Termstrukturen bestehen.
== Symbolisches Differenzieren ==
Zunächst sollten wir Bezeichner festlegen, die sich stärker am Mathematikunterricht orientieren:
<code id="4b92c9c5b038e" hidden>
(define sqr
(lambda (x)
(* x x)))
</code>
<code id="4b92af820d54a">
(define ^ expt)
(define ln log)
(define e (exp 1))
</code>
Nun testen wir das vorliegende ''Programmfragment'':
<code id="4b859d7b0e84f">
;Differentiationsregeln
(define ableitung
(lambda (ausdr var)
(cond
[(number? ausdr) 0]
[(symbol? ausdr) (if (eqv? ausdr var) 1 0)]
[(= (length ausdr) 2)
(let ([op (car ausdr)] [term1 (cadr ausdr)])
(case op
[(+)
(list '+ (ableitung term1 var))]
;hier stehen weitere Regeln unärer Operationen
[else
'Unbekannt!]))]
[(= (length ausdr) 3)
(let ([op (car ausdr)] [term1 (cadr ausdr)] [term2 (caddr ausdr)])
(case op
[(+)
(list '+ (ableitung term1 var) (ableitung term2 var))]
[(-)
(list '- (ableitung term1 var) (ableitung term2 var))]
[(*)
(list '+
(list '* (ableitung term1 var) term2)
(list '* term1 (ableitung term2 var)))]
;hier stehen weitere Regeln binärer Operationen
[else
'Unbekannt!]))]
[else
'Unbekannt!])))
</code>
<eval id="4b92b8a83ef8d">
(ableitung '(- (* 2 x) y) 'x)
</eval>
Exemplarisch untersuchen wir in diesem Fragment die Implementation der ''Produktregel''<br />
<blockquote><math>y = u \cdot v \longrightarrow y' = u' \cdot v + u \cdot v'</math></blockquote>
(list '+
(list '* (ableitung term1 var) term2)
(list '* term1 (ableitung term2 var)))
Wir stellen fest: Die Produktregel wird unter Beachtung der erforderlichen Syntax exakt umgesetzt.<br />
Die Ableitungen <math>u'</math> und <math>v'</math> entsprechen einem rekursiven Prozeduraufruf.
'''Hinweis:'''<br />
Es ist zu beachten, dass bei allen höheren Funktionen innere Ableitungen existieren können, auf die die Kettenregel anzuwenden ist.
So gilt für die Ableitung der Prozedur <tt>sqr</tt>:
(list '*
(list '* 2 term)
(ableitung term var))
=== Aufgaben ===
<ol>
<li>
Implementieren Sie alle weiteren Differentiationsregeln in dem oberen Definitionsfenster.<br />
Informieren Sie sich ggf. im Tafelwerk.
</li>
</ol>
== Vereinfachen von Termen ==
Die ersten Testläufe zeigen sofort die Notwendigkeit, die symbolisch generierten Terme zu vereinfachen.<br />
Dazu sei ebenfalls ein ''Programmfragment'' vorgegeben:
<code id="4b92af820e4dc">
;Vereinfachungsregeln
(define vereinfache
(lambda (ausdr)
(letrec
([help-unop
(lambda (op term1)
(case op
[(+ *) (vereinfache term1)]
[(/) (list '/ 1 (vereinfache term1))]
;hier stehen weitere Vereinfachungsregeln für unäre Operationen
[else
(list op (vereinfache term1))]))]
[help-binop
(lambda (op term1 term2)
(case op
[(+) (cond
[(eqv? term1 0) (vereinfache term2)]
[(eqv? term2 0) (vereinfache term1)]
[(equal? term1 term2) (list '* 2 (vereinfache term1))]
[(and (number? term1) (number? term2)) (+ term1 term2)]
[else
(list '+ (vereinfache term1) (vereinfache term2))])]
;hier stehen weitere Vereinfachungsregeln für binäre Operationen
[else
ausdr]))])
(cond
[(or (number? ausdr) (symbol? ausdr)) ausdr]
[(= (length ausdr) 2) (help-unop (car ausdr) (cadr ausdr))]
[(= (length ausdr) 3)
(help-binop (car ausdr) (cadr ausdr) (caddr ausdr))]
[else
ausdr]))))
</code>
<eval id="4b92af820f476">
(vereinfache '(+ 3 (+ x 0)))
</eval>
Auch hier wird zwischen unären und binären Operationen unterschieden.<br / >
Insbesondere elementare Vereinfachungen dürfen dabei nicht übersehen werden:
(vereinfache '(- term)) --> (- (vereinfache term))
(vereinfache '(+ term1 0)) --> (vereinfache term1)
(vereinfache '(* 0 term2)) --> 0
(vereinfache '(* term1 1)) --> (vereinfache term1)
Sind die auftretenden Terme Zahlen, so wird natürlich gerechnet:
(if (and (number? term1) (number? term2)) (+ term1 term2))
Bei unären Operationen kann vereinfacht werden, wenn Operation und Umkehroperation nacheinander zum Einsatz kommen:
(vereinfache '(sqr (sqrt term))) --> (vereinfache term)
Ein nicht zu vereinfachender Ausdruck wird unverändert zurück gegeben.
=== Aufgaben ===
<ol>
<li>
Ergänzen Sie weitere Vereinfachungsregeln im entsprechenden Definitionsfenster.
</li>
<li>
Begründen Sie, warum die Vereinfachung trotz der Implementation aller bekannter Vereinfachungsregeln nicht vollständig sein wird.
</li>
<li>
'''Zusatzaufgabe:'''<br />
Entwickeln Sie die Prozedur <tt>vereinfache-vollstaendig</tt>:
<code id="4b92c07a59ffc">
(define vereinfache-vollstaendig
(lambda (term)
(let ([term-neu (vereinfache term)])
...)))
</code>
<check>
(eqv? (vereinfache-vollstaendig '(+ (+ 3 0) (+ 0 5))) 8)
</check>
<eval id="4b941dfe4aaf7">
(vereinfache-vollstaendig '(+ (+ 3 0) (+ 0 5)))
</eval>
</li>
</ol>
== Numerische Auswertung symbolischer Ausdrücke ==
Leistungsstark ist unser CAS erst dann, wenn mit den symbolischen Ausdrücken auch gerechnet werden kann. Dazu müssen diese zu vollständigen λ-Ausdrücken erweitert werden. Anschließend ist die Evaluation mit <tt>eval</tt> möglich:
<code id="4b98a144af985">
(define superelement?
(lambda (el ls)
(cond
[(null? ls) #f]
[(list? (car ls)) (or (superelement? el (car ls)) (superelement? el (cdr ls)))]
[(equal? el (car ls)) #t]
[else
(superelement? el (cdr ls))])))
(define berechne
(lambda (term var wert)
(cond
[(number? term) term]
[(equal? 'Unbekannt! term) 'Unbekannt!]
[(superelement? 'Unbekannt! term) 'Unbekannt!]
[else
((eval (list 'lambda (list var) term)) wert)])))
</code>
<eval id="4b92b8a83ff2c">
(berechne '(- (* 2 x) 3) 'x 5)
</eval>
<eval id="4b92b8a840ecf">
(berechne (ableitung '(- (* 2 x) 3) 'x) 'x 5)
</eval>
Nun können wir auch Funktionen mit beliebigen Ableitungen grafisch darstellen.<br />
Dazu verwenden wir die bekannte Prozedur <tt>schaubild</tt>.<br />
Die gewünschten Ableitungen müssen aber erst evaluiert und in einer Funktionsliste "gesammelt" werden.
<code id="4b92cc888e8cf" hidden>
(clear canvas)
(define genau 6)
(define width 610)
(define height 460)
(define black
(lambda (canvas)
(setcolor canvas 0 0 0)))
(define red
(lambda (canvas)
(setcolor canvas 255 0 0)))
(define brown
(lambda (canvas)
(setcolor canvas 100 50 0)))
(define orange
(lambda (canvas)
(setcolor canvas 255 100 0)))
(define yellow
(lambda (canvas)
(setcolor canvas 255 200 0)))
(define green
(lambda (canvas)
(setcolor canvas 0 255 0)))
(define blue
(lambda (canvas)
(setcolor canvas 0 0 255)))
(define pink
(lambda (canvas)
(setcolor canvas 200 50 200)))
(define n-tes-mod
(lambda (ls anz)
(list-ref ls (modulo anz (length ls)))))
(define genaurunden
(lambda (x anz)
(let ([n 0] [erg 0])
(if (not (= x 0))
(set! n (inexact->exact (round (- anz (/ (log (abs x)) (log 10)) -0.5)))))
(set! erg (/ (round (* x (expt 10 n))) (expt 10 n)))
(if (integer? erg)
(inexact->exact erg)
(exact->inexact erg)))))
(define groessenordnung
(lambda (x)
(if (= x 0)
1
(let ([pot (/ (log (abs x)) (log 10))])
(genaurunden (expt 10 (floor pot)) genau)))))
(define min
(lambda (x y)
(if (< x y)
(if (> x 0) 0 x)
(if (> y 0) 0 y))))
(define max
(lambda (x y)
(if (> x y)
(if (< x 0) 0 x)
(if (< y 0) 0 y))))
(define ungleich-null
(lambda (x y)
(if (= x y 0) (+ y 1) y)))
(define schaubild
(lambda (fkt-list x1 x2 y1 y2 von bis koordcolor color-list)
(clear canvas)
(setwidth canvas 1)
(let* ([textgroesse 9]
[rand 50]
[xu (exact->inexact (min x1 x2))] [xo (exact->inexact (max x1 x2))] [xo (ungleich-null xu xo)]
[yu (exact->inexact (min y1 y2))] [yo (exact->inexact (max y1 y2))] [yo (ungleich-null yu yo)]
[spmin rand] [spmax (- width rand)] [spend (+ spmax 15)]
[zemin (- height rand)] [zemax rand] [zeend (- zemax 15)]
[s0 (+ (* (/ (- xu) (- xo xu)) (- spmax spmin)) spmin)]
[z0 (+ (* (/ (- yu) (- yo yu)) (- zemax zemin)) zemin)]
[spvon (+ (* (/ (- von xu) (- xo xu)) (- spmax spmin)) spmin)]
[spbis (+ (* (/ (- bis xu) (- xo xu)) (- spmax spmin)) spmin)]
[mx (- xo xu)] [teilerx 1] [stepx (/ (- spmax spmin) mx teilerx)] [ex mx] [faktorx 1]
[my (- yo yu)] [teilery 1] [stepy (/ (- zemin zemax) my teilery)] [ey my] [faktory 1])
(letrec
([anpassen
(lambda (m)
(if (> m 2)
(if (<= m 20)
m
(anpassen (/ m 10)))
(if (> m 2)
m
(anpassen (* m 10)))))]
[teilen
(lambda (m)
(cond
[(< m 3) 5]
[(< m 10) 2]
[else 1]))]
[x-teilen-positiv
(lambda (sx)
(if (< sx (+ spmax 1))
(begin
(line canvas sx z0 sx (- z0 3))
(x-teilen-positiv (+ sx stepx)))))]
[x-teilen-negativ
(lambda (sx)
(if (> sx (- spmin 1))
(begin
(line canvas sx z0 sx (- z0 3))
(x-teilen-negativ (- sx stepx)))))]
[y-teilen-positiv
(lambda (zy)
(if (> zy (- zemax 1))
(begin
(line canvas s0 zy (+ s0 3) zy)
(y-teilen-positiv (- zy stepy)))))]
[y-teilen-negativ
(lambda (zy)
(if (< zy (+ zemin 1))
(begin
(line canvas s0 zy (+ s0 3) zy)
(y-teilen-negativ (+ zy stepy)))))]
[faktor
(lambda (len step)
(if (<= len step)
1
(+ 1 (faktor (- len step) step))))]
[textwidth
(lambda (str)
(* textgroesse (string-length str)))]
[textout-widthcenter
(lambda (sx zy str)
(if (integer? (string->number str))
(text canvas (- sx (/ (textwidth str) 2))
(+ zy (/ textgroesse 2/3)) str textgroesse)
(text canvas (- sx (/ (textwidth str) 2) (- (/ textgroesse 2)))
(+ zy (/ textgroesse 2/3)) str textgroesse)))]
[textout-heightcenter
(lambda (sx zy str)
(if (integer? (string->number str))
(text canvas (- sx (textwidth str) 2)
(+ zy (/ textgroesse 2)) str textgroesse)
(text canvas (- sx (textwidth str) (- (/ textgroesse 2)))
(+ zy (/ textgroesse 2)) str textgroesse)))]
[x-bezeichnen-positiv
(lambda (sx e)
(if (< sx (+ spmax 1))
(begin
(textout-widthcenter sx z0 (number->string (genaurunden e genau)))
(x-bezeichnen-positiv (+ sx (* stepx faktorx)) (+ e (* ex faktorx))))))]
[x-bezeichnen-negativ
(lambda (sx e)
(if (> sx (- spmin 1))
(begin
(textout-widthcenter sx z0 (number->string (genaurunden e genau)))
(x-bezeichnen-negativ (- sx (* stepx faktorx)) (- e (* ex faktorx))))))]
[y-bezeichnen-positiv
(lambda (zy e)
(if (> zy (- zemax 1))
(begin
(textout-heightcenter s0 zy (number->string (genaurunden e genau)))
(y-bezeichnen-positiv (- zy (* stepy faktory)) (+ e (* ey faktory))))))]
[y-bezeichnen-negativ
(lambda (zy e)
(if (< zy (+ zemin 1))
(begin
(textout-heightcenter s0 zy (number->string (genaurunden e genau)))
(y-bezeichnen-negativ (+ zy (* stepy faktory)) (- e (* ey faktory))))))]
[graph-startpkt
(lambda (fkt pkt)
(let ([sx (car pkt)] [zy (cdr pkt)])
(if (< sx (+ spbis 1))
(with-failure-continuation
(lambda (error-record error-k) (graph-startpkt fkt (cons (+ sx 1) zy)))
(lambda ()
(let* ([x (+ (* (/ (- sx spmin) (- spmax spmin)) (- xo xu)) xu)] [y (fkt x)])
(if (real? y)
(begin
(set! zy (+ (* (/ (- y yu) (- yo yu)) (- zemax zemin)) zemin))
(if (> zy zemin) (set! zy zemin))
(if (< zy zemax) (set! zy zemax))
(cons sx zy))
(graph-startpkt fkt (cons (+ sx 1) zy))))))
(cons sx zy))))]
[graph-zeichnen
(lambda (fkt pkt)
(let ([sx (car pkt)] [zy (cdr pkt)])
(if (< sx (+ spbis 1))
(with-failure-continuation
(lambda (error-record error-k)
(graph-zeichnen fkt (graph-startpkt fkt (cons (+ sx 1) zy))))
(lambda ()
(let* ([sx-neu (+ sx 1)]
[x (+ (* (/ (- sx-neu spmin) (- spmax spmin)) (- xo xu)) xu)] [y (fkt x)])
(if (real? y)
(let ([zy-neu (+ (* (/ (- y yu) (- yo yu)) (- zemax zemin)) zemin)])
(if (> zy-neu zemin) (set! zy-neu zemin))
(if (< zy-neu zemax) (set! zy-neu zemax))
(if (and (< zy zemin) (> zy zemax) (< zy-neu zemin) (> zy-neu zemax))
(line canvas sx zy sx-neu zy-neu))
(graph-zeichnen fkt (cons sx-neu zy-neu)))
(graph-zeichnen fkt (graph-startpkt fkt (cons (+ sx 1) zy))))))))))]
[graph-list-zeichnen
(lambda (fkt-ls anz color-ls)
(if (not (null? fkt-ls))
(let ([fkt (eval (car fkt-ls))])
((eval (n-tes-mod color-ls anz)) canvas)
(graph-zeichnen fkt (graph-startpkt fkt (cons spvon z0)))
(graph-list-zeichnen (cdr fkt-ls) (+ anz 1) color-ls))))])
(koordcolor canvas)
(line canvas spmin z0 spend z0)
(line canvas s0 zemin s0 zeend)
(line canvas (- spend 6) (- z0 2) spend z0)
(line canvas (- spend 6) (+ z0 2) spend z0)
(line canvas (- spend 6) (- z0 2) (- spend 6) (+ z0 2))
(line canvas (- s0 2) (+ zeend 6) s0 zeend)
(line canvas (+ s0 2) (+ zeend 6) s0 zeend)
(line canvas (- s0 2) (+ zeend 6) (+ s0 2) (+ zeend 6))
(set! mx (anpassen mx)) (set! teilerx (teilen mx))
(set! stepx (/ (- spmax spmin) mx teilerx))
(set! my (anpassen my)) (set! teilery (teilen my))
(set! stepy (/ (- zemin zemax) my teilery))
(x-teilen-positiv (+ s0 stepx)) (x-teilen-negativ (- s0 stepx))
(y-teilen-positiv (- z0 stepy)) (y-teilen-negativ (+ z0 stepy))
(set! ex (/ ex mx teilerx))
(set! faktorx (faktor
(* textgroesse (string-length (number->string (genaurunden ex genau))))
stepx))
(set! ey (/ ey my teilery))
(set! faktory (faktor
textgroesse
stepy))
(if (= yu 0)
(x-bezeichnen-positiv s0 0)
(x-bezeichnen-positiv (+ s0 (* stepx faktorx)) (* ex faktorx)))
(x-bezeichnen-negativ (- s0 (* stepx faktorx)) (- (* ex faktorx)))
(if (= xu 0)
(y-bezeichnen-positiv z0 0)
(y-bezeichnen-positiv (- z0 (* stepy faktory)) (* ey faktory)))
(y-bezeichnen-negativ (+ z0 (* stepy faktory)) (- (* ey faktory)))
(if (< spvon spmin) (set! spvon spmin)) (if (> spbis spmax) (set! spbis spmax))
(graph-list-zeichnen fkt-list 0 color-list)
'ok))))
</code>
<code id="4b93727670cfb">
(define x-von -10)
(define x-bis 10)
(define y-von -10)
(define y-bis 10)
(define schaubild-n-ableitung
(lambda (term var n)
(letrec
([fkt-liste
(lambda (term n)
(if (< n 0)
()
(append (list (eval (list 'lambda (list var) term)))
(fkt-liste (ableitung term var) (- n 1)))))]
[farb-liste '(red blue green yellow orange pink)])
(schaubild (fkt-liste term n)
x-von x-bis y-von y-bis x-von x-bis
black
farb-liste))))
</code>
<canvas w="610" h="460"></canvas>
<eval id="4b93727671c86">
(schaubild-n-ableitung '(- (* 2 x) 3) 'x 1)
</eval>