Español
Fuente/ Codesnippets

Matrixinversion mittels Gauss-Jordan-Algorithmus

 

p.specht

Der Alemán Mathematiker Jordan erweiterte el Gauß'schen Eliminationsalgorithmus a Erzeugung de Nullen no sólo bajo, pero auch oberhalb el Hauptdiagonale. Besonders elegant se ser Verfahren, si zusätzlich ...
1. el Matrizen vorab en numerische Stabilität y Invertierbarkeit geprüft voluntad ("Explosionsschutz"),
2. en el Fall de Nullelementen el aktuelle Spalte gegen jene con el Pivotelement el Línea vertauscht se (Pivot= Angelpunkt, d.i. el Element con el maximalen Absolutbetrag),
3. en lugar de unnötigem "Division por Null"-Fehlerabbruch el Rechner-Underflow-Grenzwert errechnet y en lugar de el Null eingesetzt se, sodaß en el Ergebnis allenfalls "Rechnerunendlich" auftaucht, qué immerhin todavía el Chance el Ablesen uno analytischen Lösungsgleichung ergibt.
4. el Ganze incluso "in Place", also sin más Speicherplatz en el RAM, tener lugar podría. Diesbezüglich besteht also todavía Verbesserungspotential.
Título de la ventana "Gauss-Jordan Matrix-Inversion"
' Quelle: https://www.cs.berkeley.edu/~wkahan/MathH110/gji.pdf
' Aus IBM BASIC traducido después de XProfan 11.2a, P. Pájaro carpintero 2012-04
' Ausschließlich para Demo-Zwecke, no Gewähr!
' Verwendung samt y sonders en Risiko des Anwenders!!!
' Enthält Überprüfungen en exzessives Wachstum trotz Spaltenpivotierung.
' y una Anpassung a Vermeidung de Nullen como Pivotelemente.
Ventana 0,0 - %maxx,%maxy-52
Font 2:Selección aleatoria:Cls Rnd(8^8)
set("decimals",6):set("numwidth",16)
Var n&=5' Für Testmatrix nötige Maximale Zeilen- o. Spaltenzahl
Declarar A![N&,N&],X![N&,N&],P![N&]
A![1,1]=1   :A![1,2]=0   :A![1,3]=0    :A![1,4]=0  :A![1,5]=0
A![2,1]=2   :A![2,2]=1   :A![2,3]=0    :A![2,4]=0  :A![2,5]=0
A![3,1]=3   :A![3,2]=2   :A![3,3]=1    :A![3,4]=0  :A![3,5]=0
A![4,1]=0   :A![4,2]=0   :A![4,3]=0    :A![4,4]=1  :A![4,5]=0
A![5,1]=0   :A![5,2]=0   :A![5,3]=0    :A![5,4]=0  :A![5,5]=1
n&=3' Diese Zeilen/Spaltenzahl hier se tatsächlich verwendet voluntad
MatrInvs n&
Show n&
WaitInput
End

proc Show

    parámetros n&
    declarar i&,j&
    Imprimir " X = "

    WhileLoop n&:i&=&Loop

        WhileLoop n&:j&=&Loop

            imprimir X![i&,j&],

        Endwhile

        imprimir

    Endwhile

    imprimir

ENDPROC

Proc MatrInvs :parámetros n&

    Declarar UFL!,EPS!,G!,P!,Q!,T!,i&,j&,k&,l&,m&
    ' I a N son Ganzzahlvariablen, el otro Doubleprecision Floats!
    ' Vorab se el Rundungsfehler sowie Over- y Underflow-Valor festgelegt.
    UFL! = val("5.9E-39")'...= max{underflow,1/overflow}-Grenzwerte.
    G!=4 : G!=G!/3 : G!=G!-1' ... = 1/3 + Rundungswert en 4/3
    EPS! = ABS( ((G!+G!) - 1) + G! )' ... = Rundungspegel
    G! = 1'Neue Verwendung de G:
    ' G características nun Wachstumsrate des Pivotelementes en!
    ' Kopiere Matrix A en X y speichere el betragsgrößte Argument el Spalte.
    ' ACHTUNG: In siempre-el-selben Spalte se gesucht, en el el Zeilenindex se ejecuta!!!

    WhileLoop n&:j&=&Loop

        P![J&]=0

        WhileLoop n&:i&=&Loop

            T! = A![I&,J&]
            X![I&,J&] = T!
            T! = ABS(T!)
            Case T! > P![J&] : P![J&] = T!

        EndWhile

    EndWhile

    ' El P![Zeilenindex] beinhalten jew. el größten Betrag dieser Spalte

    WhileLoop n&:k&=&Loop' ... Elimination en Línea k

        Q!=0
        J&=K&'Annahme: Pivotzeile en Diagonale, por lo tanto igual Spalte
        ' Búsqueda de & unterhalb k. Spalte el Pivot (Betragsmaximum)

        WhileLoop k&,n&,1:i&=&Loop

            T!=ABS(X![I&,K&])

            if T!>Q!

                Q!=T!
                J&=I&' J speichert offenbar el Línea con el Pivot
                'ACHTUNG FEHLERQUELLE: IBM-Basic if: Das 'then : : ´' bezieht se en todos : : !!!

            endif

        EndWhile

        if Q!=0

            Q!=EPS!*P![K&]+UFL!
            X![K&,K&]=Q!

        endif

        if P![K&]>0

            Q!=Q!/P![K&]

            if Q!>G!

                G!=Q!

            endif

        endif

        Case G!<=(8*K&):Goto "OK"
        PRINT "Wachstumsfaktor g = ";G!;" va encima Alarmgrenze ";8*K
        PRINT "Versuchen Sie, Spalte ";k&;" de A como Spalte 1 a conjunto!"
        FIN' ... eventuell hilft una otro Umordnung el Spalten de A.
        OK:
        P![k&]=j&' ... speichere el gefundene Pivot-Línea el Spalte k.
        ' ...el P![]-Array es ahora frei dafür, por qué also no trotz Float uso...
        Case J&=K& : GOTO "Skip"' como vertauschen con se incluso sinnlos.

        WhileLoop n&:L&=&Loop

            Q!=X![J&,L&]
            X![J&,L&]=X![K&,L&]
            X![K&,L&]=Q!

        EndWhile

        Skip:
        Q! = X![K&,K&]
        X![K&,K&] = 1

        WhileLoop n&:j&=&Loop

            X![K&,J&] = X![K&,J&]/Q!

        EndWhile

        WhileLoop n&:i&=&Loop

            Case I&=K&:Continue
            Q!=X![I&,K&]
            X![I&,K&]=0

            WhileLoop n&:j&=&Loop

                X![I&,J&] = X![I&,J&] - X![K&,J&] * Q!

            EndWhile

        EndWhile

    EndWhile

    WhileLoop n&-1,1,-1:k&=&Loop

        ' ... Rücktausch el Spalten de X
        J&=P![K&]
        Case J&=K&:Continue

        WhileLoop n&:i&=&Loop

            Q!=X![I&,K&]
            X![I&,K&]=X![I&,J&]
            X![I&,J&]=Q!

        EndWhile

    EndWhile

ENDPROC

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



Zum Quelltext


Título del Tema, max. 100 Signo.
 

Systemprofile:

Kein Systemprofil creado. [anlegen]

XProfan:

 Contribución  Font  Smilies  ▼ 

Bitte registro en una Contribución a verfassen.
 

Tema opciones

638 Views

Untitledvor 0 min.
N.Art01.08.2021
Ernst21.07.2021
p.specht18.07.2021
Glubbfan19.06.2021
Más...

Themeninformationen

Dieses Thema ha 1 subscriber:

p.specht (1x)


Admins  |  AGB  |  Applications  |  Autores  |  Chat  |  Política de Privacidad  |  Descargar  |  Entrance  |  Ayuda  |  Merchantportal  |  Pie de imprenta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Juegos  |  Búsqueda  |  Support

Ein Projekt aller XProfan, el lo son!


Mi XProfan
Privado Noticias
Eigenes Ablageforum
Temas-Merkliste
Eigene Beiträge
Eigene Temas
Zwischenablage
Cancelar
 Deutsch English Français Español Italia
Traducciones

Política de Privacidad


Wir uso Cookies sólo como Session-Cookies wegen el technischen Notwendigkeit y en uns hay no Cookies de Drittanbietern.

Wenn du hier en unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung de Informationen en unseren Cookies en XProfan.Net a.

Weitere Informationen a unseren Cookies y dazu, como du el Kontrolle darüber behältst, findest du en unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Yo möchte no Cookie