XProfan

Window Title "Matrixinversion"
Font 2:randomize:cls rnd(8^8)
' Q: https://www.rhirte.de/vb/gleichsys.htm#mat
' for XProfan adaptiert of P. woodpecker 2012-04
' Demoware, no How always geartete Gewähr!
Var n&=12'= Lines, Split (Testmatrix-Size)
Declare A![n&,n&],erg$
@MatrixAufruf n&
' Testmatrix with Zufallszahlen occupy.
' subsequently:
' whether The Matrixinversion calculate properly, can simply
' testing, because The Inverse the Inversen must again The
' Ausgangsmatrix yield. in the example becomes therefore The
' most absolute deviation outputted.

Proc @MatrixAufruf : Parameters n&

    Declare i&,j&,Max!,erg$,B![n&,n&],k!

    Whileloop n&:i&=&Loop

        Whileloop n&:j&=&Loop

            A![i&,j&]=(Rnd()-0.5)*1000000
            B![i&,j&]=A![i&,j&]

        Endwhile

    Endwhile

    print "TESTMATRIX:" : @Show A![],n&
    MatInv A![],N&
    print "INVERSE:" : @Show A![],n&
    MatInv A![],N&
    print "INVERSE RÜCKINVERTIERT:" : @Show A![],n&
    ' Fehlerbestimmung and -spending
    Max! = -1

    Whileloop n&:i&=&Loop

        Whileloop n&:j&=&Loop

            If Abs(A![i&,j&] - B![i&,j&]) > Max!

                Max! = Abs(A![i&,j&] - B![i&,j&])

            endif

            'erg$ = erg$ + stature$("%e",A![i&,j&] - B![i&,j&]) + " "

        endwhile

        'erg$ = erg$ + chr$(10)+chr$(13)

    endwhile

    erg$ = erg$ + "\n Größter Error: "+stature$("%e",Max!)
    print "DIFFERENZ:" :print erg$
    waitinput
    Clear B![]

Endproc

' Eigentliche Inversion

Proc MatInv :parameters Mat![],N&

    Declare Hlp1&[n&],Hlp2&[n&],Hlp3&[n&]
    Declare Max!,T!,i&,j&,k&,ix&,iy&

    Whileloop n&:i&=&Loop

        Hlp3&[i&]=0

    Endwhile

    Whileloop n&:i&=&Loop

        ' Search the most element
        Max! = 0

        Whileloop n&:j&=&Loop

            If Hlp3&[j&]<>1

                Whileloop n&:k&=&Loop

                    If (Hlp3&[k&]<>1) AND (Max! <= Abs(Mat![j&,k&]))

                        iy& = k&
                        ix& = j&
                        Max! = Abs(Mat![j&,k&])

                    EndIf

                endwhile

            EndIf

        endwhile

        Hlp3&[iy&] = Hlp3&[iy&] + 1
        'Pivotisierung

        If ix&<>iy&

            Whileloop n&:j&=&Loop

                t!=Mat![ix&,j&]
                Mat![ix&,j&]=Mat![iy&,j&]
                Mat![iy&,j&]=t!

            Endwhile

        EndIf

        Hlp1&[i&] = ix&
        Hlp2&[i&] = iy&
        'control on mögliches vanish one Hauptachsenwertes

        If Abs(Mat![iy&,iy&]) < 10^-300

            Print "Abbruch, Inversion you don't say so!"
            Waitinput :End

        Else

            T! = Mat![iy&,iy&]
            Mat![iy&,iy&] = 1

            Whileloop n&:j&=&Loop

                Mat![iy&,j&] = Mat![iy&,j&] / T!

            EndWhile

            Whileloop n&:j&=&Loop

                If j&<>iy&

                    T! = Mat![j&,iy&]
                    Mat![j&,iy&] = 0

                    Whileloop n&:k&=&Loop

                        Mat![j&,k&] = Mat![j&,k&]- Mat![iy&,k&] * T!

                    endwhile

                EndIf

            endwhile

        EndIf

    endwhile

    'Rücktausch

    Whileloop n&:i&=&Loop

        j& = N& + 1 - i&

        If Hlp1&[j&]<>Hlp2&[j&]

            ix& = Hlp1&[j&]
            iy& = Hlp2&[j&]

            Whileloop n&:k&=&Loop

                T!=Mat![k&,ix&]
                Mat![k&,ix&]=Mat![k&,iy&]
                Mat![k&,iy&]=T!

            endwhile

        EndIf

    endwhile

    'Hilfsspeicher enable
    Clear Hlp1&[],Hlp2&[],Hlp3&[]
    'to spending ...

ENDPROC

' Show the Matrix

Proc Show :parameters A![],n&

    declare i&,j&

    Whileloop n&:i&=&Loop

        Whileloop n&:j&=&Loop

            erg$ = erg$ + stature$("%e",A![i&,j&])+" "

        Endwhile

        erg$ = erg$+chr $(10)+chr $(13)

    Endwhile

    print erg$
    waitinput 1000
    erg$=""

ENDPROC

' an important application the Matrizeninversion is the
' Solution of linearen Gleichungssystemen. this
' Lösungsverfahren has Yes whom immensen benefit, sofern one
' The invertierte Matrix knows, particularly elegant To his.
' because if Ax = b the Gleichungssystem in vektorieller
' spelling describe, then is x = inv(A)*A*x = inv(A)*b
' already The Solution. therefore:

Proc InvMat : parameters n&,a![],x![]

    Declare i%,j%
    MatInv a![],n&

    WhileLoop n&:i&=&Loop

        x!(i&)=0

        Whileloop n&:j&=&Loop

            x!(i&)=x!(i&)+a![i&,j&] * a![j&,n&+1]'<<< rights Page d.LGS

        Endwhile

    Endwhile

Endproc