Grundlagen der funktionsorientierten Programmierung mit SCHEME/Prozeduren höherer Ordnung (II)
Aus ProgrammingWiki
Wiki-Quelltext dieser Seite.
<language>SchemeJS</language>
<code id="5ba6527579e84" hidden>
(define nr 1)
(define genau 6)
(define breite 610)
(define hoehe 460)
(define rand 50)
(define canvas (eval (string->symbol (string-append "canvas" (number->string nr)))))
(define bez "x")
(define raster #f)
(define sqr
(lambda (x)
(* x x)))
(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])
(if (not (= x 0))
(set! n (round (- anz (/ (log (abs x)) (log 10)) -0.5))))
(/ (round (* x (expt 10 n))) (expt 10 n)))))
(define groessenordnung
(lambda (x)
(if (= x 0)
1
(let ([pot (/ (log (abs x)) (log 10))])
(genaurunden (expt 10 (floor pot)) genau)))))
(define minimum
(lambda (x y)
(if (< x y)
(if (> x 0) 0 x)
(if (> y 0) 0 y))))
(define maximum
(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]
[xu (minimum x1 x2)] [xo (maximum x1 x2)] [xo (ungleich-null xu xo)]
[yu (minimum y1 y2)] [yo (maximum y1 y2)] [yo (ungleich-null yu yo)]
[spmin rand] [spmax (- breite rand)] [spend (+ spmax 15)]
[zemin (- hoehe 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-raster
(lambda (sx zy)
(if (> zy (- zemax 1))
(begin
(line canvas sx zy sx zy)
(x-raster sx (- zy 3)))))]
[x-teilen-positiv
(lambda (sx)
(if (< sx (+ spmax 1))
(begin
(line canvas sx z0 sx (- z0 3))
(if raster (x-raster sx zemin))
(x-teilen-positiv (+ sx stepx)))))]
[x-teilen-negativ
(lambda (sx)
(if (> sx (- spmin 1))
(begin
(line canvas sx z0 sx (- z0 3))
(if raster (x-raster sx zemin))
(x-teilen-negativ (- sx stepx)))))]
[y-raster
(lambda (sx zy)
(if (< sx (+ spmax 1))
(begin
(line canvas sx zy sx zy)
(y-raster (+ sx 3) zy))))]
[y-teilen-positiv
(lambda (zy)
(if (> zy (- zemax 1))
(begin
(line canvas s0 zy (+ s0 3) zy)
(if raster (y-raster spmin zy))
(y-teilen-positiv (- zy stepy)))))]
[y-teilen-negativ
(lambda (zy)
(if (< zy (+ zemin 1))
(begin
(line canvas s0 zy (+ s0 3) zy)
(if raster (y-raster spmin 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)))]
[textout-bez-widthcenter
(lambda (sx zy str)
(text canvas (- sx (/ (textwidth str) 4))
(- zy textgroesse) str textgroesse))]
[textout-bez-heightcenter
(lambda (sx zy str)
(text canvas (+ sx (/ 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))))))]
[x-achse-bezeichnen
(lambda (str)
(textout-bez-heightcenter spend z0 str))]
[y-achse-bezeichnen
(lambda (str)
(let ([y-str (string-append "f(" str ")")])
(textout-bez-widthcenter s0 zeend y-str)))]
[graph-startpkt
(lambda (fkt pkt)
(let ([sx (car pkt)] [zy (cdr pkt)])
(if (< sx (+ spbis 1))
(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))
(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)))
(x-achse-bezeichnen bez)
(y-achse-bezeichnen bez)
(if (< spvon spmin) (set! spvon spmin)) (if (> spbis spmax) (set! spbis spmax))
(graph-list-zeichnen fkt-list 0 color-list)
'ok))))
</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>
<run id="4b14d88e40f55">
((invers *) 5 2)
</run>
=== Prozeduren als Rückgabewert ===
Wir vergleichen folgende Prozedurdefinitionen:
<table cellspacing="0" cellpadding="2">
<tr valign="top">
<td width="400">
<code id="4b117c410350b">
(define add
(lambda (a b)
(+ a b)))
</code>
</td>
<td width="400">
<code id="4b14d88e37314">
(define add-with
(lambda (a)
(lambda (b)
(+ a b))))
</code>
</td>
</tr>
<tr valign="top">
<td>
<run id="4b14d88e41ef5">
(add 5 7)
</run>
</td>
<td>
<run id="4b14d88e42e95">
((add-with 5) 7)
</run>
</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 cellspacing="0" cellpadding="2">
<tr valign="top">
<td width="400">
<run id="4b14d88e43e34">
(add-with 5)
</run>
</td>
<td width="400">
<run id="4b14d88e44dde">
(map (add-with 5) '(1 2 3 4 5))
</run>
</td>
</tr>
</table>
=== Differential- und Differenzenquotient ===
Aus der Mathematik ist die Definition des Differentialquotienten bekannt:
<blockquote>
$f'(x)=\lim\limits_{h \to 0}\frac{f(x+h)-f(x)}{h}$
</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="2">
<tr valign="top">
<td width="400">
<blockquote>$f_{1}(x)=x^2-2$</blockquote>
</td>
<td width="400">
<blockquote>$f_{2}(x)=3x^2+\frac{2}{x}$</blockquote>
</td>
</tr>
<tr valign="top">
<td>
<blockquote>$f_{1}'(4)=...$</blockquote>
</td>
<td>
<blockquote>$f_{2}'(2)=...$</blockquote>
</td>
</tr>
<tr valign="top">
<td>
<code id="4b14d88e3a1f3">
(define fkt1
(lambda (x)
...))
</code>
</td>
<td>
<code id="4b14d88e3b192">
(define fkt2
(lambda (x)
...))
</code>
</td>
</tr>
<tr valign="top">
<td>
<check>
(and (= (fkt1 -3) 7) (= (fkt1 1) -1))
</check>
</td>
<td>
<check>
(and (= (fkt2 -3) (/ 79 3)) (= (fkt2 1) 5))
</check>
</td>
</tr>
<tr valign="top">
<td>
<run id="4b14d88e45d76">
((ableitung fkt1) 4)
</run>
</td>
<td>
<run id="4b14d88e46d16">
((ableitung fkt2) 2)
</run>
</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>
<run id="5ba652757a03f">
(schaubild '(fkt1 (ableitung fkt1)) -10 10 -8 8 -10 10 black '(red blue))
</run>
'''Hinweis:''' Syntax der Prozedur <tt>schaubild</tt>:
(schaubild
<Prozedurliste> ; quotierte Liste mit den darzustellenden Funktionen
<xu xo yu yo> ; Grenzen des Koordinatensystems
<li re> ; Intervallgrenzen
<KoordSyst-Farbe> ; Farbe des Koordinatensystems
<Farbliste>) ; quotierte 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>
<run id="4ca509f1b7e8e">
(runden (sqrt 2) 3)
</run>
Vervollständigen und testen Sie nun die Prozedur <tt>wertetabelle</tt>.
<code id="5ba6b22e4df6b">
(define anz 2)
(define argumente
(lambda (xl xr dx)
(if (> xl xr)
()
(cons xl (argumente (+ xl dx) xr dx)))))
(define tabausgabe
(lambda (ls1 ls2 ls3)
(if (or (null? ls1) (null? ls2) (null? ls3))
'ok
(begin
(display (number->string (runden (car ls1) anz))
(string #\tab)
(number->string (runden (car ls2) anz))
(string #\tab)
(number->string (runden (car ls3) anz)))
(tabausgabe (cdr ls1) (cdr ls2) (cdr ls3))))))
(define wertetabelle
(lambda (fkt ls)
(display "x" (string #\tab) "f(x)" (string #\tab) "f'(x)")
(tabausgabe ls (map fkt ls) (map (ableitung fkt) ls))))
</code>
<run id="4cb1780897d04">
(wertetabelle fkt1 '(-6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6))
</run>
</li>
<li>
Entwickeln Sie die Prozedur <tt>(nstliste <fkt> <min> <max> <dx>)</tt>, die zu einer beliebigen stetigen Funktion ''alle'' Nullstellen im Intervall $[min \hspace{0.3em};\hspace{0.3em} max]$ als Liste zurückgibt.<br />
'''Lösungsalgorithmus:'''<br />
* Zerlege das Intervall $[min \hspace{0.3em};\hspace{0.3em} max]$ in Teilintervalle der Breite $dx$.
* 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 $max$ 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>
(nstsuche sin 2 4)
--> 3.141592025756836
</pre>
<code id="4b14d88e3f0f7">
(define nstsuche
(lambda (fkt xl xr)
(let ([x (/ (+ xl xr) 2)])
...)))
</code>
<run id="5ba6b22e4e08c">
(nstsuche sin 2 4)
</run>
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>
<run id="4b14d88e4bb37">
(nstliste sin -10 10 0.33)
</run>
</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]].