XProfan

English

p.specht

The German Mathematiker Jordan erweiterte whom Gauß'schen Eliminationsalgorithmus around the Erzeugung of nobodies not only under, separate too oberhalb the Hauptdiagonale. particularly elegant will be take action, if additional ...
1. The Matrizen beforehand on numerische strength and Invertierbarkeit examined go ("Explosionsschutz"),
2. in the drop of Nullelementen The actually slot against those with the Pivotelement the row vertauscht becomes (Pivot= Angelpunkt, d.i. the element with the maximalen Absolutbetrag),
3. instead of unnötigem "Division through Null"-Fehlerabbruch the computer-Underflow-Grenzwert errechnet and instead of the zero inserted becomes, sodaß in the Result if need be "Rechnerunendlich" auftaucht, what still yet The chance the read of/ one analytischen Lösungsgleichung yields.
4. the whole even "in Place", means without further Speicherplatz in the RAM, erfolgen could. Diesbezüglich exists means yet Verbesserungspotential.

Compile Mark Separation

Window Title "Gauss-Jordan Matrix-Inversion"
' fountain: https://www.cs.berkeley.edu/~wkahan/MathH110/gji.pdf
' from IBM BASIC translated to XProfan 11.2a, P. woodpecker 2012-04
' solely for demonstration-tack, no Gewähr!
' usage velvet and sonders on risk the Anwenders!!!
' contains Überprüfungen on exzessives growth withal Spaltenpivotierung.
' and a Anpassung to prevention of nobodies as Pivotelemente.
Window 0,0 - %maxx,%maxy-52
Font 2:Randomize:Cls Rnd(8^8)
set("decimals",6):set("numwidth",16)
Var n&=5' for Testmatrix nötige Maximale Lines- or. Spaltenzahl
Declare 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' These Lines/Spaltenzahl here should objectively uses go
MatrInvs n&
Show n&
WaitInput
End

proc Show

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

    WhileLoop n&:i&=&Loop

        WhileLoop n&:j&=&Loop

            print X![i&,j&],

        Endwhile

        print

    Endwhile

    print

endproc

Proc MatrInvs :parameters n&

    Declare UFL!,EPS!,G!,P!,Q!,T!,i&,j&,k&,l&,m&
    ' I To n are Ganzzahlvariablen, The others Doubleprecision Floats!
    ' beforehand becomes the Rundungsfehler as well as Over- and Underflow-worth set.
    UFL! = val("5.9E-39")'...= max{underflow,1/overflow}-Limits.
    G!=4 : G!=G!/3 : G!=G!-1' ... = 1/3 + Rundungswert on 4/3
    EPS! = ABS( ((G!+G!) - 1) + G! )' ... = Rundungspegel
    G! = 1'new usage of G:
    ' G draw now Wachstumsrate the Pivotelementes on!
    ' copy Matrix A on X and save the betragsgrößte argument the column.
    ' ACHTUNG: In always-the-same slot becomes sought, in the the Zeilenindex runs!!!

    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

    ' The P![Zeilenindex] imply jew. whom biggest amount this slot

    WhileLoop n&:k&=&Loop' ... Elimination in line k

        Q!=0
        J&=K&'assumption: Pivotzeile in Diagonale, therefore same slot
        ' Search ex & below k. slot the Pivot (Betragsmaximum)

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

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

            if T!>Q!

                Q!=T!
                J&=I&' J save evident The row with the Pivot
                'ACHTUNG FEHLERQUELLE: IBM-Basic if: the 'then : : ´' relating itself on any : : !!!

            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!;" goes over Alarmgrenze ";8*k
        PRINT "Versuchen tappt im dunkeln, slot ";k&;"By A as slot 1 To settle!"
        END' ... possible helps another Umordnung the Split of A.
        OK:
        P![k&]=j&' ... save The found Pivot-row the column k.
        ' ...the P![]-aray is now spare for, Why means not withal Float use...
        Case J&=K& : GOTO "Skip"' there vertauschen with itself self futile.

        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 the Split of 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