Code-Beispiel

Berechnung der Lösungen von Gleichungen 4. Grades

Lizenz:	Erster Autor:	Letzte Bearbeitung:
k. A.	FBTron	10.12.2016

Der nachfolgende Quellcode enthält 2 SUB's, die ohne Einsatz von Iterationsverfahren die Lösungen von Gleichungen 4. Grades auf "direktem Weg" berechnen.

Gemischt-quadratische Gleichungen (Gl.2.Grades) können über eine einfache Lösungsformel gelöst werden, die Lösungsformel ist recht bekannt.

Für Gleichungen 3. Grades und 4. Grades existieren ebenfalls Lösungsformeln.

Nachfolgend eine kleine Anwendung, das Beispiel läßt sich recht einfach auch zur Lösung von Gleichungen 3. Grades ändern.

'****************************************************************

' Berechnung der Lösungen x1,x2,x3,x4 einer Gleichung 4. Grades

'

'                   4        3        2        1

' Normalform:      X  + A * X  + B * X  + C * X  + D = 0

'****************************************************************



 Dim As Double  A,B,C,D, XR(1 TO 4),XI(1 To 4)

 Dim As Integer i

 Dim As String  X,Z





 Declare Sub ROOT4 (A As Double, B As Double, C As Double, D As Double, _

                    XR() As Double, XI() As Double)



Do

 Cls

 Locate 7,1

 Print "       A = "

 Print "       B = "

 Print "       C = "

 Print "       D = "



 Locate 1,1

 Print

 Print " Gleichung 4. Grades"

 Print

 Print "   4        3        2        1"

 Print "  X  + A * X  + B * X  + C * X  + D = 0"

 Print

 Input "       A =   ",A

 Input "       B =   ",B

 Input "       C =   ",C

 Input "       D =   ",D



'Löungen berechnen

'-----------------

 ROOT4(A,B,C,D,XR(),XI())



'Ausgabe der Gleichung

'---------------------

 Cls

 Print

 Print " Gleichung 4. Grades"

 Print

 Print "   4        3        2        1"

 Print "  X  + A * X  + B * X  + C * X  + D = 0"

 Print

 Print "       A = "; A

 Print "       B = "; B

 Print "       C = "; C

 Print "       D = "; D

 Print

 Print



'Ausgabe der Lösungen

'--------------------

 Print

 Print " L”sungen der Gleichung"

 For i = 1 To 4

   Print



  'Realteil ausgeben

   Print Using"      X# = ";i;

   Print XR(i);



  'Imaginärteil aufbreiten u. ausgeben

   If XI(i)<>0 Then

     If XI(i)>0 Then

       Print "  +j ";Abs(XI(i));

     Else

       Print "  -j ";Abs(XI(i));

     EndIf

   EndIf



   Print



 Next i



 Do:X=InKey:Loop While X=""

 If X = Chr$(27) Then End



Loop



End







Sub CSQR (AR As Double, _

          AI As Double, _

   ByRef  BR As Double, _

   ByRef  BI As Double)

'**************************************************

'  Das Programm CSQR berechnet die Quadratwurzel

'  einer komplexen Zahl.

'

'  Eingabe:                  Ausgabe:

'   AR,AI  kompelxe Zahl      BR,BI    Wurzel

'**************************************************

 Dim As Double A,PR,PI



 A  = SQR(AR*AR+AI*AI)

 PR = Sqr((A+AR)/2)

 PI = SQR((A-AR)/2) : If AI<0 Then PI = -PI

 BR = PR : BI = PI



End Sub







Sub ROOT3 (A As Double, B As Double, C As Double, _

           XR() As Double, XI() As Double)

'******************************************************************

'  Das Programm berechnet die Lösungen einer Gleichung 3. Grades.

'  Die Gleichung muß in Normalform vorliegen

'          3        2        1

'         X  + A * X  + B * X + C = 0

'  Eine solche Gleichung hat immer 3 Lösungen.

'******************************************************************

'  Eingaben:

'    A , B , C     Koeffizienten der Gleichung 3. Grades

'

'  Ausgaben:

'    XR(1 - 3)     Feld mit Realteilen der 3 Lösungen

'    XI(1 - 3)     Feld mit Imaginärteilen der 3 Lösungen

'******************************************************************



 Dim As Double  H,P,Q,D,W,U,V



 H = -A/3

 P = B/3-H*H

 Q = H*H*H-(H*B+C)/2

 D = Q*Q+P*P*P



 If D<0 Then



  'drei reelle Lösungen

  '--------------------

   P = 2*Sqr(-P)



   If Abs(Q) < Abs(D) Then

     W = (2*Atn(1)-Atn(Q/Sqr(-D)))/3

   Else

     W = Atn(Sqr(-D)/Q)/3

   EndIf

   XR(1) = P*Cos(W)+H

   XI(1) = 0



   W     = W+Atn(1)*8/3

   XR(2) = P*Cos(W)+H

   XI(2) = 0



   W     = W+Atn(1)*8/3

   XR(3) = P*Cos(W)+H

   XI(3) = 0



   Exit Sub

 EndIf



 D = Sqr(D)

 U = Q+D : U = Sgn(U)*Abs(U)^(1/3)

 V = Q-D : V = Sgn(V)*Abs(V)^(1/3)



'eine reelle Lösung und

'----------------------

 XR(1) = H+U+V     : XI(1) = 0



'eine konjugiert komplexe Lösung

'-------------------------------

 XR(2) = H-(U+V)/2 : XI(2) = Abs(U-V)/2*Sqr(3)

 XR(3) = XR(2)     : XI(3) = -XI(2)



End Sub







Sub ROOT4 (A As Double, B As Double, C As Double, D As Double, _

           XR() As Double, XI() As Double)

'******************************************************************

'  Das Programm  berechnet die Lösungen einer Geichung 4. Grades.

'  Die Gleichung muß in Normalform vorliegen

'                 4      3      2      1

'                X  + A X  + B X  + C X + D = 0

'  Eine solche Gleichung hat immer 4 Lösungen.

'******************************************************************

'  Eingaben:

'    A , B , C , D    Koeffizienten der Gleichung 4. Grades

'

'  Ausgaben:

'    XR(1 - 4)        Feld mit Realteilen der 4 Lösungen

'    XI(1 - 4)        Feld mit Imaginärteilen der 4 Lösungen

'

'  benötigte Unterprogramme: ROOT3 , CSQR

'******************************************************************

 Dim As Double  N,H,S,R,IV

 Dim As Double  A3,B3,C3,X1,Y1,X2,Y2,X3,Y3



 N = 2



 H = -A/N

 S = C+(B-H*H)*H

 H = H/N

 R = B-H*H*6



 A3 = R*N : If S<0 Then N = -N

 B3 = R*R-(((B-H*H*3)*H+C)*H+D)*4

 C3 = -S*S



'jetzt             3        2        1

'Gl.3.Grades   (X²) +A3*(X²) +B3*(X²) + C3 = 0

'lösen

'----------------------------------------------

 ROOT3(A3,B3,C3,XR(),XI())



'Wurzeln der drei Lösungen berechnen

'-----------------------------------

 If XI(3)=0 And XI(2)=0 Then

  'hier drei reelle Lösungen

   IV = 1

   S = Sqr(Abs(XR(1)))

   If XR(1)>=0 Then X1=S : Y1=0 Else X1=0 : Y1=S*IV : IV=-IV

   S = SQR(ABS(XR(2)))

   If XR(2)>=0 Then X2=S : Y2=0 Else X2=0 : Y2=S*IV : IV=-IV

   S = SQR(ABS(XR(3)))

   If XR(3)>=0 Then X3=S : Y3=0 Else X3=0 : Y3=S*IV

 Else

  'hier eine reelle und eine konjugiert komplexe Lösung

   X1 = XR(1)   : If X1<0 Then X1=0

   X1 = Sqr(X1) : Y1=0

   CSQR(XR(2),XI(2),X2,Y2)

   X3 = X2 : Y3 = -Y2

 EndIf



 X1 = X1/N : Y1 = Y1/N

 X2 = X2/N : Y2 = Y2/N

 X3 = X3/N : Y3 = Y3/N



'Realteil             Imaginärteil

'---------------------------------

 XR(1) = H+X1-X2+X3 : XI(1) =  Y1-Y2+Y3

 XR(2) = H+X1+X2-X3 : XI(2) =  Y1+Y2-Y3

 XR(3) = H-X1+X2+X3 : XI(3) = -Y1+Y2+Y3

 XR(4) = H-X1-X2-X3 : XI(4) = -Y1-Y2-Y3



End Sub

Zusätzliche Informationen und Funktionen

Das Code-Beispiel wurde am 22.07.2011 von FBTron angelegt.
Die aktuellste Version wurde am 10.12.2016 von FBTron gespeichert.

Bearbeiten

Versionen