Deutsch
Quelltexte/ Codesnippets

Newton-Raphson gewaltig beschleunigt: STEFFENSEN-Algorithmus

 

p.specht
Wie bei einer hier kubischen Funktion zu erwarten, liefern verschiedene Startwerte drei verschiedene reelle Lösungs-Näherungen im gefordertern Toleranzbereich. Beispiel: Newton-Raphson benötigt 44 Iterationen, Steffensen wegen verbessertem Näherungsalgorithmus nur sieben! Achtung: Goto-Spagetticode Old Style!
WindowTitle "STEFFENSEN-ALGORITHMUS"
'   berechnet implizit die "Biegung" der Funktionskurve, nähert sich exponentiell.
'   NUR FÜR DEMONSTRATIONSZWECKE! Keine Gewähr! No warranties whatsoever!
' Original: 1987 John H Mathews, Californa State Univ.
WindowStyle 24:Font 2
Randomize:CLS Rnd(8^8)
Set("Decimals",15)
Declare DELTA!,EPSILON!,max&,ANS$,P0!,SMALL!,POLD!
Declare K&,COND&,P1!,P2!,p3!,P4!,DF0!,D1!,D2!,DP!,DF1!,Y3!,RELERR!
'*** HIER DIE FUNKTION SOWIE IHRE ABLEITUNG EINPROGRAMMIEREN:
'    FNF (X!) = X!*X!*X! - 3*X! + 2
Def FNF(1)  @!(1)*@!(1)*@!(1) - 3 * @!(1) + 2
'    FNF1(X!) = 3*X!*X! - 3
Def FNF1(1)  3*@!(1)*@!(1) - 3
'***********************************************************
Goto "G52"'skip print subroutine
S30:
' DIE FUNKTION IN KLARTEXT AUSGEBEN:
REM SUBROUTINE PRINT FUNCTION
PRINT "         F(X)  =  X^3 - 3*X + 2  = 0            "
Return
'***********************************************************
G52:
Goto "G100"
G100:
REM PROGRAM STEFFENS
DELTA!  =Val("1E-16")'Relative Fehlergrenze des Parameters
EPSILON!=Val("1E-16")'Ansolute Funktionswert-Toleranz
MAX&=99'Maximale Anzahl an Iterationen
G140:
Gosub "S300": REM SUBROUTINE INPUTS
GOSUB "S400": REM SUBROUTINE STEFFENSEN
GOSUB "S1000":REM SUBROUTINE RESULTS
PRINT
Print
PRINT " ANDEREN STARTWERT PROBIEREN <j/n>? ";
Input ANS$
CaseNot (ANS$="N") Or (ANS$="n"):GOTO "G140"
GOTO "G5000"
S300:
REM SUBROUTINE INPUTS
CLS Rnd(8^8)
PRINT
PRINT " STEFFENSEN'S BESCHLEUNIGUNG DES NEWTON-RAPHSON-ALGORITHMUS "
PRINT "   ZUR NULLSTELLENSUCHE IN EINER (NICHTLINEAREN) FUNKTION   "
PRINT
Gosub "S30"' ZU SUBROUTINE PRINT FUNCTION
PRINT
PRINT " Es wird ein anfänglicher Startwert P0 benötigt:"
PRINT " Gewünschter Startwert P0 = ";
Input P0!
PRINT
RETURN
S400:
REM SUBROUTINE STEFFENSEN
SMALL!=Val("1E-20")
POLD!=P0!
K&=0
COND&=0
P3!=P0!
P2!=P0!+1
P1!=P0!+2

WHILE (K& < MAX&) And (COND& = 0)

    P0!=P3!
    DF0!=FNF1(P0!)

    If DF0!<>0:Goto "G520"

        Else:Goto "G540"

    EndIf

    G520:
    P1!=P0! - FNF(P0!)/DF0!' Newton-Raphson-Schritt
    Goto "G590"
    G540:
    REM ELSE
    COND&=1
    DP!=P3!-P2!
    P3!=P0!
    Goto "G860"
    G590:
    REM ENDIF
    DF1!=FNF1(P1!)

    If  DF1! <>0:Goto "G620"

        Else:Goto "G640"

    EndIf

    G620:
    P2!=P1! - FNF(P1!)/DF1!
    Goto "G690"
    G640:
    REM ELSE
    COND&=1
    DP!=P1!-P0!
    P3!=P1!
    Goto "G860"
    G690:
    REM ENDIF
    D1!=(P1!-P0!)*(P1!-P0!)
    D2!=P2!-2*P1!+P0!

    IF D2!=0:Goto "G730"

        Else:Goto "G770"

    EndIf

    G730:
    COND&=1
    DP!=P2!-P1!
    P3!=P2!
    GOTO "G800"
    G770:
    REM ELSE
    P3!=P0!-D1!/D2!
    DP!=P3!-P2!
    G800:
    REM ENDIF
    Y3!=FNF(P3!)
    RELERR!=Abs(DP!)/(Abs(P3!)+SMALL!)
    Case RELERR! < DELTA!:  COND&=2
    Case  Abs(Y3!) < EPSILON! : COND&=3
    Case  (RELERR!  < DELTA!) And (Abs(Y3!) < EPSILON!) : COND&=4
    G860:
    REM WEITER
    K&=K&+1

ENDWHILE

P0!=POLD!
RETURN
S1000:
REM SUBROUTINE RESULTS
CLS Rnd(8^8)
PRINT
PRINT " STEFFENSEN'S BESCHLEUNIGUNG DES NEWTON-RAPHSON-ALGORITHMUS "
PRINT "   ZUR NULLSTELLENSUCHE IN EINER (NICHTLINEAREN) FUNKTION   "
PRINT
Gosub "S30"'PRINT-SUBROUTINE
PRINT
PRINT " Der Startwert war P0 =",P0!
PRINT
PRINT " Nach "+Trim$(Str$(K&))+" Iterationen Quasi-Nullwert gefunden bei:"
Print : Print
Print "    P =",P3!
Print : Print
PRINT "  DP  =",ABS(DP!)," ist seine relative Genauigkeit."
PRINT
Print "  F(";Trim$(Str$(P3!));") =",FNF(P3!)
PRINT
Case FNF(P3!)=0  : PRINT "  Berechnete Funktion ergab GENAU NULL! "

If COND&=0:Goto "G1200"

    Else:Goto "G1240"

EndIf

PRINT "  Die Konvergenz des Verfahrens ist zweifelhaft. Begründung:"
PRINT
G1220:
PRINT "  Maximale Iterationszahl überschritten!"
Goto "G1400"
G1240:
REM ELSEIF

If COND&=1:Goto "G1260"

    Else:Goto "G1280"

EndIf

G1260:
PRINT "  Verfahrenskonvergenz zweifelhaft, da Division durch Null."
Goto "G1400"
G1280:
REM ELSEIF

IF  COND&=2:Goto "G1300"

    Else:Goto "G1320"

EndIf

G1300:
PRINT "  Lösung innerhalb der programmierten Toleranzen."
Goto "G1400"
G1320:
REM ELSEIF

If COND&=3:Goto "G1340"

    Else:Goto "G1360"

EndIf

G1340:
PRINT "  Funktionswert F(P) innerhalb der Toleranzgrenzen."
Goto "G1400"
G1360:
REM ELSEIF

If  COND&=4:Goto "G1380"

    Else: Goto "G1400"

EndIf

G1380:
PRINT "  Der Parameter-Wert  P und der Funktionswert F(P) "
PRINT "  liegen beide in den programmierten Toleranzen.       "
G1400:
REM ENDIF
Return
G5000:
END
 
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen...
vor 4 Tagen  
 



Zum Quelltext


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

32 Betrachtungen

Unbenanntvor 0 min.
Manfred BareiGestern (22:43)
Peter Max MüllerGestern (06:42)
Roland SchäfferVorgestern (07:00)
Jürgen Strahl vor 3 Tagen
Mehr...

Themeninformationen

Dieses Thema hat 1 Teilnehmer:

p.specht (1x)


Admins  |  AGB  |  Anwendungen  |  Autoren  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Händlerportal  |  Impressum  |  Mart  |  Schnittstellen  |  SDK  |  Services  |  Spiele  |  Suche  |  Support

Ein Projekt aller XProfaner, die es gibt!


Mein XProfan
Private Nachrichten
Eigenes Ablageforum
Themen-Merkliste
Eigene Beiträge
Eigene Themen
Zwischenablage
Abmelden
 Deutsch English Français Español Italia
Übersetzungen

Datenschutz


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie