XProfan

Window Title "Regula falsi: Nullstellensuche over Sekanten-Abschnitte"
' abbot. "Historische Algorithmen"
' (D) Demoware May 2012 P. Specht; without jedwede Gewähr!!!
' Gleichungslösung through "Herantasten", Indikator: Fehlerkurvenanstieg
' uses here straight The proc Formel_1
' Startwert is Responsible, To which individual Solution
' of ggf. several Solutions the Algorithmus each tendiert
Font 2:Randomize:Cls rnd(8^8):set("decimals",18)
Declare a!,x!,i&
Var imax&=1000' Maximale number Näherungsschritte
Begin:
print "\n Startwert for Lösungssuche (critically!): ";
input a!
x!=regulafalsi(a!)

if x!=val("4.9406564584124654E-323")

    print " Solution to ";imax&;" stepped not found!"

else

    print " Solution:   x = ";x!
    print " found to ";i&;" stepped."
    print " Funktionswert: ";formel_1(x!)'formel_0(x!)

endif

WaitInput
case %csrlin>22:cls
goto "Begin"

proc regulafalsi

    parameters a!' Startwert
    var it!=10^-13
    Declare x0!,x1!,x2!,y0!,y1!
    x2!=a!
    x1!=a!+0.1' should only same To Beginn Division through zero avoid
    i&=0

    while i&<=imax&

        x0!=x1!:x1!=x2!' next generation preparing
        rem y0!=formel_0(x0!) : y1!=formel_0(x1!)' Testfunktion parable
        y0!=formel_1(x0!) : y1!=formel_1(x1!)' Polynom 3. Grades

        if (y1!-y0!)<>0

            x2! = x0! - y0! * (x1!-x0!) / (y1!-y0!)

        else

            print " warning: take action watts instabil!"
            break

        endif

        case abs(x2!-x1!)<=it!:break
        inc i&

    endwhile

    'with Error: x2 = -INF + 1e-307 =
    'kleinstmöglicher DoublePrecision Floatwert<>0
    case i&>imax&:x2!=val("4.9406564584124654E-323")
    return x2!

endproc

proc Formel_0

    parameters x!
    declare y!
    '---------------------------------------------------------------
    ' Formel before always on homogene shape bring:  ... = 0
    ' Ges: Solution To  x^2 = +4 , becomes means (both pages: - 4) To:
    y!=x!*x! - 4' with y = deviation of 0 (Irrtumsvariable)
    ' Verfahrensziel: Search ex Startwert a one x, the y To zero power
    ' Tipp for Schnittpunkt 2it functions: Differenzfunktion form!
    '---------------------------------------------------------------
    return y!

ENDPROC

proc Formel_1

    parameters x!
    declare y!
    '-------------------------------------
    ' To solve: x^3-2*x^2+12*x = 100
    y!=x!*x!*x!-2*x!*x!+12*x!-100' = 0
    '-------------------------------------
    return y!

ENDPROC