XProfan

English

p.specht

for a function 3. Grades needed the take action to R. Brent [1973] only 8 Durchgänge, circa on 16-stellige accuracy To come. though are Voraussetzungen To erfüllen: The Anfangswerte should different omen having. moreover must one already something Idea having, How the Funktionsgraph about looks. there the follow up Program here only a Error Message abgibt, itself means not (as Profi-programs) yourself on The Search to suitable Values begibt, deals it itself first once only circa a Prinzipstudie. still functions the principle but very well!

Compile Mark Separation

Window Title "Prinzipstudie: Nichtlineare Gleichung numerisch solve to Brent [1973]"
Window Style 24:CLS:font 2
declare c0!,c1!,c2!,c3!,c4!,c5!,x!,a!,b!,c!,d!,e!,tol!,fa!,fb!,fc!
declare iter&,maxiter&,eps!,m!,r!,s!,t!,p!,q!,xs!
'Funktionstyp the To lösenden Gleichung (here:Polynom max. 5.Grades)

proc f :parameters x!

    return c0!+x!*c1!+x!*x!*c2!+x!*x!*x!*c3!+x!*x!*x!*x!*c4!+x!*x!*x!*x!*x!*c5!

endproc

'Funktionsparameter: Testfunktion is here of strain 3 = Kubische parable
c0!=-5
c1!=8.17
c2!=-1.894
c3!=.114
c4!=0
c5!=0
'desired accuracy (max. 15 signifikannte to put):
eps!=val("1e-16")
maxiter&=1000
t!=0'small additive Constant (nnur with very difficult functions)
'Suchbereich 1:
print "\n Test-Sollwerte: ",6.208317, 9.67556
a!=6
b!=7
BRENT :Waitinput 1000
a!=7
b!=10
BRENT :beep:Waitinput
END

Proc BRENT

    Declare x!, c!,d!,e!,tol!,fa!,fb!,fc!
    Declare iter&,m!,r!,s!,p!,q!,xs!
    print "\n\n into border ";stature$("%g",a!),"bis",stature$("%g",b!);" get found:"
    fa!=f(a!)
    fb!=f(b!)

    if (fa!*fb!)>0

        print "\n ERROR: f(a) and f(b) should different omen haben"
        beep:waitinput:end

    endif

    c!=a!:fc!=fa!' To Beginn is c = a
    d!=b!-a!
    e!=d!
    iter&=0

    while iter&<maxiter&

        iter&=iter&+1

        if (fb!*fc!)>0

            c!=a!:fc!=fa!:d!=b!-a!:e!=d!

        endif

        if abs(fc!)<abs(fb!)

            a!=b!:b!=c!:c!=a!
            fa!=fb!: fb!=fc!: fc!=fa!

        endif

        tol!=2*eps!*abs(b!)+t!'tolerance
        m!=(c!-b!)/2

        if (abs(m!)>tol!) AND (abs(fb!)>0)' take action must yet implemented go

            if (abs(e!)<tol!) OR (abs(fa!)<=abs(fb!))

                d!=m!:e!=m!

            else

                s!=fb!/fa!

                if a!=c!

                    p!=2*m!*s!
                    q!=1-s!

                else

                    q!=fa!/fc!
                    r!=fb!/fc!
                    p!=s!*(2*m!*q!*(q!-r!)-(b!-a!)*(r!-1))
                    q!=(q!-1)*(r!-1)*(s!-1)

                endif

                if p!>0

                    q!=-q!

                else

                    p!=-p!

                endif

                s!=e!
                e!=d!

                if ( (2*p!)<(3*m!*q!-abs(tol!*q!)) ) AND (p!<abs(s!*q!/2))

                    d!=p!/q!

                else

                    d!=m!
                    e!=m!

                endif

            endif

            a!=b!
            fa!=fb!

            if abs(d!)>tol!

                b!=b!+d!

            else

                if m!>0

                    b!=b!+tol!

                else

                    b!=b!-tol!

                endif

            endif

        else

            break

        endif

        fb!=f(b!)

    endwhile

    xs!=b!
    print "\n Nullwurzel: ";stature$("%g",xs!)," with "
    print "\n Restfehler: ";stature$("%g",fb!)," found in ";iter&;" Durchgängen."

Endproc