XProfan

Título de la ventana "LGS[n,(n+1)] con Pivot-normalisierter Gauss-Elimination lösen"
' Quelle: https://www.rhirte.de/vb/gleichsys.htm#lin
' Aus el Pascal-Original en XProfan übertragen por
' P. Pájaro carpintero April 2012-04. Keine como siempre geartete
' Haftung! Sämtliche Risiken liegén beim Anwender!
' Achtung, el Inhalt el Originalmatrix se verändert!
Font 2:randomize:cls rnd(8^8):set("decimals",15)
' Testmatrix-Dimensionen
Var n%=4
' LGS-Zeilen*(Spalten+1) ca.Lösungsvektor "Rechte Seite"
Declarar A![n%,n%+1],x![n%],i%,j%,k%
Declarar jmax%,kmax!,kmax%,merk%[n%]
Declarar s!,max!,skal![n%]
' Testmatrix aufsetzen
a![1,1]=1 :a![1,2]=0 :a![1,3]=0 :a![1,4]=0 :a![1,5]=10'=Rechte Página
a![2,1]=1 :a![2,2]=1 :a![2,3]=0 :a![2,4]=0 :a![2,5]=20'= ...
a![3,1]=1 :a![3,2]=0 :a![3,3]=1 :a![3,4]=0 :a![3,5]=30'= ..
a![4,1]=1 :a![4,2]=0 :a![4,3]=0 :a![4,4]=1 :a![4,5]=40'= .
' GaussPivot
' 1. Reihenfolge sichern

WhileLoop n%

    i%=&Loop
    merk%[i%]=i%

EndWhile

' 2. Normalisierung

WhileLoop n%

    i%=&Loop
    s!=0

    WhileLoop n%

        j%=&Loop
        s!=s!+Abs(A![i%,j%])

    EndWhile

    skal![i%]=1/s!

EndWhile

' 3. Vorwärtselimination

WhileLoop n%-1

    k%=&Loop
    max!=skal![k%]*Abs(A![k%,k%])
    kmax% = k%'Spalte con max
    jmax% = k%'Línea con max

    WhileLoop k%,n%

        j%=&Loop
        ' 4. Pivotzelle suchen

        WhileLoop k%,n%

            i%=&Loop

            If (skal![j%]*Abs(A![j%,i%]))>max!

                jmax%=j%
                kmax%=i%
                max! =skal![j%]*Abs(A![j%,i%])

            EndIf

        EndWhile

    EndWhile

    ' 5. Zeilentausch, si nötig

    If jmax% <> k%

        WhileLoop k%,n%+1

            j%=&Loop
            s!=A![k%,j%]
            A![k%,j%]=A![jmax%,j%]
            A![jmax%,j%]=s!

        EndWhile

        s!=skal![k%]
        skal![k%] = skal![jmax%]
        skal![jmax%] = s!

    EndIf

    ' 6. Spaltentausch, si nötig

    If kmax% <> k%

        WhileLoop n%

            i%=&Loop
            s! = A![i%,k%]
            A![i%,k%] = A![i%,kmax%]
            A![i%,kmax%] = s!

        EndWhile

        j% = merk%[k%]
        merk%[k%] = merk%[kmax%]
        merk%[kmax%] = j%

    EndIf

    ' 7. Eigentliche Elimination

    WhileLoop k%+1,n%

        i%=&Loop
        s! = A![i%,k%]/A![k%,k%]
        A![i%,k%] = 0.0

        WhileLoop k%+1,n%+1

            j%=&Loop
            A![i%,j%]=A![i%,j%]-s!*A![k%,j%]

        EndWhile

    EndWhile

EndWhile

' 8. Rückwärtsauflösung
x![merk%[n%]]=A![n%,n%+1]/A![n%,n%]

WhileLoop n%-1,1,-1

    i%=&Loop
    s! = A![i%,n%+1]

    WhileLoop i%+1,n%

        j%=&Loop
        s!=s!-A![i%,j%]*x![merk%[j%]]

    EndWhile

    x![merk%[i%]]=s!/A![i%,i%]

EndWhile

' 9. Edición

Whileloop n%

    i%=&Loop
    imprimir "x"+str$(i%);" = ";x![i%]
    ' format$("%e",x![i%])

endwhile

Waitinput
End