XProfan

Título de la ventana "Matrixinversion"
Font 2:randomize:cls rnd(8^8)
' Q: https://www.rhirte.de/vb/gleichsys.htm#mat
' Für XProfan adaptiert de P. Pájaro carpintero 2012-04
' Demoware, no como siempre geartete Gewähr!
Var n&=12'= Zeilen, Spalten (Testmatrix-Größe)
Declarar A![n&,n&],erg$
@MatrixAufruf n&
' Testmatrix con Zufallszahlen ocupar.
' Anschließend:
' Ob el Matrixinversion correcto rechnet, puede ser simplemente
' testen, porque el Inverse el Inversen muß otra vez el
' Ausgangsmatrix ergeben. Im Ejemplo se deshalb el
' größte absolute Abweichung ausgegeben.

Proc @MatrixAufruf : Parámetros n&

    Declarar 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

    imprimir "TESTMATRIX:" : @Show A![],n&
    MatInv A![],N&
    imprimir "INVERSE:" : @Show A![],n&
    MatInv A![],N&
    imprimir "INVERSE RÜCKINVERTIERT:" : @Show A![],n&
    ' Fehlerbestimmung y -Edición
    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$ + Formato$("%e",A![i&,j&] - B![i&,j&]) + " "

        endwhile

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

    endwhile

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

ENDPROC

' Eigentliche Inversion

Proc MatInv :parámetros Mat![],N&

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

    Whileloop n&:i&=&Loop

        Hlp3&[i&]=0

    Endwhile

    Whileloop n&:i&=&Loop

        ' Búsqueda el größte 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&
        'Kontrolle en mögliches Verschwinden uno Hauptachsenwertes

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

            Imprimir "Abbruch, Inversion no posible!"
            Waitinput :End

        Más

            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 liberación
    Claro Hlp1&[],Hlp2&[],Hlp3&[]
    'a Edición ...

ENDPROC

' Mostrar el Matrix

Proc Show :parámetros A![],n&

    declarar i&,j&

    Whileloop n&:i&=&Loop

        Whileloop n&:j&=&Loop

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

        Endwhile

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

    Endwhile

    imprimir erg$
    waitinput 1000
    erg$=""

ENDPROC

' Un wichtige Anwendung el Matrizeninversion Es el
' Solución de linearen Gleichungssystemen. Dieses
' Lösungsverfahren ha sí el immensen Vorteil, sofern uno
' el invertierte Matrix sabe, besonders elegant a ser.
' Denn si Ax = b el Gleichungssystem en vektorieller
' Schreibweise beschreibt, entonces x = inv(A)*A*x = inv(A)*b
' ya el Solución. Deshalb:

Proc InvMat : parámetros n&,a![],x![]

    Declarar 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]'<<< Rechte Página d.LGS

        Endwhile

    Endwhile

ENDPROC