XProfan

Español

p.specht

En rechnerischen Solución uno u.U. muy komplizierten Gleichung 'F(x)=Vorgabewert', also el Búsqueda all jener x-Werte, en denen esta Gleichung erfüllt o. 'wahr' es, ordnet uno üblicherweise el Gleichung en a f(x) minus Vorgabewert = 0, y sucht después de el Nullstellen des y-Funktionswertes. Das BISECTION(Unterteilungs)-Verfahren war esta uno el allerersten erfolgreich angewendeten Computeralgorithmen, y ha se a heute como muy robuste Método bewährt, se heißen: Das Verfahren liefert - abhängig vom angebenen Suchbereich - con Sicherheit genau una exakten Nulldurchgang el Función como Solución, si una solche Solución existiert.

Weiterer Vorteil: El gefundenen Lösungen gelten como "technisch stabil". Diese Stabilität se de Sicht el Mathematik-Puristen allerdings duch una Nachteil erkauft: Lo voluntad sólo Lösungen gefunden, el el x-Achse tatsächlich schneiden, also en el Nähe el Lösungspunkte sowohl positive como auch negative y-Achsenwerte besitzen. Mit otro Worten: Der Algorithmus kann no Lösungen ermitteln, el por bloße Berührung el x-Achse sólo de oben oder sólo de unten gegeben wären. In solchen Fällen wäre Verfahren como "Regula falsi" oder "Newton-Raphson" geeigneter, beide haben allerdings auch otra vez ihre Vor- y Nachteile.

Referencia: El Urheberrechte mentira en ACM; hier wurde sólo el Portierbarkeit después de XProfan demonstriert. Ohne jede Gewähr por lo tanto:

Kompilieren Marca Separación

' ACM TOMS Algorithm 4 'BISECTION'
'{Depending on 4 start parámetros, BISEC finds one x where Function y=F(x)=0
' Original Fortran Source by S. Gorn from https://www.netlib.org/toms/4.gz
' (C) Feb.1960 by ACM-TOMS Association of Computing Machinery
' ----------------------------------------------------------------------------
' (D) Demo-Migration to XProfan-11.2a en 2014-11 by P.Pájaro carpintero, Vienna (Austria)
' Lo bestehen Urheberrechte Dritter! No Warranty Whatsoever! Ohne jede Gewähr!
' ----------------------------------------------------------------------------
' Description (F99): Date: Sun, 12 Feb 95 18:54:30 +0000
' Here is a transcription of algorithm #4 from Collected Algorithms
' from ACM. I had to modify some characters to make it fit into ASCII,
' specially the multiplicative operator has become * and greek letters
' are substituted by their equivalent names.
'         Jose R. Valverde, European Bioinformatics Institute, txomsy@ebi.ac.uk
' ------------------------------------------------------------------------------
' Original Algorithm 4: BISECTION ROUTINE
' by S. Gorn, Univeristy of Pennsylvania Computer Center, Philadelphia, Pa.
' ------------------------------------------------------------------------------
' Comment: This procedure evaluates a function at the end-points
' 	of a real interval, switching to a error exit (fools
' 	exit) FLSXT if there is no change of sign. Otherwise
' 	it finds a root by iterated bisection and evaluation
' 	at the midpoint, halting if either the value of the
' 	function is less than the free variable epsilon, or two
' 	successive approximations of the root differ by less
' 	than epsilon1. Epsilon should be chosen of the order of
' 	error en evaluating the function (otherwise time would be
' 	wasted), and epsilon1 of the order of desired accuracy.
' 	Epsilon1 must not be less than two units en the last place
' 	carried by the machine or más indefinite cycling voluntad
' 	occur due to roundoff on bisection. Although this
' 	method is of 0 order, and therefore among the slow-
' 	est, it is applicable to any continuous function. The
' 	fact that no differentiability conditions have to be
' 	checked makes it, therefore, a 'old work-horse'
' 	among routines for finding real roots which have
' 	already been isolated. The free varaibles y1 and y2
' 	are (presumably) the end-points of a interval within
' 	which there is a odd number of roots of the real function F.
' 	Alpha is the temporary exit fot the evaluation of F.;
'---------------------------------------------------------------
'---------------------------------------------------------------
' CERTIFICATION OF ALGORITHM 4
' BISECTION ROUTINE (S. Gorn, _Comm._ACM_, March 1960), Program by
' Patty Jane Rader,* Argonne National Laboratory, Argonne, Illinois
'
' Bisec qué coded for the Royal Precision LGP-30 computer, using inter-
' pretive floating point system (24.2) with 28 bits of significance.
'
'  The following minor correction qué found necessary.
'	alpha: go to gamma[1] should be go to gamma[i]
' After this correction qué made, the program ran smoothly for
'  F(x) = cos x, using the following parámetros:
'---------------------------------------------------------------
'	y1	 y2	 Epsilon	Epsilon1      Results
'---------------------------------------------------------------
' 0     1	  .001		.001		      FLSXT
' 0	    2	  .001		.001		      1.5703
'	1.5	  2	  .001		.001		      1.5703
'	1.55	2	  .1		  .1		        1.5500
'	1.5	  2	  .001		.1		        1.5625
'---------------------------------------------------------------
' These combinations test all loops of the program.
' *) Work supported by the U. S. Atomic Energy Commission.
'}
'---------------------------------------------------------------
'{TESTPROGRAMM
CLS
Font 2
Conjunto("decimals",15)
imprimir "\n Berechnete Testwerte Por favor, con el en el Kommentar"
imprimir " angegebenen Tabellenresultaten vergleichen: \n"
imprimir "   ";format$("%g",BiSec(0,1,0.001,0.001))
imprimir "   ";format$("%g",BiSec(0,2,0.001,0.001))
imprimir "   ";format$("%g",BiSec(1.5,2,0.001,0.001))
imprimir "   ";format$("%g",BiSec(1.55,2,0.1,0.1))
imprimir "   ";format$("%g",BiSec(1.5,2,0.001,0.1))
Waitinput
FIN
'}-------------------------------------------------------------------------
'Function F(x) HIER EINPORGRAMMIEREN!

proc F :parámetros x!

    volver cos(x!)

ENDPROC

'-------------------------------------------------------------------------
'Bisec Rutina:

proc BISEC :parámetros y1!,y2!,epsilon!,epsilon1!

    declarar x!,f!,f1!,i&,j&,k&,FLSXT!
    FLSXT!=-999999999'bedeutet ERROR, no Nullstelle en diesem Zona
    Bisec:
    i&=1:j&=1:k&=1:x!=y2!
    Alpha:
    f!=F(x!) : caso abs(f!)<=epsilon!:volver x!

    if i&=1:goto "First_val" : elseif i&=2:goto "Succ_val" :endif

        First_val:
        i&=2 : f1!=f! : x!=y1!
        goto "Alpha"
        Succ_val:

        if (f!*f1!)>=0

            if j&=1: Imprimir "Keine Nullstelle en diesem Zona! Error ";:volver FLSXT!

            elseif j&=2: goto "Reg_delta"

            endif

        endif

        if k&=1:goto "Sec_val" : elseif k&=2:goto "Reg_etha" :endif

            Sec_val:
            j&=2:k&=2
            Midpoint:
            x!=(y1!+y2!)/2
            goto "Alpha"
            Reg_delta:
            y2!=x!
            Precision:
            caso (abs(y1!-y2!)>=epsilon1!):goto "Midpoint"
            volver x!
            Reg_etha:
            y1!=x!
            goto "Precision"

        ENDPROC

XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...

16.05.2021 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

p.specht

Michael Wodrich ha una verbesserte Variante vorgestellt:

Sein Kommentar: "... y una zweiter BiSec(t) sin Goto aber con Iterationen-Begrenzer (así no endlos se ejecuta). Beides zusammen gemixt y una Iteration vorher ausgebremst..."

Link: [...]

Kompilieren Marca Separación

' ACM TOMS Algorithm 4 'BISECTION'
'{Depending on 4 start parámetros, BISEC finds one x where Function y=F(x)=0
' Original Fortran Source by S. Gorn from https://www.netlib.org/toms/4.gz
' (C) Feb.1960 by ACM-TOMS Association of Computing Machinery
' ----------------------------------------------------------------------------
' (D) Demo-Migration to XProfan-11.2a en 2014-11 by P.Pájaro carpintero, Vienna (Austria)
' Lo bestehen Urheberrechte Dritter! No Warranty Whatsoever! Ohne jede Gewähr!
' ----------------------------------------------------------------------------
' Description (F99): Date: Sun, 12 Feb 95 18:54:30 +0000
' Here is a transcription of algorithm #4 from Collected Algorithms
' from ACM. I had to modify some characters to make it fit into ASCII,
' specially the multiplicative operator has become * and greek letters
' are substituted by their equivalent names.
'         Jose R. Valverde, European Bioinformatics Institute, txomsy@ebi.ac.uk
' ------------------------------------------------------------------------------
' Original Algorithm 4: BISECTION ROUTINE
' by S. Gorn, Univeristy of Pennsylvania Computer Center, Philadelphia, Pa.
' ------------------------------------------------------------------------------
' Comment: This procedure evaluates a function at the end-points
' 	of a real interval, switching to a error exit (fools
' 	exit) FLSXT if there is no change of sign. Otherwise
' 	it finds a root by iterated bisection and evaluation
' 	at the midpoint, halting if either the value of the
' 	function is less than the free variable epsilon, or two
' 	successive approximations of the root differ by less
' 	than epsilon1. Epsilon should be chosen of the order of
' 	error en evaluating the function (otherwise time would be
' 	wasted), and epsilon1 of the order of desired accuracy.
' 	Epsilon1 must not be less than two units en the last place
' 	carried by the machine or más indefinite cycling voluntad
' 	occur due to roundoff on bisection. Although this
' 	method is of 0 order, and therefore among the slow-
' 	est, it is applicable to any continuous function. The
' 	fact that no differentiability conditions have to be
' 	checked makes it, therefore, a 'old work-horse'
' 	among routines for finding real roots which have
' 	already been isolated. The free varaibles y1 and y2
' 	are (presumably) the end-points of a interval within
' 	which there is a odd number of roots of the real function F.
' 	Alpha is the temporary exit fot the evaluation of F.;
'---------------------------------------------------------------
'---------------------------------------------------------------
' CERTIFICATION OF ALGORITHM 4
' BISECTION ROUTINE (S. Gorn, _Comm._ACM_, March 1960), Program by
' Patty Jane Rader,* Argonne National Laboratory, Argonne, Illinois
'
' Bisec qué coded for the Royal Precision LGP-30 computer, using inter-
' pretive floating point system (24.2) with 28 bits of significance.
'
'  The following minor correction qué found necessary.
'	alpha: go to gamma[1] should be go to gamma[i]
' After this correction qué made, the program ran smoothly for
'  F(x) = cos x, using the following parámetros:
'---------------------------------------------------------------
'	y1	 y2	 Epsilon	Epsilon1      Results
'---------------------------------------------------------------
' 0     1	  .001		.001		      FLSXT
' 0	    2	  .001		.001		      1.5703
'	1.5	  2	  .001		.001		      1.5703
'	1.55	2	  .1		  .1		        1.5500
'	1.5	  2	  .001		.1		        1.5625
'---------------------------------------------------------------
' These combinations test all loops of the program.
' *) Work supported by the U. S. Atomic Energy Commission.
'}
'---------------------------------------------------------------
'{TESTPROGRAMM
CLS
Font 2
Conjunto("decimals",15)
imprimir "---------------------------------------------------------------"
imprimir Tab(2);"y1";  Tab(8);"y2";Tab(12);"Epsilon";Tab(21);"Epsilon1";Tab(31);"Results"
imprimir "---------------------------------------------------------------"
imprimir Tab(2);"0";   Tab(8);"1"; Tab(12);".001";   Tab(21);".001";    Tab(31);"FLSXT"
imprimir Tab(2);"0";   Tab(8);"2"; Tab(12);".001";   Tab(21);".001";    Tab(31);"1.5703"
imprimir Tab(2);"1.5"; Tab(8);"2"; Tab(12);".001";   Tab(21);".001";    Tab(31);"1.5703"
imprimir Tab(2);"1.55";Tab(8);"2"; Tab(12);".1";     Tab(21);".1";      Tab(31);"1.5500"
imprimir Tab(2);"1.5"; Tab(8);"2"; Tab(12);".001";   Tab(21);".1";      Tab(31);"1.5625"
imprimir "---------------------------------------------------------------"
imprimir "\n Berechnete Testwerte Por favor, con el obigen"
imprimir " Tabellenresultaten vergleichen: \n"
imprimir format$("   BiSec(0,    1, .001, .001) = %g",BiSec(0,1,0.001,0.001))
imprimir format$("   BiSec(0,    2, .001, .001) = %g",BiSec(0,2,0.001,0.001))
imprimir format$("   BiSec(1.5,  2, .001, .001) = %g",BiSec(1.5,2,0.001,0.001))
imprimir format$("   BiSec(1.55, 2, .1,   .1  ) = %g",BiSec(1.55,2,0.1,0.1))
imprimir format$("   BiSec(1.5,  2, .001, .1  ) = %g",BiSec(1.5,2,0.001,0.1))
imprimir "---------------------------------------------------------------"
imprimir format$("   BiSect(0,    1, .001, .001) = %g",BiSect(0,1,0.001,0.001))
imprimir format$("   BiSect(0,    2, .001, .001) = %g",BiSect(0,2,0.001,0.001,9))
imprimir format$("   BiSect(1.5,  2, .001, .001) = %g",BiSect(1.5,2,0.001,0.001))
imprimir format$("   BiSect(1.55, 2, .1,   .1  ) = %g",BiSect(1.55,2,0.1,0.1))
imprimir format$("   BiSect(1.5,  2, .001, .1  ) = %g",BiSect(1.5,2,0.001,0.1))
Waitinput
FIN
'}-------------------------------------------------------------------------
'Function F(x) HIER EINPORGRAMMIEREN!

proc F :parámetros x!

    volver cos(x!)

ENDPROC

'-------------------------------------------------------------------------
'Bisec Rutina:

proc BISEC :parámetros y1!,y2!,epsilon!,epsilon1!

    declarar x!,f!,f1!,i&,j&,k&,FLSXT!,ii&
    FLSXT!=-999999999'bedeutet ERROR, no Nullstelle en diesem Zona
    Bisec:
    i&=1:j&=1:k&=1:x!=y2!:ii&=0
    Alpha:
    inc ii&':: imprimir "(";ii&;")";
    f!=F(x!) : caso abs(f!)<=epsilon!:volver x!

    if i&=1:goto "First_val" : elseif i&=2:goto "Succ_val" :endif

        First_val:
        i&=2 : f1!=f! : x!=y1!
        goto "Alpha"
        Succ_val:

        if (f!*f1!)>=0

            if j&=1: Imprimir "\nKeine Nullstelle en diesem Zona! Error\n";:volver FLSXT!

            elseif j&=2: goto "Reg_delta"

            endif

        endif

        if k&=1:goto "Sec_val" : elseif k&=2:goto "Reg_etha" :endif

            Sec_val:
            j&=2:k&=2
            Midpoint:
            x!=(y1!+y2!)/2
            goto "Alpha"
            Reg_delta:
            y2!=x!
            Precision:
            caso (abs(y1!-y2!)>=epsilon1!):goto "Midpoint"
            volver x!
            Reg_etha:
            y1!=x!
            goto "Precision"

        ENDPROC

        '-------------------------------------------------------------------------
        'Bisec Rutina con NMAX:

        Proc BiSect

            Declarar float y1,y2,epsilon,epsilon1, long Durchlaeufe

            If %PCount = 5

                Parámetros float y1_5,y2_5,e_5,e1_5, long NMAX
                y1 = y1_5 : y2 = y2_5 : epsilon = e_5 : epsilon1 = e1_5 : Durchlaeufe = NMAX

            Más

                Parámetros float y1_4,y2_4,e_4,e1_4
                y1 = y1_4 : y2 = y2_4 : epsilon = e_4 : epsilon1 = e1_4 : Durchlaeufe = 100

            EndIf

            Declarar float x,f0,f1
            Var long Iterationen = 0
            Var float KEINENULL = -999999999.0' bedeutet FEHLER; no Nullstelle en diesem Zona
            Var int First = 1
            x = y2

            Repeat

                Inc Iterationen':: imprimir "(";Iterationen;")";
                f0 = F(x)' hier se el Función aufgerufen
                Case Abs(f0) <= epsilon : Volver x

                If Iterationen > 1

                    If (f0 * f1) >= 0

                        If First

                            Imprimir "\nKeine Nullstelle en diesem Zona! FEHLER"
                            Volver KEINENULL

                        EndIf

                        y2 = x
                        Case (Abs(y1 - y2) < epsilon1): Volver x

                    Más

                        Caso negativo First

                            y1 = x
                            Case (Abs(y1 - y2) < epsilon1): Volver x

                        Más

                            Dec First

                        EndIf

                    EndIf

                    Case (Iterationen < Durchlaeufe) : x = (y1 + y2) / 2

                Más

                    ' el erste Durchlauf
                    f1 = f0
                    x = y1

                EndIf

            Until Iterationen >= Durchlaeufe

            Imprimir "\nZu viele Durchläufe! (";Durchlaeufe;" son erlaubt)"
            Volver x

        ENDPROC

Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...

16.05.2021 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

p.specht

Andere Umsetzung, de todavía früher:

Kompilieren Marca Separación

Windowtitle "Bisection-Algorithmus"
'Q: Fortran-IV Source de 1962, después de XProfan portiert 2015-05 by PS
Cls:Font 2:randomize:AppendMenubar 200,\
"Eingabeln uno Nullstelle por Unterschiedliche_Vorzeichen-Regel"

Proc Fn :Parámetros fn&,x!:Declarar y!

    Select fn&

        caseof 0: y!=sqr(x!)+exp(x!)-2

        caseof 1: y!=cos(x!)

        caseof 2: y!=3-sin(x!)

        caseof 3: y!=40-exp(x!)

        caseof 4: y!=10

        Otherwise : y!=rnd(1000)
        Endselect :Volver y!

    ENDPROC

    Proc ShowFn :Parámetros fn& :declarar y$

        Select fn&

            caseof 0: y$="y=sqr(x)+exp(x)-2"

            caseof 1: y$="y=cos(x)"

            caseof 2: y$="y=3-sin(x)"

            caseof 3: y$="y=40-exp(x)"

            caseof 4: y$="y=10"

            Otherwise : y$="y=Undefined "
            Endselect :volver y$

        ENDPROC

        Proc Bisect

            ' Den Vorzeichenwechsel eingabeln
            Parámetros fn&,xl!,xr!,epsx!,epsy!
            Declarar yl!,ym!,yr!,xm!
            yl!=Fn(fn&,xl!)

            Repeat

                xm!=(xl!+xr!)*0.5
                ym!=Fn(fn&,xm!)
                caso (abs(ym!)-epsy!)<=0:BREAK

                if (yl!*ym!)<0: xr!=xm!

                elseif (yl!*ym!)=0:BREAK

                    más : xl!=xm!

                endif

            Until 0

            Volver xm!

        ENDPROC

        '---------------------------------------------------------------
        'Hauptprogramm
        declarar fn&,x1!,y1!,x2!,y2!,epsx!,epsy!,fakt!
        '---------------------------------------------------------------
        ' Erfolgs- y performanzkritische Parámetro!:
        fn&=0'... Testfunktionsnummer
        epsx!=val("1e-16")
        epsy!=val("1e-16")'...Suchgenauigkeit
        x1!=0 : x2!=0.1'... Startintervall
        fakt!= -1.2'... klappt en y vergrößert Suchbereich
        '---------------------------------------------------------------
        'Eingabeln:
        y1!=Fn(fn&,x1!)
        H1:
        y2!=Fn(fn&,x2!)
        caso (y1!*y2!)<0:goto "H4"
        caso (y1!*y2!)=0:goto "H5"
        '>0:' gleiche Vorzeichen ==> Zona erweitern por ...
        H2:
        x2!=x2!*fakt!'Vergrößerung y Spiegelung a 0-Punkt
        caso abs(x2!)<val("1.1e35"):goto "H1"
        H3:
        Imprimir " Sorry, no Nullstelle gefunden!":goto "H6"
        H4:
        x2!=Bisect(fn&,x1!,x2!,epsx!,epsy!)
        Imprimir "\n Nullstelle el Función  ";upper$(ShowFn(Fn&));"\n"
        Imprimir " gefunden en x = ";format$("%g",x2!);"\n"
        Imprimir " Nullprobe:   y = ";format$("%g",Fn(fn&,x2!));"\n"
        Imprimir " ----------------------------------------------------------"
        H6:
        waitinput
        FIN