XProfan

Titre de la fenêtre "Matrixinversion"
Font 2:randomize:cls rnd(8^8)
' Q: https://www.rhirte.de/vb/gleichsys.htm#mat
' Pour XProfan adaptiert de P. Specht 2012-04
' Demoware, aucun comment toujours geartete Gewähr!
Var n&=12'= Zeilen, Spalten (Testmatrix-Taille)
Déclarer A![n&,n&],erg$
@MatrixAufruf n&
' Testmatrix avec nombres aléatoires belegen.
' Anschließend:
' si qui Matrixinversion richtig rechnet, peux on simple
' testen, car qui Inverse qui Inversen doit wieder qui
' Ausgangsmatrix ergeben. Im Beispiel wird c'est pourquoi qui
' größte absolute Abweichung ausgegeben.

Proc @MatrixAufruf : Paramètres n&

    Déclarer i&,j&,Max!,erg$,B![n&,n&],k!

    Whileloop n&:i&=&Boucle

        Whileloop n&:j&=&Boucle

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

        Endwhile

    Endwhile

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

    Whileloop n&:i&=&Boucle

        Whileloop n&:j&=&Boucle

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

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

            endif

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

        endwhile

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

    endwhile

    erg$ = erg$ + "\n Größter faute: "+format$("%e",Max!)
    imprimer "DIFFERENZ:" :imprimer erg$
    waitinput
    Claire B![]

ENDPROC

' Eigentliche Inversion

Proc MatInv :parameters Mat![],N&

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

    Whileloop n&:i&=&Boucle

        Hlp3&[i&]=0

    Endwhile

    Whileloop n&:i&=&Boucle

        ' cherche cela größte Element
        Max! = 0

        Whileloop n&:j&=&Boucle

            Si Hlp3&[j&]<>1

                Whileloop n&:k&=&Boucle

                    Si (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

        Si ix&<>iy&

            Whileloop n&:j&=&Boucle

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

            Endwhile

        EndIf

        Hlp1&[i&] = ix&
        Hlp2&[i&] = iy&
        'Kontrolle sur mögliches Verschwinden eines Hauptachsenwertes

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

            Imprimer "Abbruch, Inversion pas possible!"
            Waitinput :Fin

        D'autre

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

            Whileloop n&:j&=&Boucle

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

            Endwhile

            Whileloop n&:j&=&Boucle

                Si j&<>iy&

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

                    Whileloop n&:k&=&Boucle

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

                    endwhile

                EndIf

            endwhile

        EndIf

    endwhile

    'Rücktausch

    Whileloop n&:i&=&Boucle

        j& = N& + 1 - i&

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

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

            Whileloop n&:k&=&Boucle

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

            endwhile

        EndIf

    endwhile

    'Hilfsspeicher freigeben
    Claire Hlp1&[],Hlp2&[],Hlp3&[]
    'zur Ausgabe ...

ENDPROC

' Montrer qui Matrix

Proc Show :parameters A![],n&

    declare i&,j&

    Whileloop n&:i&=&Boucle

        Whileloop n&:j&=&Boucle

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

        Endwhile

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

    Endwhile

    imprimer erg$
    waitinput 1000
    erg$=»

ENDPROC

' une wichtige Anwendung qui Matrizeninversion ist qui
' Solution de linearen Gleichungssystemen. cet
' Lösungsverfahren hat oui den immensen Vorteil, sofern on
' qui invertierte Matrix kennt, besonders elegant trop son.
' car si Ax = b cela Gleichungssystem dans vektorieller
' Schreibweise beschreibt, ensuite ist x = inv(A)*A*x = inv(A)*b
' bereits qui Solution. c'est pourquoi:

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

    Déclarer i%,j%
    MatInv a![],n&

    WhileLoop n&:i&=&Boucle

        x!(i&)=0

        Whileloop n&:j&=&Boucle

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

        Endwhile

    Endwhile

ENDPROC