XProfan

Window Title "LGS[n,(n+1)] with Pivot-normalisierter Gauss-Elimination lösen"
' fountain: https://www.rhirte.de/vb/gleichsys.htm#lin
' from the Pascal-Original in XProfan transfer through
' P. woodpecker april 2012-04. No How always geartete
' Liability! all risks liegén at users!
' deference, the Content the Originalmatrix becomes changed!
Font 2:randomize:cls rnd(8^8):set("decimals",15)
' Testmatrix-Dimensionen
Var n%=4
' LGS-Lines*(Split+1) wg.Lösungsvektor "Rechte Page "
Declare A![n%,n%+1],x![n%],i%,j%,k%
Declare jmax%,kmax!,kmax%,merk%[n%]
Declare s!,max!,skal![n%]
' Testmatrix touch down
a![1,1]=1 :a![1,2]=0 :a![1,3]=0 :a![1,4]=0 :a![1,5]=10'=Rechte Page
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. Order secure

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%'slot with max
    jmax% = k%'row with max

    WhileLoop k%,n%

        j%=&Loop
        ' 4. Pivotzelle search

        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, if necessary

    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, if necessary

    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. spending

Whileloop n%

    i%=&Loop
    print "x"+st$(i%);" = ";x![i%]
    ' stature$("%e",x![i%])

endwhile

Waitinput
End