XProfan

Deutsch

p.specht

Mit der Karthesischen Kegelschnittgleichung a*x² + 2b*x*y + c*y² + 2d*x + 2e*y + f = 0 können sämtliche Arten von Kegelschnitten (Ellipse, Parabel, Hyperbel) einschließlich aller degenerierten Fälle (Geradenzwickel, Gerade, Punkt oder Garnichts) dargestellt werden. In der Astronomie betrifft das zB die Bahnen von Kometen. Bei bereits ermittelten Parametern wäre aber von Interesse, um welchen Typ es sich jeweils tatsächlich handelt und wie die Bestimmungselemente des Kegelschnittes lauten. Das leistet nachstehendes, von mir nach XProfan-11 übersetzes Programm von der genialen Homepage von Prof. J.-P. Moreau - Wie immer ohne Gewähr!

Kompilieren Markieren Separieren

WindowTitle upper$("Aus karthesischer Kegelschnittformel "+\
"auf Parameter des Kegelschnittes schließen")
WindowStyle 24':Window (%maxx-%maxy)/2,0-%maxy,%maxy
font 2:set("decimals",12):randomize
'Q: https://jean-pierre.moreau.pagesperso-orange.fr/Basic/conical_bas.txt
'Transscribed to XProfan 11.2a by P.Specht, Vienna (Austria).
'*  Type: Parabola                                   *
'*  Center:  x=0.999999  y=5.000000                  *
'*  Symmetry direction:  x=1  y=-1                   *
'*  Focus:   x=1.124999  y=4.875000                  *
'*  Parameter:           0.35355339                  *
'*                                                   *
'*                     Basic version by J-P Moreau.  *
'*                           (www.jpmoreau.fr)       *
Declare c$,a!,b!,c!,d!,e!,f!,x!,y!
Declare ex!,xc!,yc!,xla!,xlb!,xf1!,yf1!,xf2!,yf2!
Declare xs1!,ys1!,xs2!,ys2!,xv1!,yv1!,xv2!,yv2!
Declare delta!,u!,xl!,xm!,x2!,y2!,i&,j&,ityp&,typ&
START:
CLS rgb(200+rnd(56),200+rnd(56),200+rnd(56))
print
print "          UMFORMUNG DER KEGELSCHNITTGLEICHUNG AUF ELEMENTARE DARSTELLUNG  "
print "          ==============================================================  \n"
print "  Parameter der Gleichung a*x² + 2b*x*y + c*y² + 2d*x + 2e*y + f = 0 eingeben:\n"
'Testwerte lt. Beispiel aus dem Sourcetext:
a!=1:b!=2:c!=1:d!=-13:e!=-11:f!=32
print "  Frage: Sollen die Werte des internen Testbeispiels verwenden [j/n]? ";
input c$:c$=left$(lower$(trim$(c$)),1):case (c$="j") or (c$="y"):goto "Huepf"
print
print "    a  = ";:input a!
print "    2b = ";:input b!
print "    c  = ";:input c!
print "    2d = ";:input d!
print "    2e = ";:input e!
print "    f  = ";:input f!

if (a!=0) and (b!=0) and (c!=0) and (d!=0) and (e!=0) and (f!=0)

    beep:print "\n   *** Es wurden keine Werte eingegeben! *** "
    waitinput 10000
    goto "START"

endif

Huepf:
print
b!=b!/2: d!=d!/2: e!=e!/2
delta!=a!*c!-b!*b!

if delta!=0

    gosub "S1000"'call Parabola

else

    xc!=(b!*e!-d!*c!)/delta!
    yc!=(b!*d!-a!*e!)/delta!
    f! = f! + a!*xc!*xc!+2*b!*xc!*yc!+c!*yc!*yc!+2*d!*xc!+2*e!*yc!

    if f!=0

        if delta!>0

            ityp&=7'one point

        else

            ityp&=6'two lines
            goto "G100"

        endif

    endif

    u!=sqrt((a!-c!)*(a!-c!)+4*b!*b!)
    xl!=(a!+c!-u!)/2: xm!=(a!+c!+u!)/2

    if (a!=c!) and (b!=0)

        if (f!*a!)>=0

            ityp&=8'no conical
            goto "G100"

        else

            ityp&=4'circle
            xla!=sqrt(-f!/a!)
            ex!=1
            goto "G100"

        endif

    endif

    if (a!<c!) and (b!=0)

        x2!=1: y2!=0: xv1!=1: yv1!=0

    else

        xv1!=b!: yv1!=1-a!
        u!=sqrt(xv1!*xv1!+yv1!*yv1!)
        x2!=xv1!/u!: y2!=yv1!/u!

    endif

    if delta!<0

        gosub "S2000"'call Hyperbola

    else

        gosub "S3000"'call Ellipse

    endif

endif'else if delta=0

' print results
G100:

if ityp&=1

    print "  Type: Ellipse"
    print
    print "  Mittelpunktkoordianten:  x=";format$("%g",xc!);"  y=";format$("%g",yc!)
    print "\n  Richtung Große Achse  :  x=";format$("%g",xv1!);"  y=";format$("%g",yv1!)
    print "\n  Richtung Kleine Achse :  x=";format$("%g",xv2!);"  y=";format$("%g",yv2!)
    print "\n  Länge Große Halbachse :  ";format$("%g",xla!)
    print "\n  Länge Kleine Halbachse:  ";format$("%g",xlb!)
    print "\n  Brennpunktkoordinaten :  x=";format$("%g",xf1!);"  y=";format$("%g",yf1!)
    print "\n  Zweiter Brennpunkt    :  x=";format$("%g",xf2!);"  y=";format$("%g",yf2!)
    print "\n  Num.Exzentrizität     :  ";format$("%g",ex!)

endif

if ityp&=2

    if (a!+c!)=0

        print "  Typ: Gleichseitige Hyperbel"

    else

        print "  Typ: Hyperbel"

    endif

    print
    print "  Mittelpunkt           :  x=";format$("%g",xc!);"  y=";format$("%g",yc!)
    print "\n  Richtung Erste Achse  :  x=";format$("%g",xv1!);"  y=";format$("%g",yv1!)
    print "\n  Richtung Zweite Achse :  x=";format$("%g",xv2!);"  y=";format$("%g",yv2!)
    print "\n  Erste Leitgerade      :  x=";format$("%g",xs1!);"  y=";format$("%g",ys1!)
    print "\n  Zweite Leitgerade     :  x=";format$("%g",xs2!);"  y=";format$("%g",ys2!)
    print "\n  Erster Brennpunkt     :  x=";format$("%g",xf1!);"  y=";format$("%g",yf1!)
    print "\n  Zweiter Brennpunkt    :  x=";format$("%g",xf2!);"  y=";format$("%g",yf2!)
    print "\n  Num.Exzentrizität     :  ";format$("%g",ex!)

endif

if ityp&=3

    print "  Typ: Parabel"
    print
    print "  Mittelpunkt           :  x=";format$("%g",xc!); "  y=";format$("%g",yc!)
    print "\n  Symmetrieachsenvektor :  x=";format$("%g",xv1!);"  y=";format$("%g",yv1!)
    print "\n  Brennpunktskoordinaten:  x=";format$("%g",xf1!);"  y=";format$("%g",yf1!)
    print "\n  Parameter der Parabel :  "; format$("%g",ex!)

endif

if ityp&=4

    print "  Typ: Kreis"
    print
    print "  Mittelpunkt           :  x=";format$("%g",xc!);"  y=";format$("%g",yc!)
    print "\n  Radius                :  ";format$("%g",xla!)
    print "\n  Num.Exzentrizität     :  ";format$("%g",ex!)

endif

case ityp&=5: print "  Dieser Kegelschnitt degeneriert zur Linie."
case ityp&=6: print "  Dieser Kegelschnitt degeneriert zu zwei Geraden."
case ityp&=7: print "  Dieser Kegelschnitt degeneriert zu einem einzelnen Punkt."
case ityp&=8: print "  Reell nicht lösbar. Kein Kegelschnitt!"
print
Waitinput
Print "\n   Noch ein Beispiel durchrechnen [n,e = Ende]? ";
input c$:c$=left$(lower$(trim$(c$)),1)
casenot (c$="n") or (c$="e"):Goto "START"
beep:Print "\n   Programm beendet.\n\n   Auf Wiedersehen!"
Waitinput 3000
END'of main program
'Subroutine Parabel
S1000:
ityp&=3

if (c!=0) and (a!=0)'The parabola does not exist or is degenerated into a line

    if (d!=0) and (e!=0)

        typ&=8'no conical

    else

        typ&=5'line
        return

    endif

endif

if (a!=0)

    x2!=1: y2!=0: xl!=0: xm!=1

else

    if a!<0

        f!=-f!: e!=-e!: d!=-d!
        c!=-c!: b!=-b!: a!=-a!

    endif

    xl!=sqrt(a!): xm!=sqrt(c!)
    case b!<0 : xm!=-xm!
    u!=sqrt(a!+c!)
    x2!=xm!/u!: y2!=-xl!/u!
    f!=f!*u!:c!=(a!+c!)*u!
    u!=d!*xm!-e!*xl!: e!=d!*xl!+e!*xm!: d!=u!

endif

if d!=0

    if sqr(e!)<(c!*f!)

        typ&=8

    else

        typ&=6'two lines
        return

    endif

else

    x!=(e!*e!-c!*f!)/2/c!/d! : y!=-e!/c!
    xc!=x!*x2!-y!*y2! : yc!=y!*x2!+x!*y2!
    ex!=-d!/c!
    xf1!=xc!+ex!*x2!/2 :yf1!=yc!+ex!*y2!/2
    xv1!=xm! : yv1!=-xl!

endif

return
'Subroutine Hyperbel
S2000:
ityp&=2
xla!=sqrt(-abs(f!)/xl!): xlb!=sqrt(abs(f!)/xm!)

if f!<0

    u!=xla!: xla!=xlb!: xlb!=u!
    u!=x2!: x2!=-y2!: y2!=u!
    u!=xv1!: xv1!=-yv1!: yv1!=u!

endif

xv2!=-yv1!: yv2!=xv1!
u!=sqrt(xla!*xla!+xlb!*xlb!)
xs1!=xc!+x2!*xla!: ys1!=yc!+y2!*xla!
xs2!=xc!-x2!*xla!: ys2!=yc!-y2!*xla!
xf1!=xc!+x2!*u!: yf1!=yc!+y2!*u!
xf2!=xc!-x2!*u!: yf2!=yc!-y2!*u!
ex!=u!/xla!
return
'Subroutine Ellipse
S3000:
ityp&=1

if (f!*xl!)>0

    typ&=8'no conical
    return

endif

xla!=sqrt(-f!/xl!): xlb!=sqrt(-f!/xm!)

if xl!<0

    u!=xla!: xla!=xlb!: xlb!=u!
    u!=x2!: x2!=-y2!: y2!=u!
    u!=xv1!: xv1!=-yv1!: yv1!=u!

endif

xv2!=-yv1!: yv2!=xv1!
u!=sqrt(xla!*xla!-xlb!*xlb!)
xf1!=xc!+x2!*u!: yf1!=yc!+y2!*u!
xf2!=xc!-x2!*u!: yf2!=yc!-y2!*u!
ex!=u!/xla!
return