Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Mathematik

Berechnung der Lösungen von Gleichungen 4. Grades

Lizenz:Erster Autor:Letzte Bearbeitung:
k. A.MitgliedFBTron 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 MitgliedFBTron angelegt.
  • Die aktuellste Version wurde am 10.12.2016 von MitgliedFBTron gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen