XProfan

Italia

p.specht

Im Bereich Statistik hat sich wegen ihrer Verwandtschaft zur Gauss'schen Glockenkurve ("Normalverteilungsfunktion") in manchen speziellen Teilgebieten (etwa in der Risiko- und Ausfallsanalyse) die etwas leichter zu berechnende Fehlerfunktion Erf(x) etabliert. Auch die Komplementärfunktion ErfC(x) = 1-Erf(x) hat hier Eingang gefunden (Hinweis: An Stelle x=0 ist der Wert der Komplementärfunktion 1-0 = 1, die Funktion ist also NICHT zentralsymmetrisch zur Erf(x)-Funktion! Nach diesem "Fehler" hatte ich mich zuerst noch krumm und bucklig gesucht, es war aber gar keiner !)

In FORTRAN stehen diese Funktionen übrigens von Anfang an als Bibliotheksfunktionen zur Verfügung. Da soll doch XProfan keinesfalls nachstehen, oder?

Kompilieren Markieren Separieren

WindowTitle upper$("Gauss'sche Fehlerfunktionen Erf(x) und Erfc(x)")
' Q: https://de.wikipedia.org/wiki/Fehlerfunktion#Numerische_Berechnung
' Umsetzung in XPRofan (CL) CopyLeft 2014-10 by P.Specht, Wien
' Keine wie auch immer geartetet Gewähr!

Proc Erf :parameters x!

    ' Approximation von Erf() per den kompletten Wertebereich, maximaler Fehler 1.2E-7
    declare t!,t2!,t3!,t4!,t5!,t6!,t7!,t8!,t9!,tau!
    t!=1/(1+0.5*abs(x!)):t2!=sqr(t!):t3!=t!*t2!:t4!=t2!*t2!
    t5!=t3!*t2!:t6!=t3!*t3!:t7!=t4!*t3!:t8!=t4!*t4!:t9!=t5!*t4!
    tau!=t!*exp(-sqr(x!)-1.26551223+1.00002368*t!+0.37409196*t2!+0.09678418*t3!-0.18628806*t4!+\
    0.27886807*t5!-1.13520398*t6!+1.48851587*t7!-0.82215223*t8!+0.17087277*t9!)
    case x!>=0:return 1-tau!
    return tau!-1

endproc

proc Erfc:parameters x!' Complementäre Fehlerfunktion 1-Erf(x), nicht zentralsymmetrisch!

    return 1-Erf(x!)

endproc

WindowStyle 24:Window 0,0-%maxx,%maxy-40
var xh&=width(%hwnd)\2:var yh&=height(%hwnd)\2:var x!=0
var zoomx!=%maxx/1366:var zoomy!=%maxy/768
noamoi:
Cls
'Achsen
usepen 2,1,rgb(0,0,0):line 0,yh&-2*xh&,yh&:line xh&,0-xh&,2*yh&
'Beschriftung
usefont "ARIAL",60*zoomy!,30*zoomx!,0,0,0:textcolor rgb(200,0,200),-1
drawtext 250*zoomx!,30*zoomy!,"Erfc(x)"
textcolor rgb(200,0,0),-1:drawtext 250*zoomx!,430*zoomy!,"Erf(x)":textcolor 0,-1
drawtext 650*zoomx!,1*zoomy!,"2":drawtext 650*zoomx!,120*zoomy!,"1"
drawtext 650*zoomx!,290*zoomy!,"0"
drawtext 650*zoomx!,450*zoomy!,"-1":drawtext 250*zoomx!,320*zoomy!,"-3.5"
drawtext 950*zoomx!,320*zoomy!,"3.5"
'Asymptotenlinien
usepen 0,2,rgb(0,180,0)
line 0,(yh&-yh&*0.5*erf(-5)) - 2*xh&,yh&-yh&*0.5*erf(-5)
line 0,(yh&-yh&*0.5*erf( 5)) - 2*xh&,yh&-yh&*0.5*erf( 5)
'Darstellung von ERF()
usepen 0,4,rgb(200,0,0):Moveto 0,yh&-yh&*0.5*erf(-3.7)

whileloop -xh&,xh&,1 : x!=&Loop*3.7/xh&

    Lineto xh&+x!*xh&/3.7,yh&-yh&*0.5*erf(x!)

endwhile

'Darstellung der Komplementärfunktion ErfC(x). Sie ist NICHT zentralsymmetrisch!!!
usepen 0,4,rgb(200,0,200):Moveto 0,yh&-yh&*0.5*erfc(-3.7)

whileloop -xh&,xh&,1 : x!=&Loop*3.7/xh&

    Lineto xh&+x!*xh&/3.7 , yh&-yh&*0.5*erfc(x!)

endwhile

'Ausgabe der Berechnungswerte zum Vergleich mit nachstender Verifizierungstabelle
waitinput 10000:font 2
locate 1,1:Set("decimals",7)

whileloop 0,3500,50:x!=&Loop/1000

    print x!,erf(x!),erfc(x!)
    case %csrlin>50:waitinput 20000

endwhile

beep
waitinput 20000
GOTO "noamoi"
END
'             Tabelle zur Verifizierung der Formel:
'-----------------------------------------------------------------
'    x 	erf(x) 	erfc(x) 		      !   x 	erf(x) 	erfc(x)
'---------------------------------!-------------------------------
'    0.00 	0.0000000 	1.0000000   1.30 	0.9340079 	0.0659921
'    0.05 	0.0563720 	0.9436280   1.40 	0.9522851 	0.0477149
'    0.10 	0.1124629 	0.8875371 	1.50 	0.9661051 	0.0338949
'    0.15 	0.1679960 	0.8320040 	1.60 	0.9763484 	0.0236516
'    0.20 	0.2227026 	0.7772974 	1.70 	0.9837905 	0.0162095
'    0.25 	0.2763264 	0.7236736 	1.80 	0.9890905 	0.0109095
'    0.30 	0.3286268 	0.6713732 	1.90 	0.9927904 	0.0072096
'    0.35 	0.3793821 	0.6206179 	2.00 	0.9953223 	0.0046777
'    0.40 	0.4283924 	0.5716076 	2.10 	0.9970205 	0.0029795
'    0.45 	0.4754817 	0.5245183 	2.20 	0.9981372 	0.0018628
'    0.50 	0.5204999 	0.4795001 	2.30 	0.9988568 	0.0011432
'    0.55 	0.5633234 	0.4366766 	2.40 	0.9993115 	0.0006885
'    0.60 	0.6038561 	0.3961439 	2.50 	0.9995930 	0.0004070
'    0.65 	0.6420293 	0.3579707 	2.60 	0.9997640 	0.0002360
'    0.70 	0.6778012 	0.3221988 	2.70 	0.9998657 	0.0001343
'    0.75 	0.7111556 	0.2888444 	2.80 	0.9999250 	0.0000750
'    0.80 	0.7421010 	0.2578990 	2.90 	0.9999589 	0.0000411
'    0.85 	0.7706681 	0.2293319 	3.00 	0.9999779 	0.0000221
'    0.90 	0.7969082 	0.2030918 	3.10 	0.9999884 	0.0000116
'    0.95 	0.8208908 	0.1791092 	3.20 	0.9999940 	0.0000060
'    1.00 	0.8427008 	0.1572992 	3.30 	0.9999969 	0.0000031
'    1.10 	0.8802051 	0.1197949 	3.40 	0.9999985 	0.0000015
'    1.20 	0.9103140 	0.0896860 	3.50 	0.9999993 	0.0000007