Deutsch
Quelltexte/ Codesnippets

Kubische Gleichung lösen nach der Formel-Methode

 

p.specht

Die von Gerolamo Cardano dem Rechenmeister Tartaglia zu Padua entwendete Formel, welche selbiger aber selbst dem Scipione del Ferro abgeluchst hatte, wird - anders als etwa die Lösungsformel zu quadratischen Gleichungen - in unseren Schulen kaum gelehrt. Zugegeben: Dass etwas Reelles herauskommen kann, wenn man zwei komplexe Zahlen verrechnet, war lange Zeit unbekannt und galt als "unmöglicher Fall" (lat. casus irreducibilis).
Windowtitle "Kubische Gleichung mittels der Formel "+\
"von Doctoris med. Gerolimo CARDANO lösen, mit Probe!"
' (CL) Copyleft 2013-05 by P.Specht, Wien. Alpha-Version - KEINE GEWÄHR!
' Anm.: Das Newton-Verfahren ist genauer und universell einsetzbar bis 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 " Bitte a, b, c und d eingeben: \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 Das ist keine 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 reelle, 2 konjug. komplexe Lösungen

        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 reelle Lösungen

        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 verschiedene reelle Lösungen

        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 " Die kubische Gleichung  "+\
    if(a!<0," -"," ")+if(abs(a!)=1,"",format$("%g",abs(a!)))+" x³"+\
    if(b!=0,"",if(b!<0," - "," + ")+format$("%g",abs(b!))+" x²") +\
    if(c!=0,"",if(c!<0," - "," + ")+format$("%g",abs(c!))+" x") +\
    if(d!=0,"",if(d!<0," - "," + ")+format$("%g",abs(d!)))+" = 0 \n hat";

    if flg&= -2

        Print " eine reelle und zwei konjugiert komplexe Lösungen: "
        print
        print " x1 = ";x1!
        print
        print " x2 = ";x2r!;" + j * ";x2i!
        print " x3 = ";x3r!;" + j * ";x3i!
        print

    elseif flg&= 2

        print " drei reelle Lösungen (Diese können auch gleich sein): "
        print
        print " x1 = ";x1!
        print " x2 = ";x2!
        print " x3 = ";x3!
        case (x1!=0) and (x2!=0) and (x3!=0): print " Trivialer Fall!"
        print

    elseif flg&= 3

        Print " drei verschiedene reelle Lösungen ('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  durch Einsetzen. Die Ergebnisse sollten stets nahe Null sein: "
    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, gelöst gemäß 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 ergibt: ";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 " Keine reellen Lösungen, nur im Komplexen: "
        x1r!= -1/2*c!/b!
        x1i!= sqrt(-1*dis!)
        x2r!= -1/2*c!/b!
        x2i!= -1*sqrt(-1*dis!)
        print " Lösung: "
        print " x1 = ";x1r!;" + %j * ";x1i!
        print " x2 = ";x2r!;" + %j * ";x2i!
        print "\n Nullprobe ergibt: "
        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 mit der Lösung: \n"
    print " x = ";-1*d!/c!
    print " Nullprobe ergibt: ";c!*(-1*d!/c!)-d!
    waitinput
    goto "Start"
    Const:
    Print "\n Konstantenvergleich: \n"

    if d!=0:Print " x = 0 ... Triviale Lösung! \n"

        else :Print " Es gibt keine Lösung. \n"

    endif

    waitinput
    goto "Start"
 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
09.05.2021  
 



Zum Quelltext


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

578 Betrachtungen

Unbenanntvor 0 min.
Ernst21.07.2021
Uwe ''Pascal'' Niemeier13.06.2021
R.Schneider28.05.2021
Michael W.28.05.2021
Mehr...

Themeninformationen

Dieses Thema hat 1 Teilnehmer:

p.specht (1x)


Admins  |  AGB  |  Anwendungen  |  Autoren  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Händlerportal  |  Impressum  |  Mart  |  Schnittstellen  |  SDK  |  Services  |  Spiele  |  Suche  |  Support

Ein Projekt aller XProfaner, die es gibt!


Mein XProfan
Private Nachrichten
Eigenes Ablageforum
Themen-Merkliste
Eigene Beiträge
Eigene Themen
Zwischenablage
Abmelden
 Deutsch English Français Español Italia
Übersetzungen

Datenschutz


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie