XProfan

Windowtitle "Diverse Kubikwurzelalgorithmen in the Vergleich"
cls:font 2:set("decimals",17)
declare x!,y1!,y2!,y3!,y4!,w$,ex!

Repeat

    Print "\n Radikand x = ";:input w$:case w$="":end
    w$=upper$(trim$(w$)):ex!=if(instr("E",w$), val(substr$(w$,-1,"E")),0)

    ifnot between(ex!,-53,53):beep:print "\n *** Exponent out of brat! ***"

        waitinput:cls:continue:endif:x!=val(w$)
        y1!=cubrt1(x!):y2!=cubrt2(x!):y3!=cubrt3(x!)
        locate 4,3
        print "     cubrt1(x)            cubrt2(x)             cubrt3(x)"
        locate 6,3 :print stature$("%g",y1!)
        locate 6,27:print stature$("%g",y2!)
        locate 6,52:print stature$("%g",y3!)
        print "\n Abs.Diff: y2-y1=          y3-y1=                y3-y2="
        locate 9,3 :print stature$("%g",y2!-y1!)
        locate 9,27:print stature$("%g",y3!-y1!)
        locate 9,52:print stature$("%g",y3!-y2!)
        print "\n   Probe: y1^3             y2^3=                  y3^3="
        locate 12,3 :print stature$("%g",sqr(y1!)*y1!)
        locate 12,27:print stature$("%g",sqr(y2!)*y2!)
        locate 12,52:print stature$("%g",sqr(y3!)*y3!)
        waitinput
        cls

    until 0

    proc cubrt1 :parameters x!

        var sgn!=1-2*(x!<0):x!=abs(x!)
        return if(x!=0,0,sgn!*x!^0.333333333333333333)

    endproc

    proc cubrt2 :parameters x!

        var sgn!=1-2*(x!<0):x!=abs(x!)
        return if(x!=0,0,sgn!*sqrt(x!)/x!^(1/6))

    endproc

    proc cubrt3 :parameters v!

        case V!=0:return 0.0:declare sg!,epsi!,r!,last_r!,i&
        sg!=if(V!<0,-1,1):v!=abs(v!):r!=1:i&=0
        epsi!=1.77*10^(-15+lg(V!)*(lg(V!)>0)/3)
        'lg(x)=ln(x)*0.434294481903251827

        while i&<=3000:last_r!=r!:r!=(2*r!+V!/sqr(r!))/3

            inc i&:case abs(r!-last_r!)<=epsi!:break
            endwhile:case i&>3000:return -9.9999999999e-52
            return r!*sg!

        endproc