XProfan

Italia

p.specht

Ein Klassiker: Die numerische Integration durch Aufteilung einer Funktion y(x) in N gleich grande Streifen, Einpassung einer Parabel in jeweils drei Funktionspunkte y(x) und Summierung der mathematisch nun relativ einfach berechenbaren Flächen unter den gefundenen Parabelstücken zwischen den vorgegebenen Grenzen X-unten und X-oben. Je nach Funktion liefert schon eine Teilung in nur 8 Streifen bereits recht brauchbare Ergebnisse! In nachstehender Version ist nun eine Fehlerabfangmöglichkeit im Funktions-Proc eingebaut.

Kompilieren Markieren Separieren

'---------------------------------------------------------------------------------------
'          BESTIMMTES INTEGRAL NACH DER SIMPSON-REGEL (3-Punkte-Parabel)
'---------------------------------------------------------------------------------------
' In leichter Anlehnung an: J.Ober/W.Sokol: Technische Gleichungssysteme
' XProfan 11.2a 2014-05 by P. Specht, Wien
' Keine wie auch immer geartete Gewähr!
'---------------------------------------------------------------------------------------
' Die numerisch zu integrierende Funktion als FnY mit Parameter x! hier eingeben:  -----

proc FnY :parameters x!

    declare fny!
    ' Zum Fehler-Abfangen Magic-Wert -99999999999999 (- 14*'9') zurückgeben!
    ' case x!=0:return -99999999999999
    '       FnY! = 1/x! '... verträgt z.B. keine Null im Nenner!
    ' ORIGINALE TESTFUNKTION:
    FnY! = 4/(1+sqr(x!))' Originale Testfunktion, ...
    '       muss bei Integration zwischen 0 und 1: Pi() ergeben!
    return FnY!

endproc

'---------------------------------------------------------------------------------------
Main:
 $IFDEF Interpreter
WindowTitle "Bestimmtes Integral nach der Simpson-Regel (3-Punkte-Parabel)    I N T E R P R E T E R "
 $ENDIF
 $IFDEF Compiler
WindowTitle "Bestimmtes Integral nach der Simpson-Regel (3-Punkte-Parabel)    C O M P I L I E R T !"
 $ENDIF
windowstyle 24:randomize:CLS rgb(200+rnd(56),200+rnd(56),200+rnd(56)):font 2:set("decimals",18)
declare v$,xu!,xo!,xd!,dd&,e&,fk&,x!,n&,sum!,f!
Print "\n 0. Zu integrierende Funktion als Proc FnY :parameters x! einprogrammieren!\n"
Print "    Erledigt ? [ J, j, Y, y ='Ja']: ";:input v$:v$=left$(lower$(trim$(v$)),1)

ifnot (v$="j") or (v$="y")

    beep:Print mkstr$("\n",12);tab(20);"   B I T T E   E R L E D I G E N !   ":waitinput :end

endif

LOOP:
print "\n 1. Untergrenze des bestimmten Integrals: Xu = ";:input v$:xu!=val(v$)

if FNY(xu!)=-99999999999999:sound 2000,200

    Print "\n PROBLEM MIT FUNKTION AN STELLE X = ";x!;"\n":goto "Frage"

endif

print "\n 2. Obergrenze  des bestimmten Integrals: XO = ";:input v$:xo!=val(v$)

if FNY(xO!)=-99999999999999:sound 2000,200

    Print "\n PROBLEM MIT FUNKTION AN STELLE X = ";x!;"\n":goto "Frage"

endif

print "\n 3. Anzahl der Streifen (Gerade Zahl, z.B. 8): ";:input v$:n&=val(v$)
n&=abs(n&):case n&<2:n&=2:case n&>1000000:n&=1000000:case n& mod 2: n&=n&+1
' Verarbeitung (Simpson-Integration)
xd!=(xo!-xu!)/n&:x!=xu!:sum!=fny(x!):e&=-1

whileloop n&-1:e&=-1*e&:fk&=3+e&

    x!=xu!+&Loop*xd!:f!=fny(x!):CASE f!=-99999999999999:BREAK
    sum!=sum!+fk&*f!

endwhile

IF f!=-99999999999999:sound 2000,200

    Print "\n PROBLEM MIT FUNKTION AN STELLE X = ";x!;"\n":goto "Frage"

ENDIF

x!=xo!:sum!=sum!+fny(x!):sum!=xd!*sum!/3
print "\n\n Das 'Bestimmte Integral' der Funktion FNY(x) "
print " (die Fläche unter der Kurve) zwischen Xu = ";
print format$("%g",xu!);" und XO = ";format$("%g",xo!);","
print " zusammengesetzt aus ";int(n&);" Streifen, beträgt nach Simpson:"
print "\n";tab(55);format$("%g",Sum!);"\n"
'
' --- Ergänzung per reine Testzwecke, nur sinnvoll mit der originalen FnY-Funktion:

if nearly(sum!,pi(),3)

    print "                               Computer-Pi()          ";pi()
    print " Der absolute Fehler opposto Computer-Pi() beträgt  ";abs(sum!-pi())
    print " Der relative Fehler opposto Computer-Pi() beträgt  ";
    print abs(100*(sum!-pi())/pi());" % "

endif

' --------------------------------------------------------------------------------------
'
Frage:
Print "\n      Nochmal ? [ J, j, Y, y ='Ja']: ";:input v$
v$=left$(lower$(trim$(v$)),1):casenot (v$="j") or (v$="y"):END
CLS rgb(200+rnd(56),200+rnd(56),200+rnd(56)):goto "LOOP"
PROGEND