XProfan

Windowtitle "Kubische Gleichung through the Formel "+\
"By Doctoris med. Gerolimo CARDANO solve, with Probe!"
' (CL) Copyleft 2013-05 by P.woodpecker, Wien. Alpha-Version - NO GEWÄHR!
' Anm.: the Newton-take action is accurate and universell einsetzbar To ca. x^12
font 2:randomize:set("decimals",15)
declare x!,x1!,x2!,x3!,y1!,y2!,y3!,a!,b!,c!,d!,p!,q!,dis!,u!,v!
declare y2r!,y2i!,y3r!,y3i!,x1r!,x1i!,x2r!,x2i!,x3r!,x3i!,phi!,flg&

proc kubrt :parameters w!

    case w!=0:return 0.0
    case w!>0:return w!^(1/3)
    return -1*((-1*w!)^(1/3))

endproc

Proc ArkCos :Parameters w!

    var res!=0

    if w!=1:res!=0

    elseif w!=-1:res!=Pi()

        else :res!= Pi()/2 - ArcTan(w!/Sqrt(1-w!*w!))
        endif :return res!

    ENDPROC

    Start:
    cls rgb(200+rnd(56),200+rnd(56),200+rnd(56))
    Loop:
    print "\n a * x³ + b * x² + c * x + d = 0. "
    Print " Please a, b, c and d prompt: \n"
    print " a = ";:input a!
    print " b = ";:input b!
    print " c = ";:input c!
    print " d = ";:input d!

    if a!=0:sound 2000,200

        Print "\n this is no kubische Gleichung! \n"
        goto "Quadr"

    endif

    p!=3*a!*c!-b!*b!
    q!=2*b!*b!*b!-9*a!*b!*c!+27*a!*a!*d!
    dis!=q!*q!+4*p!*p!*p!

    IF dis!>0' 1 real, 2 konjug. complex Solutions

        u!=1/2*kubrt(-4*q!+4*sqrt(dis!))
        v!=1/2*kubrt(-4*q!-4*sqrt(dis!))
        y1!=u!+v!
        x1!=(y1!-b!)/(3*a!)
        y2r!= -1/2*(u!+v!)
        x2r!=(y2r!-b!)/(3*a!)
        y2i!=sqrt(3)*(u!-v!)/2' * j
        x2i!=y2i!/(3*a!)' * j
        y3r!= -1/2*(u!+v!)
        x3r!=(y3r!-b!)/(3*a!)
        y3i!= -1*sqrt(3)*(u!-v!)/2' * j
        x3i!= y3i!/(3*a!)' * j
        flg&= -2

    ELSEIF dis!=0' 3 real Solutions

        u!=1/2*kubrt(-4*q!)
        v!=1/2*kubrt(-4*q!)
        y1!=2*u!
        x1!=(y1!-b!)/(3*a!)
        y2r!= -1*u!
        x2r!=(y2r!-b!)/(3*a!)
        y2i!=0
        x2i!=0
        x2!=x2r!
        y3r!= -1*u!
        x3r!=(y3r!-b!)/(3*a!)
        y3i!=0
        x3i!=0
        x3!=x3r!
        flg&=2

    ELSEIF dis!<0' 3 different real Solutions

        phi!=ArkCos( -1*q!/(2*sqrt(-1*p!*p!*p!)))
        y1!=sqrt(-p!)*2*cos(phi!/3)
        x1!=(y1!-b!)/(3*a!)
        y2!=sqrt(-p!)*2*cos(phi!/3+2*pi()/3)
        x2!=(y2!-b!)/(3*a!)
        y3!=sqrt(-p!)*2*cos(phi!/3+4*pi()/3)
        x3!=(y3!-b!)/(3*a!)
        flg&=3

    ENDIF

    Print "\n L Ö s u n G : \n"
    Print " The kubische Gleichung  "+\
    if(a!<0," -"," ")+if(abs(a!)=1,"",stature$("%g",abs(a!)))+" x³"+\
    if(b!=0,"",if(b!<0," - "," + ")+stature$("%g",abs(b!))+" x²") +\
    if(c!=0,"",if(c!<0," - "," + ")+stature$("%g",abs(c!))+" x") +\
    if(d!=0,"",if(d!<0," - "," + ")+stature$("%g",abs(d!)))+" = 0 \n hat";

    if flg&= -2

        Print " a real and two konjugiert complex Solutions: "
        print
        print " x1 = ";x1!
        print
        print " x2 = ";x2r!;" + j * ";x2i!
        print " x3 = ";x3r!;" + j * ";x3i!
        print

    elseif flg&= 2

        print " three real Solutions (These can also same his): "
        print
        print " x1 = ";x1!
        print " x2 = ";x2!
        print " x3 = ";x3!
        case (x1!=0) and (x2!=0) and (x3!=0): print " Trivialer drop!"
        print

    elseif flg&= 3

        Print " three different real Solutions ('Casus irreducibilis'): "
        print
        print " x1 = ";x1!
        print " x2 = ";x2!
        print " x3 = ";x3!
        print

    else

        print " Unknown flag status! "
        sound 2000,200
        waitinput
        end

    endif

    print " P R O B E  through bring into action. The Results should always near zero his: "
    print "\n  f(x1) = ";a!*x1!*x1!*x1!+b!*x1!*x1!+c!*x1!+d!
    case (flg&=2) or (flg&=3):print "  f(x2) = ";a!*x2!*x2!*x2!+b!*x2!*x2!+c!*x2!+d!

    if flg&= -2

        print " f(x2r) = ";a!*(x2r!*x2r!*x2r!-3*x2r!*x2i!*x2i!)+b!*(x2r!*x2r!-x2i!*x2i!)+c!*x2r!+d!
        print " f(x2i) = ";a!*(3*x2r!*x2r!*x2i!-x2i!*x2i!*x2i!)+b!*    2*x2r!*x2i!  + c!*x2i!

    endif

    case (flg&=2) or (flg&=3):print "  f(x3) = ";a!*x3!*x3!*x3!+b!*x3!*x3!+c!*x3!+d!

    if flg&= -2

        print " f(x3r) = ";a!*(x3r!*x3r!*x3r!-3*x3r!*x3i!*x3i!)+b!*(x3r!*x3r!-x3i!*x3i!)+c!*x3r!+d!
        print " f(x3i) = ";a!*(3*x3r!*x3r!*x3i!-x3i!*x3i!*x3i!)+b!*    2*x3r!*x3i!  + c!*x3i!

    endif

    waitinput
    case %csrlin<=20:goto "loop"
    goto "Start"
    Quadr:
    case b!=0:goto "Linr"
    print "\n Quadratische Gleichung, resolved according Mitternachtsformel: \n"
    dis!=sqr(c!/(2*b!))-d!/b!

    if dis!=0

        x1!= -1/2*c!/b!
        x2!=x1!
        print " x1 = x2 = "; x1!
        Print " Nullprobe yields: ";b!*x1!*x1!+c!*x!+d!

    elseif dis!>0

        x1!= -1/2*c!/b! + sqrt(dis!)
        x2!= -1/2*c!/b! - sqrt(dis!)
        print " x1 = ";x1!
        print " x2 = ";x2!
        Print "\n Nullprobe: "
        Print "  f(x1) = ";b!*x1!*x1!+c!*x1!+d!
        Print "  f(x2) = ";b!*x1!*x1!+c!*x1!+d!

    elseif dis!<0

        Print " No reellen Solutions, only complex: "
        x1r!= -1/2*c!/b!
        x1i!= sqrt(-1*dis!)
        x2r!= -1/2*c!/b!
        x2i!= -1*sqrt(-1*dis!)
        print " Solution: "
        print " x1 = ";x1r!;" + %j * ";x1i!
        print " x2 = ";x2r!;" + %j * ";x2i!
        print "\n Nullprobe yields: "
        print " f(x1r) = "; b!*(x1r!*x1r!-x1i!*x1i!)+c!*x1r!+d!
        print " f(x1i) = "; 2*b!*x1r!*x1i!+c!*x1i!
        print " f(x2r) = "; b!*(x2r!*x2r!-x2i!*x2i!)+c!*x2r!+d!
        print " f(x2i) = "; 2*b!*x2r!*x2i!+c!*x2i!

    endif

    waitinput :goto "Start"
    Linr:
    case c!=0: goto "Const"
    print "\n Lineare Gleichung with the Solution: \n"
    print " x = ";-1*d!/c!
    print " Nullprobe yields: ";c!*(-1*d!/c!)-d!
    waitinput
    goto "Start"
    Const:
    Print "\n Konstantenvergleich: \n"

    if d!=0:Print " x = 0 ... Triviale Solution! \n"

        else :Print " there's no Solution. \n"

    endif

    waitinput
    goto "Start"