XProfan

Français

p.specht

l'Allemand Mathematiker Jordan Avancé den Gauß'schen Eliminationsalgorithmus à Erzeugung de Nullen pas seulement sous, mais aussi au-dessus de qui Hauptdiagonale. Besonders elegant sera procéder, si zusätzlich ...
1. qui Matrizen vorab sur numerische Stabilität et Invertierbarkeit geprüft volonté ("Explosionsschutz"),
2. im le cas de Nullelementen qui aktuelle Spalte vers celui-là avec dem Pivotelement qui la ligne vertauscht wird (Pivot= Angelpunkt, d.i. cela Element avec dem maximalen Absolutbetrag),
3. statt unnötigem "Division par Null"-Fehlerabbruch qui calculateur-Underflow-Grenzwert errechnet et statt qui zéro eingesetzt wird, si im Ergebnis allenfalls "Rechnerunendlich" auftaucht, quoi immerhin encore qui chance sur cela Ablesen einer analytischen Lösungsgleichung ergibt.
4. cela Ganze sogar "in Place", alors sans weiteren Speicherplatz im RAM, avoir lieu pourrait. Diesbezüglich besteht alors encore Verbesserungspotential.

Kompilieren Marque Séparation

Titre de la fenêtre "Gauss-Jordan Matrix-Inversion"
' source: https://www.cs.berkeley.edu/~wkahan/MathH110/gji.pdf
' Aus IBM BASIC traduit pour XProfan 11.2a, P. Specht 2012-04
' Ausschließlich pour Demo-Zwecke, aucun Gewähr!
' Verwendung velours et sonders sur Risiko des Anwenders!!!
' Enthält Überprüfungen sur exzessives croissance trotz Spaltenpivotierung.
' et une Anpassung zur Vermeidung de Nullen comme Pivotelemente.
Fenêtre 0,0 - %maxx,%maxy-52
Font 2:Randomiser:Cls Tour(8^8)
set("decimals",6):set("numwidth",16)
Var n&=5' Pour Testmatrix nötige Maximale Zeilen- bzw. Spaltenzahl
Déclarer 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' cet Zeilen/Spaltenzahl ici soll réellement verwendet volonté
MatrInvs n&
Show n&
WaitInput
Fin

proc Show

    parameters n&
    declare i&,j&
    Imprimer " X = "

    WhileLoop n&:i&=&Boucle

        WhileLoop n&:j&=&Boucle

            imprimer X![i&,j&],

        Endwhile

        imprimer

    Endwhile

    imprimer

endproc

Proc MatrInvs :parameters n&

    Déclarer UFL!,EPS!,G!,P!,Q!,T!,i&,j&,k&,l&,m&
    ' I jusqu'à N sommes Ganzzahlvariablen, qui anderen Doubleprecision Floats!
    ' Vorab wird qui Rundungsfehler sowie Over- et Underflow-Wert festgelegt.
    UFL! = val("5.9E-39")'...= max{underflow,1/overflow}-Grenzwerte.
    G!=4 : G!=G!/3 : G!=G!-1' ... = 1/3 + Rundungswert sur 4/3
    EPS! = ABS( ((G!+G!) - 1) + G! )' ... = Rundungspegel
    G! = 1'Neue Verwendung de G:
    ' G zeichnet eh bien taux de croissance des Pivotelementes sur!
    ' Kopiere Matrix A sur X et speichere cela betragsgrößte Argument qui Spalte.
    ' ACHTUNG: dans toujours-qui-selben Spalte wird gesucht, dans dem qui Zeilenindex fonctionne!!!

    WhileLoop n&:j&=&Boucle

        P![J&]=0

        WhileLoop n&:i&=&Boucle

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

        Endwhile

    Endwhile

    ' qui P![Zeilenindex] beinhalten jew. den größten Betrag cette Spalte

    WhileLoop n&:k&=&Boucle' ... Elimination dans la ligne k

        Q!=0
        J&=K&'Annahme: Pivotzeile dans Diagonale, daher juste Spalte
        ' cherche ab & unterhalb k. Spalte cela Pivot (Betragsmaximum)

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

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

            si T!>Q!

                Q!=T!
                J&=I&' J speichert évident qui la ligne avec dem Pivot
                'ACHTUNG FEHLERQUELLE: IBM-Basic si: cela 'then : : ´' bezieht sich sur alle : : !!!

            endif

        Endwhile

        si Q!=0

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

        endif

        si P![K&]>0

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

            si Q!>G!

                G!=Q!

            endif

        endif

        Cas G!<=(8*K&):Goto "OK"
        PRINT "Wachstumsfaktor g = ";G!;" allez sur Alarmgrenze ";8*K
        PRINT "Versuchen vous, Spalte ";k&;" de A comme Spalte 1 trop mettons!"
        FIN' ... eventuell hilft une autre Umordnung qui Spalten de A.
        OK:
        P![k&]=j&' ... speichere qui gefundene Pivot-la ligne qui Spalte k.
        ' ...cela P![]-Array ist maintenant libre pour, pourquoi alors pas trotz Float verwenden...
        Cas J&=K& : GOTO "Skip"' là vertauschen avec sich selbst sinnlos.

        WhileLoop n&:L&=&Boucle

            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&=&Boucle

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

        Endwhile

        WhileLoop n&:i&=&Boucle

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

            WhileLoop n&:j&=&Boucle

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

            Endwhile

        Endwhile

    Endwhile

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

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

        WhileLoop n&:i&=&Boucle

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

        Endwhile

    Endwhile

ENDPROC