Grundlagen der funktionsorientierten Programmierung mit SCHEME/Prozeduren höherer Ordnung (II)
Aus ProgrammingWiki
Wiki-Quelltext dieser Seite.
<language>Scheme</language>
<code id="4b1b75a4b8d72" hidden>
(define sqr
(lambda (x)
(* x x)))
</code>
== Prozeduren geben Prozeduren zurück ==
=== Umkehroperationen ===
Wir konstruieren eine Prozedur, die den inversen Operator und somit eine Prozedur zurückgibt:
<blockquote>[[Bild:Invers1.gif]]</blockquote>
<code id="4b14d88e36375">
(define invers
(lambda (op)
(cond
[(eq? op +) -] [(eq? op -) +]
[(eq? op *) /] [(eq? op /) *]
[(eq? op sqr) sqrt] [(eq? op sqrt) sqr]
[(eq? op sin) asin] [(eq? op asin) sin]
[(eq? op cos) acos] [(eq? op acos) cos]
[(eq? op tan) atan] [(eq? op atan) tan]
[(eq? op exp) log] [(eq? op log) exp]
[else
#f])))
</code>
<eval id="4b14d88e40f55">
((invers *) 5 2)
</eval>
=== Prozeduren als Rückgabewert ===
Wir vergleichen folgende Prozedurdefinitionen:
<table cellspacing="0" cellpadding="1">
<tr>
<td>
<table cellspacing="0" cellpadding="1">
<tr>
<td valign="top" height="100">
<code id="4b117c410350b">
(define add
(lambda (a b)
(+ a b)))
</code>
</td>
</tr>
<tr>
<td>
<eval id="4b14d88e41ef5">
(add 5 7)
</eval>
</td>
</tr>
</table>
</td>
<td>
<table cellspacing="0" cellpadding="1">
<tr>
<td valign="top" height="100">
<code id="4b14d88e37314">
(define add-with
(lambda (a)
(lambda (b)
(+ a b))))
</code>
</td>
</tr>
<tr>
<td>
<eval id="4b14d88e42e95">
((add-with 5) 7)
</eval>
</td>
</tr>
</table>
</td>
</tr>
</table>
Aus der Notation des Prozeduraufrufs mit <tt>add-with</tt> ist erkennbar, dass <tt>(add-with 5)</tt> selbst ein Operator bzw. eine Prozedur sein muss.<br />
Wir überprüfen diese Vermutung:
<table>
<tr>
<td>
<eval id="4b14d88e43e34">
(add-with 5)
</eval>
</td>
<td>
<eval id="4b14d88e44dde">
(map (add-with 5) '(1 2 3 4 5))
</eval>
</td>
</tr>
</table>
=== Differential- und Differenzenquotient ===
Aus der Mathematik ist die Definition des Differentialquotienten bekannt:
<blockquote>
<math>f'(x)=\lim_{h\to 0}\frac{f(x+h)-f(x)}{h}</math>
</blockquote>
Scheme kann natürlich nur mit einem endlichen Wert für h arbeiten.
Wir definieren deshalb:
<code id="4b14d88e382bd">
(define h 1e-06)
</code>
Damit gehen wir vom Differential- zum Differenzenquotienten mit kleinen Intervallen über.<br />
Nun können wir eine Prozedur höherer Ordnung definieren, die die ''Ableitung beliebiger(!) Funktionen'' als Näherungswert ermittelt!
<code id="4b14d88e39257">
(define ableitung
(lambda (fkt)
(lambda (x)
(/ (- (fkt (+ x h)) (fkt x)) h))))
</code>
Wir definieren zwei Testfunktionen und rechnen nach.
<table cellspacing="0" cellpadding="1">
<tr>
<td>
<table cellspacing="0" cellpadding="1">
<tr>
<td height="65">
<blockquote><math>f_{1}(x)=x^2-2</math></blockquote>
</td>
</tr>
<tr>
<td>
<blockquote><math>f_{1}'(4)=...</math></blockquote>
</td>
</tr>
<tr>
<td>
<code id="4b14d88e3a1f3">
(define fkt1
(lambda (x)
...))
</code>
</td>
</tr>
<tr>
<td>
<check>
(and (= (fkt1 -3) 7) (= (fkt1 1) -1))
</check>
</td>
</tr>
<tr>
<td>
<eval id="4b14d88e45d76">
((ableitung fkt1) 4)
</eval>
</td>
</tr>
</table>
</td>
<td>
<table cellspacing="0" cellpadding="1">
<tr>
<td height="65">
<blockquote><math>f_{2}(x)=3x^2+\frac{2}{x}</math></blockquote>
</td>
</tr>
<tr>
<td>
<blockquote><math>f_{2}'(2)=...</math></blockquote>
</td>
</tr>
<tr>
<td>
<code id="4b14d88e3b192">
(define fkt2
(lambda (x)
...))
</code>
</td>
</tr>
<tr>
<td>
<check>
(and (= (fkt2 -3) 79/3) (= (fkt2 1) 5))
</check>
</td>
</tr>
<tr>
<td>
<eval id="4b14d88e46d16">
((ableitung fkt2) 2)
</eval>
</td>
</tr>
</table>
</td>
</tr>
</table>
Natürlich dürfen wir ''nicht'' erwarten, dass die Prozedur <tt>ableitung</tt> die ''symbolische'' Ableitung einer Funktion ermittelt. Sie liefert lediglich den ''numerischen'' Näherungswert der ersten Ableitung an der Stelle x.
Wir können uns aber im Schaubild der Funktion von ihrer Leistungsstärke überzeugen.
<canvas w="610" h="460"></canvas>
<code id="4b3625fdaa918" hidden>
(define sqr
(lambda (x)
(* x x)))
(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>
<eval id="4b1b75a4bbc3a">
(schaubild (list fkt1 (ableitung fkt1)) -10 10 -8 8 -10 10 black '(red blue))
</eval>
'''Hinweis:''' Syntax der Prozedur <tt>schaubild</tt>:
(schaubild
<Prozedurliste> ; Liste mit den darzustellenden Funktionen
<xu xo yu yo> ; Grenzen des Koordinatensystems
<li re> ; Intervallgrenzen
<KoordSyst-Farbe> ; Farbe des Koordinatensystems
<Farbliste>) ; Liste mit den Farben der Funktionsgraphen
Im vorliegenden Fall handelt es sich um einen sehr einfachen Funktionsplotter mit dennoch nützlichen Eigenschaften:
* als Farben können <tt>black</tt>, <tt>red</tt>, <tt>brown</tt>, <tt>orange</tt>, <tt>yellow</tt>, <tt>green</tt>, <tt>blue</tt> und <tt>pink</tt> verwendet werden,
* Prozedur- und Farbliste müssen nicht die gleiche Länge haben, die Farben der Funktionsgraphen werden entsprechend der Anzahl der Funktionen <tt>modulo</tt>-eingesetzt,
* Fehler, die durch unzulässiges Überschreiten des Definitionsbereiches entstehen, werden ignoriert.
== Aufgaben ==
<ol>
<li>
Testen Sie die Prozedur <tt>ableitung</tt> am Beispiel der Sinusfunktion, ihrer ersten und zweiten Ableitung.<br />
Führen Sie weitere Tests mit selbstgewählten unbenannten Prozeduren durch.
</li>
<li>
Wir wollen Wertetabellen von Funktionen und ihren Ableitungen erstellen.<br />
Dazu ist es sinnvoll, die Prozedur zum [[Grundlagen der funktionsorientierten Programmierung mit SCHEME/Prozeduren|Runden von Gleitkommazahlen]] bereitzustellen.
<code id="4ca509f1b7cb9">
(define runden
(lambda (x anz)
(/ (round (* x (expt 10 anz))) (expt 10 anz))))
</code>
<eval id="4ca509f1b7e8e">
(runden (sqrt 2) 3)
</eval>
Vervollständigen und testen Sie nun die Prozedur <tt>wertetabelle</tt>.
<code id="4cb1780897b36">
(define anz 2)
(define wertetabelle
(lambda (fkt ls)
(display "x") (display #\tab) (display "f(x)") (display #\tab) (display "f'(x)")
(newline)
...))
(define tabausgabe
(lambda (ls1 ls2 ls3)
(if (or (null? ls1) (null? ls2) (null? ls3))
'ok
(begin
(display (number->string (exact->inexact (runden (car ls1) anz))))
(display #\tab)
(display (number->string (exact->inexact (runden (car ls2) anz))))
(display #\tab)
(display (number->string (exact->inexact (runden (car ls3) anz))))
(newline)
(tabausgabe (cdr ls1) (cdr ls2) (cdr ls3))))))
</code>
<eval id="4cb1780897d04">
(wertetabelle fkt1 '(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6))
</eval>
</li>
<li>
Entwickeln Sie die Prozedur <tt>(nstliste <fkt> <min> <max> <dx>)</tt>, die zu einer beliebigen stetigen Funktion ''alle'' Nullstellen im Intervall <math>[min ; max]</math> als Liste zurückgibt.<br />
'''Lösungsalgorithmus:'''<br />
* Zerlege das Intervall <math>[min ; max]</math> in Teilintervalle der Breite <math>dx</math>.
* Prüfe an den Intervallgrenzen jedes Teilintervalls die Vorzeichen der Funktionswerte.
* Bei entgegengesetzten Vorzeichen muss die stetige Funktion in diesem Teilintervall eine Nullstelle haben, die durch fortlaufende Intervallhalbierung eingegrenzt wird.
* Die Nullstelle ist gefunden, wenn die beiden Intervallgrenzen sehr dicht beieinander liegen. Füge diese Nullstelle der der Lösungsmenge (Liste) hinzu.
* Setze die Suche in den Nachbarintervallen fort, bis die rechte Intervallgrenze <math>max</math> erreicht ist.
'''Vorüberlegung:'''<br />
Durch Halbierung werden die Intervalle immer kleiner. Die Suche wird abgebrochen, wenn die Intervallbreite in einer hinreichend kleinen Epsilon-Umgebung liegt.<br />
Zunächst definieren wir diese Epsilon-Umgebung:
<code id="4b14d88e3e073">
(define eps 1e-06)
</code>
Nun implementieren wir die Nullstellensuche durch Intervallhalbierung in ''einem'' Teilintervall:
<pre>
(exact->inexact (nstsuche sin 2 4))
--> 3.141592025756836
</pre>
<code id="4b14d88e3f0f7">
(define nstsuche
(lambda (fkt xl xr)
(let ([x (/ (+ xl xr) 2)])
...)))
</code>
<eval id="4b14d88e4ab97">
(exact->inexact (nstsuche sin 2 4))
</eval>
Damit kann die Suche nach ''allen'' Nullstellen implementiert werden.<br />
Die Nullstellen werden dabei sinnvoll gerundet, z.B.:
<pre>
(nstliste sin -10 10 0.33)
--> (-9.4248 -6.2832 -3.1416 0.0 3.1416 6.2832 9.4248)
</pre>
<code id="4b14d88e3ffbc">
(define nstliste
(lambda (fkt xl xr dx)
...))
</code>
<eval id="4b14d88e4bb37">
(nstliste sin -10 10 0.33)
</eval>
</li>
</ol>
== Zum Weiterarbeiten ==
=== Kurvendiskussion ===
Führen Sie zu einer selbstgewählten Funktion (Mathematikunterricht!) eine vollständige [[Grundlagen der funktionsorientierten Programmierung mit SCHEME/Kurvendiskussion|Kurvendiskussion]] durch.<br />
Ermitteln Sie dazu mit Hilfe des konstruierten "Mathematikwerkzeugs":
* das Schaubild,
* die Nullstellen,
* lokale Extrema,
* Wendepunkte sowie
* das Verhalten im Unendlichen.
Zur [[Grundlagen der funktionsorientierten Programmierung mit SCHEME/Kurvendiskussion|Problemlösung]].