Wenn man damit zu tun hat, weiß man, worum es geht. Das Gaußsche Fehlerintegral, leider geschlossen nicht lösbar, wird üblicherweise mit Hilfe von Tabellen bestimmt. Kein Problem für Menschen, die schon vor dem Taschenrechnerzeitalter zur Schule gingen und es gelernt haben, mit tabellierten Funktionen umzugehen, sie schnell und fehlerfrei abzulesen und zu interpolieren. Das waren etwa Logarithmentafeln, Sinustabellen und eben das Gaußsche Fehlerintegral
Die Tabellen sind doch seinerzeit - ohne Computer - berechnet worden. Können wir das, mit unseren heutigen Hilfsmitteln, nicht genau so gut oder besser?
Das oben gezeigte, bestimmte Integral wird dargestellt durch die unendliche Reihe:
Der Rest ist einfach. Nur mal eben unendlich viele Glieder berechnen, aufsummieren, fertig.
Nun ja, die Glieder dieser alternierenden Reihe konvergieren, langsam aber sicher. Bei der Berechnung von Reihen steht eine "Restgliedbetrachtung" an. Die soll verraten, wann man die Reihe abbrechen kann. Bei einer gutartigen Reihe, wie der hier vorliegenden, genügt es, so lange immer höhere Glieder (unten dfkt genannt) zu berücksichtigen, bis deren absoluter Wert eine wählbare Größe (unten Eps) unterschreitet.
Die folgende Funktion setzt diese Idee um. Benötigt wird der n!-Ausdruck, der eigens berechnet wird.
| Option Explicit Const Pi = 3.141592654 Const Eps = 0.0000000001 Function phi(x As Double) As Double Dim n As Integer, fkt As Double, dfkt As Double n = 0 fkt = 0 Do dfkt = (-1) ^ n * x ^ (2 * n + 1) / fak(n) / 2 ^ n / (2 * n + 1) fkt = fkt + dfkt n = n + 1 Loop Until Abs(dfkt) < Eps End Functionphi = fkt / Sqr(2 * Pi) Function fak(m As Integer) As Double Dim i% fak = 1 For i = 1 To m fak = fak * i Next End Function |
Für x > 1 konvergiert diese Reihe sehr, sehr langsam. Für größere x-Werte ist eine so große Zahl von Gliedern erforderlich, daß irgendwann Zahlenüberlauf auftreten kann, der sich zuerst bei der Fakultätsberechnung bemerkbat macht. Deshalb ist es sinnvoll, Vorsorge gegen die Eingabe unvernünftig großer x-Werte zu treffen.
Zunächst ermöglichen wir Nutzung der Funktion. Es sind zwei Textfelder für Ein- und Ausgabe vorgesehen. Dazu ein Button Command1, dessen Click-Ereignis die Rechnung auslöst.
| Private Sub Command1_Click() Dim x As Double x = CDbl(Text1.Text) End SubText2.Text = "Phi(x)= " & Format(phi(x), "0.########") |
Damit wäre das Programm bereits verwendbar, allerdings ohne die oben erwähnte Sicherung gegen Fehlbedienung. Die kommt später.
Aber zuvor:
Was ist mit der Quantile? Der umgekehrten Ablesung also, der Vorgabe einer Prozentschranke und Bestimmung des zugehörigen Vielfachen der Standardabweichung, wofür hier unser x steht? Die könnte man doch gleich mit erschlagen?
Die folgenden Bezeichnungen seien phi(x) = y. Wir suchen diesmal zum vorgegeben y das zugehörige x. Das bedeutet die Lösung der Gleichung: phi(x) - y = 0. Um die zu lösen, suchen wir zunächst eine Beinahe-Lösung ("Vorauswahl") und starten dazu anschließend eine Newtonsche Nullstellensuche. Dies Verfahren bricht ab, wenn die Differenz von phi(x) und y einen vorgegebenen Grenzwert unterschreitet.
Dieser Programmteil könnte dann wie folgt aussehen:
| y = CDbl(Text2.Text) 'Vorauswahl x = 0 Do x = x + 0.1 Loop Until phi(x) > y'Newton-Nullstellensuche Do dphi = (phi(x) - phi(x - 0.000001)) / 0.000001 Loop Until Abs(phi(x) - y) < 0.00000001xn = x - (phi(x) - y) / dphi x = xn Text1.Text = "x = " & Format(x, "0.########") |
Die Einbindung dieses Programmfragmentes ist insofern schon begonnen, als die Eingabe in dem Fenster entgegengenommen wird, in dem bei der vorhergehenden Rechnung das Resultat angezeigt wurde. Wir prüfen die Fenster auf einen Eintrag, werten dies als Anzeige der Rechenrichtung, rechnen und geben in das leere Fenster aus.
Wie das so aussehen könnte? Es sind vier mögliche Fälle denkbar, zwei unerwünschte: Kein Eintrag, zwei Einträge und die zwei möglichen Berechnungsfälle.
| Private Sub Command1_Click() Dim x As Double, y As Double, dphi As Double, xn As Double If Text1.Text <> "" And Text2.Text <> "" Then MsgBox "Erbitte neue Eingabe!", 16, "ACHTUNG" Exit Sub End If If Text1.Text <> "" Then x = CDbl(Text1.Text) Text2.Text = "Phi(x)= " & Format(phi(x), "0.########") ElseIf Text2.Text <> "" Then y = CDbl(Text2.Text) 'Vorauswahl x = 0 Do x = x + 0.1 >Loop Until phi(x) > y 'Newton-Nullstellensuche Do dphi = (phi(x) - phi(x - 0.000001)) / 0.000001 xn = x - (phi(x) - y) / dphi x = xn Loop Until Abs(phi(x) - y) < 0.00000001 Text1.Text = "x= " & Format(x, "0.########") Else MsgBox "Eingabe erforderlich!", 16, " A C H T U N G" End If End Sub |
| Private Sub Text1_GotFocus() Text1.Text = "" End SubText2.Text = "" Private Sub Text2_GotFocus() Text1.Text = "" End SubText2.Text = "0," Text2.SelStart = 3 Private Sub Text1_KeyPress(KeyAscii As Integer) KeyAscii = PrüfeZeichen1(KeyAscii, Text1.Text) End SubPrivate Sub Text2_KeyPress(KeyAscii As Integer) KeyAscii = PrüfeZeichen2(KeyAscii, Text2.Text) End SubFunction PrüfeZeichen1(Prüfling As Integer, vorhTxt As String) As Integer Dim erlaubt As String If Len(vorhTxt) = 0 Then erlaubt = "01234" If Len(vorhTxt) = 1 Then erlaubt = "," & Chr(8) If Len(vorhTxt)> 1 Then erlaubt = "0123456789" & Chr(8) If InStr(erlaubt, Chr(Prüfling)) = 0 Then PrüfeZeichen1 = 0 Exit Function 'Prüfling war unzulässig! End If End FunctionPrüfeZeichen1 = Prüfling 'Prüfling ist zulässig! Function PrüfeZeichen2(Prüfling As Integer, vorhTxt As String) As Integer Dim erlaubt As String If Len(vorhTxt) = 2 Then erlaubt = "01234" If Len(vorhTxt)> 2 Then erlaubt = "0123456789" & Chr(8) If InStr(erlaubt, Chr(Prüfling)) = 0 Then PrüfeZeichen2 = 0 Exit Function 'Prüfling war unzulässig! End If End FunctionPrüfeZeichen2 = Prüfling 'Prüfling ist zulässig! |
Zum Schluß ein Blick auf das Programmfensterchen nach einer Berechnung; es ist - fast - bediensicher. Wie man es überlisten kann, wird nicht verraten.
