XProfan

Titre de la fenêtre "Lösungen des Allgemeinen Polynoms 6. Grades pour Bairstow"
Cls:declare a![6],xn!,x!,c$,Grad&
lup:
a![6]=1:a![5]=1:a![4]=1:a![3]=1:a![2]=1:a![1]=1:a![0]=-6'default
imprimer "\n s'il te plaît Koeffizienten pour fallendem Grad eingeben:"
imprimer "--------------------------------------------------"
imprimer " a6 = ";:input c$:cas c$ > » :a![6]=val(c$)
imprimer " a5 = ";:input c$:cas c$ > » :a![5]=val(c$)
imprimer " a4 = ";:input c$:cas c$ > » :a![4]=val(c$)
imprimer " a3 = ";:input c$:cas c$ > » :a![3]=val(c$)
imprimer " a2 = ";:input c$:cas c$ > » :a![2]=val(c$)
imprimer " a1 = ";:input c$:cas c$ > » :a![1]=val(c$)
imprimer " a0 = ";:input c$:cas c$ > » :a![0]=val(c$)
imprimer "--------------------------------------------------"
Grad&=sizeof(A![])-1

WhileLoop Grad&,0,-1

    Set("NumWidth",1) :set("Décimal",0)

    si &Boucle<Grad&:imprimer " +";:d'autre:imprimer "  ";:endif

        Imprimer "X^";&Boucle,
        Set("NumWidth",26):set("Décimal",15):Imprimer " la fois ";A![&Boucle]

    Endwhile

    Imprimer:Imprimer " Pour Berechnungsstart s'il te plaît bouton drücken!"
    WaitInput
    CLS
    Set("NumWidth",1) :set("Décimal",0)
    Imprimer "Das gegebene Polynom vom Grad ";Grad&;" hat folgende Nullstellen:":Imprimer
    Bairstow(A![])
    WaitInput
    goto "lup"

    Proc Bairstow : Paramètres A![]:Var Grad&=SizeOf(A![])-1

        Déclarer i&,R!,P!,P1!,Q!,Q1!,Ce!,s!,t!,B![Grad&],C![Grad&]
        set("NumWidth",20):set("Décimal",15)

        Tandis que Grad&>2:R!=0:P1!=1:Q1!=-1:B![Grad&]=A![Grad&]:C![Grad&]=A![Grad&]

            Repeat :P!=P1!:Q!=Q1!:B![Grad&-1]=B![Grad&]*P!+A![Grad&-1]
            C![Grad&-1]=B![Grad&-1]+B![Grad&]*P!

            Whileloop Grad&-2,0,-1:i&=&Boucle:B![i&]=B![i&+2]*Q!+B![i&+1]*P!+A![i&]

                C![i&]=C![i&+2]*Q!+C![i&+1]*P!+B![i&]

            Endwhile

            Ce!=C![2]*C![2]-C![1]*C![3]:cas Ce!=0:Imprimer "Andere Startwerte nötig!"
            P1!=P!-(B![1]*C![2]-B![0]*C![3])/Ce!:Q1!=Q!-(B![0]*C![2]-B![1]*C![1])/Ce!:R!=R!+1

            Si R!>4000:Imprimer "\n\n 4000 Runden, aucun Konvergenz!":WaitInput :Fin :EndIf

            Until Abs(B![0])+Abs(B![1])<10^-12:s!=P1!/2:t!=P1!*P1!+4*Q1!

            Si t!<0:Imprimer s!;"   + ";0.5 * Sqrt(-t!);"*i ";: comment

                Imprimer s!;"   - ";0.5 * Sqrt(-t!);"*i ";: comment
                D'autre :Imprimer s!+0.5*Sqrt(t!):Imprimer s!-0.5*Sqrt(t!)
                EndIf :whileloop 2,Grad&:i&=&Boucle:A![i&-2]=B![i&]:endwhile :Grad&=Grad&-2

            Endwhile

            Si Grad&=1:Imprimer -A![0]/A![1]:D'autre :s!=-0.5*A![1]/A![2]:t!=A![1]*A![1]-4*A![2]*A![0]

                Si t!<0:Imprimer s!;"   + ";0.5*Sqrt(-t!)/A![2];"*i ";: comment

                    Imprimer s!;"   - ";0.5*Sqrt(-t!)/A![2];"*i ";: comment
                    D'autre   :Imprimer s!+0.5*Sqrt(t!)/A![2]:Imprimer s!-0.5*Sqrt(t!)/A![2]

                EndIf

            EndIf

        ENDPROC

        Proc comment :si nearly(s!,0,9):imprimer "(Imaginär)":d'autre :imprimer "(Komplex)":endif

        endproc