(******************************************************) (* ** Datei an1func.ari ** ** ARIBAS Code zum Buch ** Analysis 1 von O. Forster ** 6. Auflage 2001 ** Vieweg-Verlag, ISBN 3-528-57224-8 ** ** Das Programm ARIBAS ist erhaeltlich ueber die ** Hompage des Verfassers ** http://www.mathematik.uni-muenchen.de/~forster ** Unterpunkt Software --> Aribas *) (******************************************************) (* ** Durch den Aribas-Befehl ** ** ==> load("an1func"). ** ** werden die Funktionen geladen und stehen anschliessend in ** Aribas zur verfuegung. *) (******************************************************) (* ** 8. Die Exponentialreihe *) (*----------------------------------------------------*) (* ** Die folgende Funktion berechnet die Eulerzahl e ** auf n Dezimalstellen genau. ** Die Berechnung erfolgt mit Integer-Arithmetik, ** es wird 10**n * e mit einem Fehler < 1 berechnet ** Das Resultat ist deshalb durch 10**n dividiert ** zu denken. ** ** Beispiel-Aufruf: ** ==> euler(1000). *) function euler(n: integer): integer; var S, u, k: integer; begin S := u := 10**(n+5); k := 0; while u > 0 do k := k+1; u := u div k; S := S+u; end; writeln("Euler number calculated in ",k," steps"); return (S div 10**5); end. (*----------------------------------------------------*) (* ** 11. Saetze ueber stetige Funktionen *) (*----------------------------------------------------*) (* ** Die Funktion findzero bestimmt mit dem ** Intervallhalbierungs-Verfahren eine Nullstelle ** der Funktion f mit einem Fehler < eps ** ** Voraussetzungen: f ist eine Funktion einer ** Variablen, die im abgeschlossenen Intervall ** von a nach b definiert ist und dort Werte ** entgegengesetzten Vorzeichens hat. ** Die Fehlerschranke eps muss groesser ** als 0 sein. ** ** Beispielaufruf: ** ==> findzero(testfun,0,2,10**-7). *) function findzero(f: function; a,b,eps: real): real; var x1,x2,y1,y2,m: real; begin y1 := f(a); y2 := f(b); if (y1 > 0 and y2 > 0) or (y1 < 0 and y2 < 0) then writeln("bad interval [a,b]"); halt(); elsif y1 < 0 then x1 := a; x2 := b; else x1 := b; x2 := a; end; while abs(x2-x1) > eps do m := (x1 + x2)/2; if f(m) >= 0 then x2 := m; else x1 := m; end; end; return (x1 + x2)/2; end. (*----------------------------------------------------*) (* ** Testfunktion fuer findzero *) function testfun(x: real): real begin return x**5 - x - 1; end. (*----------------------------------------------------*) (* ** 14. Trigonometrische Funktionen *) (*----------------------------------------------------*) (* ** Die Funktion cos20(x) berechnet einen ** Naeherungswert fuer cos(x) durch den Anfang der ** Potenzreihen-Entwicklung bis zu Gliedern ** der Ordnung 20. ** Der Fehler ist kleiner als |x|**22/10**21 *) function cos20(x: real): real; var z, u, xx: real; k: integer; begin z := u := 1.0; xx := -x*x; for k := 1 to 10 do u := u*xx/((2*k-1)*2*k); z := z + u; end; return z; end. (*------------------------------------------------------ ** Beispiel-Anwendung: ** ** ==> set_floatprec(double_float). ** -: 64 ** ** ==> eps := 10**-15. ** -: 1.00000000000000000E-15 ** ==> x0 := findzero(cos20,0,2,eps). ** -: 1.57079632679489700 ** ** ==> cos20(x0-eps/2). ** -: 1.35479697569886180E-16 ** ** ==> cos20(x0+eps/2). ** -: -8.64512190806724724E-16 *) (******************************************************)