XProfan

'---------------------------------------------------------------------------------------
'          BESTIMMTES INTEGRAL After THE SIMPSON-REGEL (3-spots-parable)
'---------------------------------------------------------------------------------------
' In leichter Anlehnung on: J.waiter/W.Sokol: technical Gleichungssysteme
' XProfan 11.2a 2014-05 by P. woodpecker, Wien
' No however geartete Gewähr!
'---------------------------------------------------------------------------------------
' The numerisch To integrierende function as FnY with Parameter x! here prompt:  -----

proc FnY :parameters x!

    declare fny!
    ' to that Error-intercepting Magic-worth -99999999999999 (- 14*'9') give back!
    ' case x!=0:return -99999999999999
    '       FnY! = 1/x! '... verträgt z.B. no zero in the denominator!
    ' ORIGINALE TESTFUNKTION:
    FnY! = 4/(1+sqr(x!))' Originale Testfunktion, ...
    '       must with Integration between 0 and 1: Pi() yield!
    return FnY!

endproc

'---------------------------------------------------------------------------------------
Main:
 $IFDEF Interpreter
Window Title "Bestimmtes Integral to the Simpson-rule (3-spots-parable)    I n T E R P R E T E R "
 $ENDIF
 $IFDEF Compiler
Window Title "Bestimmtes Integral to the Simpson-rule (3-spots-parable)    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. To integrierende function as Proc FnY :parameters x! einprogrammieren!\n"
Print "    Done ? [ J, j, Y, y ='Yes']: ";: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 the designed 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. ceiling  the designed 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. Number of wander (straight number, 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
' processing (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 the 'defined Integral' the function FNY(x) "
print " (The expanse under the curve) between Xu = ";
print stature$("%g",xu!);"And XO = ";stature$("%g",xo!);","
print " zusammengesetzt from ";int(n&);" wander, totals to Simpson:"
print "\n";tab(55);stature$("%g",Sum!);"\n"
'
' --- appendix for pure Testzwecke, only meaningfully with the originalen FnY-function:

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

    print "                               computer-Pi()          ";pi()
    print " The absolute Error to computer-Pi() totals  ";abs(sum!-pi())
    print " The relative Error to computer-Pi() totals  ";
    print abs(100*(sum!-pi())/pi());" % "

endif

' --------------------------------------------------------------------------------------
'
question:
Print "\n      Nochmal ? [ J, j, Y, y ='Yes']: ";: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