Mathematik mit VBA - Teil 2: komplexe Zahlen und Nullstellen ganzrationaler Funktionen

    • VBA: Sonstige

    Es gibt 25 Antworten in diesem Thema. Der letzte Beitrag () ist von Mono.

      Mathematik mit VBA - Teil 2: komplexe Zahlen und Nullstellen ganzrationaler Funktionen

      Folgende Elemente aus dem 1. Teil werden hier verwendet:
      (Mathematik mit VBA - Teil 1)

      Visual Basic-Quellcode

      1. Function Divisionsrest '(indirekt: wird von ggT benötigt)
      2. Function ggT '(wird von der Funktion Nullstellen_Array benötigt)



      Rechnen mit komplexen Zahlen

      Wenn man eine Zahl mit geradem Exponenten potenziert, erhält man als Ergebnis immer eine positive Zahl, z. B. 2²=4, (-2)²=4. Daher gibt es für eine gerade Wurzel einer negativen Zahl keine reelle Lösung. Es gibt jedoch die imaginäre Einheit i, die durch i²=-1 definiert ist.

      Eine komplexe Zahl erhält man, indem man zu einer reellen Zahl (Realteil) ein Vielfaches von i (Imaginärteil) addiert. Beispiele: 2*i (=Sqr(-4)), 1+1,5*i. In der komplexen Zahlenebene sind auf der „x-Achse“ die reellen Zahlen abgebildet, auf der „y-Achse“ die imaginären Zahlen. Realteil und Imaginärteil stellen also kartesische Koordinaten der komplexen Zahlenebene dar.

      Man kann eine komplexe Zahl aber auch durch Polarkoordinaten darstellen: Wenn man den Punkt in der Zahlenebene, der die komplexe Zahl darstellt, mit dem Null-Punkt verbindet, erhält man durch die Länge dieser Strecke den Betrag der komplexen Zahl. Der Winkel, den diese Strecke mit der positiven reellen Achse bildet, stellt das Argument der komplexen Zahl dar. Die Polarkoordinaten sind vor allem nützlich, wenn man Potenzen und Wurzeln von komplexen Zahlen berechnen will. Da für das Argument nur Winkel von 0° bis <360° (sprich 2*pi) Sinn machen, habe ich eine Funktion gemacht, die den Winkel in diesen Bereich verlagert (Winkel2pi).

      Hier zunächst grundlegende Datentypen und Funktionen:

      Visual Basic-Quellcode

      1. Type komplexK
      2. 'Typ für komplexe Zahlen mit Angabe von kartesischen Koordinaten.
      3. 'Entspricht der Form z=a+b*i (a=Realteil, b=Imaginärteil)
      4. Realteil As Double
      5. Imaginärteil As Double
      6. End Type
      8. Type komplexP
      9. 'Typ für komplexe Zahlen mit Angabe von Polarkoordinaten.
      10. 'Entspricht der Form z=r*(cos(phi)+sin(phi)*i) (r=Betrag, phi=Argument)
      11. Betrag As Double
      12. Argument As Double
      13. End Type


      Visual Basic-Quellcode

      1. Function pi() As Double
      3. pi = 4 * Atn(1)
      5. End Function
      8. Function Winkel2pi(Winkel As Double) As Double
      9. 'Sorgt dafür, dass "Winkel" im Bereich 0 <= Winkel < 2pi ist.
      11. Winkel2pi = (Winkel / (2 * pi) - Int(Winkel / (2 * pi))) * (2 * pi)
      13. End Function
      16. Function kompTextK(z As komplexK) As String
      17. 'Liefert einen String, der "z" in der Form a+b*i darstellt.
      18. '(ausgehend von kartesischen Koordinaten)
      20. Dim Text1 As String, Text2 As String, TextMitte As String
      22. If Abs(z.Realteil) < 10 ^ -15 Then z.Realteil = 0
      23. If Abs(z.Imaginärteil) < 10 ^ -15 Then z.Imaginärteil = 0
      24. If z.Realteil = 0 Then Text1 = "" Else Text1 = z.Realteil
      25. Select Case Abs(z.Imaginärteil)
      26. Case 0: Text2 = ""
      27. Case 1: Text2 = "i"
      28. Case Else: Text2 = Abs(z.Imaginärteil) & " · i"
      29. End Select
      30. Select Case Sgn(z.Imaginärteil)
      31. Case 0: TextMitte = ""
      32. Case 1: If Text1 = "" Then TextMitte = "" Else TextMitte = " + "
      33. Case -1: If Text1 = "" Then TextMitte = "-" Else TextMitte = " " & Chr(150) & " "
      34. End Select
      35. kompTextK = Text1 & TextMitte & Text2
      36. If kompTextK = "" Then kompTextK = "0"
      38. End Function
      41. Function kompTextP(z As komplexP) As String
      42. 'Liefert einen String, der "z" in der Form a+b*i darstellt.
      43. '(ausgehend von Polarkoordinaten)
      45. kompTextP = kompTextK(PnachK(z))
      47. End Function
      50. Function KnachP(z As komplexK) As komplexP
      51. 'Rechnet kartesische Koordinaten in Polarkoordinaten um.
      53. KnachP.Betrag = Sqr(z.Realteil ^ 2 + z.Imaginärteil ^ 2)
      54. If z.Realteil = 0 And z.Imaginärteil = 0 Then
      55. KnachP.Argument = Empty
      56. ElseIf z.Imaginärteil = 0 Then
      57. If z.Realteil > 0 Then KnachP.Argument = 0 Else KnachP.Argument = pi
      58. ElseIf z.Realteil = 0 Then
      59. If z.Imaginärteil > 0 Then KnachP.Argument = pi / 2 Else KnachP.Argument = pi * 3 / 2
      60. Else
      61. KnachP.Argument = Atn(z.Imaginärteil / z.Realteil)
      62. If z.Realteil < 0 Then KnachP.Argument = KnachP.Argument + pi
      63. KnachP.Argument = Winkel2pi(KnachP.Argument)
      64. End If
      66. End Function
      69. Function PnachK(z As komplexP) As komplexK
      70. 'Rechnet Polarkoordinaten in kartesische Koordinaten um.
      72. If z.Betrag < 0 Then MsgBox "Ungültiger Parameterwert", vbCritical: Stop
      73. If z.Betrag = 0 Then
      74. PnachK.Realteil = 0
      75. PnachK.Imaginärteil = 0
      76. Else
      77. PnachK.Realteil = z.Betrag * Cos(z.Argument)
      78. PnachK.Imaginärteil = z.Betrag * Sin(z.Argument)
      79. End If
      81. End Function
      84. Function konjugiertK(z As komplexK) As komplexK
      85. 'Liefert die konjugiert komplexe Zahl zu "z".
      87. konjugiertK.Realteil = z.Realteil
      88. konjugiertK.Imaginärteil = -z.Imaginärteil
      90. End Function
      93. Function konjugiertP(z As komplexP) As komplexP
      94. 'Liefert die konjugiert komplexe Zahl zu "z".
      96. konjugiertP = KnachP(konjugiertK(PnachK(z)))
      98. End Function

      Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von „roddy“ ()

      Hier Rechenoperationen unter Verwendung von kartesischen Koordinaten:

      Visual Basic-Quellcode

      1. Function kompAddK(z1 As komplexK, z2 As komplexK) As komplexK
      2. 'Addiert "z1" mit "z2" (kartesiche Koordinaten).
      4. kompAddK.Realteil = z1.Realteil + z2.Realteil
      5. kompAddK.Imaginärteil = z1.Imaginärteil + z2.Imaginärteil
      7. End Function
      10. Function kompSubtrK(z1 As komplexK, z2 As komplexK) As komplexK
      11. 'Subtrahiert "z2" von "z1" (kartesiche Koordinaten).
      13. kompSubtrK.Realteil = z1.Realteil - z2.Realteil
      14. kompSubtrK.Imaginärteil = z1.Imaginärteil - z2.Imaginärteil
      16. End Function
      19. Function kompMultK(z1 As komplexK, z2 As komplexK) As komplexK
      20. 'Multipliziert "z1" mit "z2" (kartesiche Koordinaten).
      22. kompMultK.Realteil = z1.Realteil * z2.Realteil - z1.Imaginärteil * z2.Imaginärteil
      23. kompMultK.Imaginärteil = z1.Realteil * z2.Imaginärteil + z2.Realteil * z1.Imaginärteil
      25. End Function
      28. Function kompDivK(z1 As komplexK, z2 As komplexK) As komplexK
      29. 'Dividiert "z1" durch "z2" (kartesiche Koordinaten).
      31. kompDivK.Realteil = (z1.Realteil * z2.Realteil + z1.Imaginärteil * z2.Imaginärteil) / (z2.Realteil ^ 2 + z2.Imaginärteil ^ 2)
      32. kompDivK.Imaginärteil = (z1.Imaginärteil * z2.Realteil - z1.Realteil * z2.Imaginärteil) / (z2.Realteil ^ 2 + z2.Imaginärteil ^ 2)
      34. End Function
      37. Function kompPotenzK(z As komplexK, Exponent As Double) As komplexK
      38. 'Potenziert "z" mit "Exponent" (kartesische Koordinaten).
      40. kompPotenzK = PnachK(kompPotenzP(KnachP(z), Exponent))
      42. End Function
      45. Function kompWurzelK(z As komplexK, n As Integer) As komplexK()
      46. 'Liefert die "n"-ten Wurzeln von "z" (kartesische Koordinaten).
      48. Dim wP() As komplexP, wK() As komplexK, k As Integer
      50. wP = kompWurzelP(KnachP(z), n)
      51. ReDim wK(UBound(wP))
      52. For k = 0 To UBound(wP)
      53. wK(k) = PnachK(wP(k))
      54. Next
      55. kompWurzelK = wK
      57. End Function


      Und hier Rechenoperationen unter Verwendung von Polarkoordinaten:

      Visual Basic-Quellcode

      1. Function kompAddP(z1 As komplexP, z2 As komplexP) As komplexP
      2. 'Addiert "z1" mit "z2" (Polarkoordinaten).
      4. kompAddP = KnachP(kompAddK(PnachK(z1), PnachK(z2)))
      6. End Function
      9. Function kompSubtrP(z1 As komplexP, z2 As komplexP) As komplexP
      10. 'Subtrahiert "z2" von "z1" (Polarkoordinaten).
      12. kompSubtrP = KnachP(kompSubtrK(PnachK(z1), PnachK(z2)))
      14. End Function
      17. Function kompMultP(z1 As komplexP, z2 As komplexP) As komplexP
      18. 'Multipliziert "z1" mit "z2" (Polarkoordinaten).
      20. If z1.Betrag < 0 Or z2.Betrag < 0 Then MsgBox "Ungültiger Parameterwert", vbCritical: Stop
      21. kompMultP.Betrag = z1.Betrag * z2.Betrag
      22. If z1.Betrag = 0 Or z2.Betrag = 0 Then
      23. kompMultP.Argument = Empty
      24. Else
      25. kompMultP.Argument = Winkel2pi(Winkel2pi(z1.Argument) + Winkel2pi(z2.Argument))
      26. End If
      28. End Function
      31. Function kompDivP(z1 As komplexP, z2 As komplexP) As komplexP
      32. 'Dividiert "z1" durch "z2" (Polarkoordinaten).
      34. If z1.Betrag < 0 Or z2.Betrag < 0 Then MsgBox "Ungültiger Parameterwert", vbCritical: Stop
      35. kompDivP.Betrag = z1.Betrag / z2.Betrag
      36. If z1.Betrag = 0 Or z2.Betrag = 0 Then
      37. kompDivP.Argument = Empty
      38. Else
      39. kompDivP.Argument = Winkel2pi(Winkel2pi(z1.Argument) - Winkel2pi(z2.Argument))
      40. End If
      42. End Function
      45. Function kompPotenzP(z As komplexP, Exponent As Double) As komplexP
      46. 'Potenziert "z" mit "Exponent" (Polarkoordinaten).
      48. If z.Betrag < 0 Then MsgBox "Ungültiger Parameterwert", vbCritical: Stop
      49. kompPotenzP.Betrag = z.Betrag ^ Exponent
      50. If z.Betrag = 0 Then
      51. kompPotenzP.Argument = Empty
      52. Else
      53. kompPotenzP.Argument = Winkel2pi(Winkel2pi(z.Argument) * Exponent)
      54. End If
      56. End Function
      59. Function kompWurzelP(z As komplexP, n As Integer) As komplexP()
      60. 'Liefert die "n"-ten Wurzeln von "z" (Polarkoordinaten).
      62. Dim w() As komplexP, k As Integer
      64. If z.Betrag < 0 Or n = 0 Then MsgBox "Ungültiger Parameterwert", vbCritical: Stop
      65. ReDim w(Abs(n) - 1)
      66. For k = 0 To Abs(n) - 1
      67. w(k).Betrag = z.Betrag ^ (1 / n)
      68. If z.Betrag = 0 Then
      69. w(k).Argument = Empty
      70. Else
      71. w(k).Argument = Winkel2pi((Winkel2pi(z.Argument) + k * 2 * pi) / n)
      72. End If
      73. Next
      74. kompWurzelP = w
      76. End Function

      Nullstellen, Extremstellen und Wendepunkte von ganzrationalen Funktionen beliebigen Grades

      Um die Nullstellen von Funktionen bis 4. Grades zu berechnen, habe ich eigene Funktionen (Nullstellen0 bis Nullstellen4).

      Mit der Funktion „Nullstellen_ParamArray“ kann man die Koeffizienten in der Reihenfolge a0, a1, a2, … eingeben. Man kann auch die Funktion als Text eingeben. Beispiel: Nullstellen("5x^2-4x+3") liefert ein Array mit den Nullstellen der Funktion. Als Koeffizienten kann man auch Brüche eingeben, z. B. Nullstellen("1/2x^2-5/6x"). Bei diesen beiden Funktionen werden zunächst die Nullstellen mit x=0 abgespalten, wodurch der Grad der Funktion evtl. verringert wird (3x^3+5x^2 hat beispielsweise eine doppelte Nullstelle bei x=0; für die weitere Berechnung der Nullstellen braucht man nur noch 3x+5 betrachten). Danach wird noch ggf. eine Substitution durchgeführt. Bei 3x^4+2x^2-5 kann man x durch z^2 ersetzen, was Folgendes ergibt: 3z^2+2z-5. Von den sich daraus ergebenden Nullstellen braucht man dann jeweils nur die beiden Quadratwurzeln ziehen und hat dann die Nullstellen der Ausgangsfunktion.

      Ist der so entstandene Term (nach Substitution) ein Polynom vom Grad 0 bis 4, wird die entsprechende Funktion angewandt, z. B. Nullstellen2. Ist der Grad höher, wird solange durch Iteration eine Nullstelle bestimmt und diese abgespalten, bis der Grad 4 oder kleiner ist.

      Es werden alle Nullstellen (also auch komplexe) bestimmt. Bei einer ganzrationalen Funktion entspricht die Anzahl der Nullstellen dem Grad. Da dort komplexe Nullstellen immer paarweise mit der dazu konjugierten komplexen Zahl auftreten (z. B. 1+2i und 1-2i), wird dies beim Iterationsverfahren entsprechend berücksichtigt.

      Die Funktionen „KurvDisk_ParamArray“ und „Kurvendiskussion“, bei denen die Parameter so wie bei „Nullstellen_ParamArray“ bzw. „Nullstellen“ eingegeben werden, liefern einen String, der die Nullstellen, Extremstellen (Maxima, Minima, Sattelpunkte) und Wendepunkte auflistet.

      Visual Basic-Quellcode

      1. Enum NullstellenTyp
      2. mNullstelle = 0
      3. mMaximum = 1
      4. mMinimum = 2
      5. mSattelpunkt = 3
      6. mWendepunkt = 4
      7. End Enum
      10. Type ExtremwertTyp
      11. relMaxima() As komplexK
      12. relMinima() As komplexK
      13. Sattelpunkte() As komplexK
      14. End Type


      Visual Basic-Quellcode

      1. Function KoeffAusText(Funktion As String) As Double()
      2. 'Erstellt ein Koeffizientenarray aus einem Text der Form
      3. '45x^5-3,5x^2+2x-1 (Beispiel);
      4. '45x5-3,5x2+2x-1 (anderes Beispiel).
      5. '1/2x^2-x+5 (anderes Beispiel).
      7. Dim Text As String, Summanden() As String, i As Integer
      8. Dim Trennung() As String, Bruch() As String
      9. Dim koeff() As Double, Index As Integer
      11. ReDim koeff(0)
      12. Text = Replace(Replace(Replace(Funktion, " ", ""), "-", "+-"), "^", "")
      13. If Left(Text, 1) = "+" Then Text = Mid(Text, 2)
      14. If Text <> "" Then
      15. Summanden = Split(Text, "+")
      16. For i = 0 To UBound(Summanden)
      17. Trennung = Split(Summanden(i), "x")
      18. If UBound(Trennung) = 0 Then
      19. Index = 0
      20. Else
      21. If Trennung(1) = "" Then
      22. Index = 1
      23. Else
      24. If Not IsNumeric(Trennung(1)) Then
      25. MsgBox "Syntaxfehler!" & vbCrLf & vbCrLf & Summanden(i), vbCritical
      26. Stop
      27. ElseIf CInt(Trennung(1)) <> CDbl(Trennung(1)) Then
      28. MsgBox "Die Exponenten müssen ganzzahlig sein!" _
      29. & vbCrLf & vbCrLf & Summanden(i), vbCritical
      30. Stop
      31. Else
      32. Index = Trennung(1)
      33. If Index < 0 Then
      34. MsgBox "Die Exponenten dürfen nicht negativ sein!" _
      35. & vbCrLf & vbCrLf & Summanden(i), vbCritical
      36. Stop
      37. End If
      38. End If
      39. End If
      40. End If
      41. If UBound(koeff) < Index Then
      42. ReDim Preserve koeff(Index)
      43. End If
      44. If Trennung(0) = "" Then Trennung(0) = "1"
      45. If InStr(1, Trennung(0), "/") > 0 Then
      46. Bruch = Split(Trennung(0), "/")
      47. If UBound(Bruch) > 1 _
      48. Or Not IsNumeric(Bruch(0)) Or Not IsNumeric(Bruch(1)) Then
      49. MsgBox "Syntaxfehler!" & vbCrLf & vbCrLf & Summanden(i), vbCritical
      50. Stop
      51. End If
      52. Trennung(0) = Bruch(0) / Bruch(1)
      53. End If
      54. If Not IsNumeric(Trennung(0)) Then
      55. MsgBox "Syntaxfehler!" & vbCrLf & vbCrLf & Summanden(i), vbCritical
      56. Stop
      57. Else
      58. koeff(Index) = Trennung(0)
      59. End If
      60. Next
      61. End If
      62. KoeffAusText = koeff
      64. End Function
      67. Function NullstSort(x() As komplexK) As komplexK()
      68. 'Sortiert die Nullstellen.
      70. Dim i As Integer, j As Integer, k As Integer, z As komplexK
      72. If UBound(x) > 0 Then
      73. For i = 1 To UBound(x)
      74. For j = 1 To i - 1
      75. If x(i).Realteil < x(j).Realteil _
      76. Or (x(i).Realteil = x(j).Realteil And x(i).Imaginärteil < x(j).Imaginärteil) Then
      77. z = x(i)
      78. For k = i To j + 1 Step -1
      79. x(k) = x(k - 1)
      80. Next
      81. x(j) = z
      82. End If
      83. Next
      84. Next
      85. End If
      86. NullstSort = x
      88. End Function

      Visual Basic-Quellcode

      1. Function NullstellenListe(x() As komplexK, Typ As NullstellenTyp) As String
      2. 'Liefert einen String, in dem die Nullstellen aufgelistet sind.
      4. Dim i As Integer, Text As String
      6. If UBound(x) = 1 Then
      7. Select Case Typ
      8. Case mNullstelle: Text = "Nullstelle"
      9. Case mMaximum: Text = "relatives Maximum"
      10. Case mMinimum: Text = "relatives Minimum"
      11. Case mSattelpunkt: Text = "Sattelpunkt"
      12. Case mWendepunkt: Text = "Wendepunkt"
      13. End Select
      14. Else
      15. Select Case Typ
      16. Case mNullstelle: Text = "Nullstellen"
      17. Case mMaximum: Text = "relative Maxima"
      18. Case mMinimum: Text = "relative Minima"
      19. Case mSattelpunkt: Text = "Sattelpunkte"
      20. Case mWendepunkt: Text = "Wendepunkte"
      21. End Select
      22. End If
      23. Select Case UBound(x)
      24. Case -1: NullstellenListe = "unendlich viele " & Text
      25. Case 0: NullstellenListe = "keine " & Text
      26. Case Else
      27. NullstellenListe = UBound(x) & " " & Text & ":" & vbCrLf
      28. For i = 1 To UBound(x)
      29. NullstellenListe = NullstellenListe & vbCrLf & kompTextK(x(i))
      30. Next
      31. End Select
      33. End Function
      36. Function FWert(x As komplexK, Koeffizienten() As Double) As komplexK
      37. 'Liefert den Funktionswert der Funktion mit den "Koeffizienten" an der Stelle "x".
      39. Dim i As Double, koeff As komplexK
      41. FWert.Realteil = 0
      42. FWert.Imaginärteil = 0
      43. For i = 0 To UBound(Koeffizienten)
      44. koeff.Realteil = Koeffizienten(i)
      45. koeff.Imaginärteil = 0
      46. FWert = kompAddK(FWert, kompMultK(koeff, kompPotenzK(x, i)))
      47. Next
      49. End Function
      52. Function Nullstellen0(c As Double) As komplexK()
      53. 'Legt die Anzahl der Nullstellen für eine Funktion der Form f(x)=c fest.
      54. '(-1 steht in diesem Fall für unendlich.)
      56. Dim x() As komplexK
      58. If c = 0 Then ReDim x(-1 To -1) Else ReDim x(0)
      59. Nullstellen0 = x
      61. End Function
      64. Function Nullstellen1(m As Double, b As Double) As komplexK()
      65. 'Liefert die Nullstelle für eine Funktion der Form f(x)=mx+b.
      67. Dim x(1 To 1) As komplexK
      69. If m = 0 Then
      70. Nullstellen1 = Nullstellen0(b)
      71. Else
      72. x(1).Realteil = -b / m
      73. x(1).Imaginärteil = 0
      74. Nullstellen1 = NullstSort(x)
      75. End If
      77. End Function
      80. Function Nullstellen2(a As Double, b As Double, c As Double) As komplexK()
      81. 'Liefert die Nullstellen für eine Funktion der Form f(x)=ax^2+bx+c.
      83. Dim x(1 To 2) As komplexK
      84. Dim Radikand As komplexK, Wurzeln() As komplexK
      85. Dim i As Integer, Summand As komplexK, Nenner As komplexK
      87. If a = 0 Then
      88. Nullstellen2 = Nullstellen1(b, c)
      89. Else
      90. Radikand.Realteil = b ^ 2 - 4 * a * c
      91. Radikand.Imaginärteil = 0
      92. Wurzeln = kompWurzelK(Radikand, 2)
      93. Summand.Realteil = -b
      94. Summand.Imaginärteil = 0
      95. Nenner.Realteil = 2 * a
      96. Nenner.Imaginärteil = 0
      97. For i = 1 To 2
      98. x(i) = kompDivK(kompAddK(Summand, Wurzeln(i - 1)), Nenner)
      99. Next
      100. Nullstellen2 = NullstSort(x)
      101. End If
      103. End Function

      Visual Basic-Quellcode

      1. Function Nullstellen3(a As Double, b As Double, c As Double, d As Double) As komplexK()
      2. 'Liefert die Nullstellen für eine Funktion der Form f(x)=ax^3+bx^2+cx+d.
      4. Dim x(1 To 3) As komplexK, y(1 To 3) As komplexK
      5. Dim r As Double, s As Double, t As Double
      6. Dim p As Double, q As Double, Radikand As Double
      7. Dim uRadikand As Double, vRadikand As Double
      8. Dim u(1 To 3) As komplexK, v(1 To 3) As komplexK
      9. Dim uvRadikand As komplexP, arg As Double
      10. Dim Wurzeln() As komplexK, i As Integer
      11. Dim Abzug As komplexK
      13. If a = 0 Then
      14. Nullstellen3 = Nullstellen2(b, c, d)
      15. Else
      16. 'auf Normalform bringen: x^3+rx^2+sx+t=0
      17. r = b / a
      18. s = c / a
      19. t = d / a
      20. 'reduzierte kubische Gleichung: x=y-r/3 -> y^3+py+q=0
      21. p = s - r ^ 2 / 3
      22. q = 2 * r ^ 3 / 27 - s * r / 3 + t
      23. If q = 0 Then
      24. y(1).Realteil = 0
      25. y(1).Imaginärteil = 0
      26. Wurzeln = Nullstellen2(1, 0, p)
      27. For i = 2 To 3
      28. y(i) = Wurzeln(i - 1)
      29. Next
      30. Else
      31. Radikand = (q / 2) ^ 2 + (p / 3) ^ 3
      32. If Radikand >= 0 Then
      33. uRadikand = -q / 2 + Sqr(Radikand)
      34. vRadikand = -q / 2 - Sqr(Radikand)
      35. u(1).Realteil = Sgn(uRadikand) * Abs(uRadikand) ^ (1 / 3)
      36. u(1).Imaginärteil = 0
      37. v(1).Realteil = Sgn(vRadikand) * Abs(vRadikand) ^ (1 / 3)
      38. v(1).Imaginärteil = 0
      39. u(2).Realteil = -u(1).Realteil / 2
      40. u(2).Imaginärteil = u(1).Realteil * Sqr(3)
      41. v(2).Realteil = -v(1).Realteil / 2
      42. v(2).Imaginärteil = v(1).Realteil * Sqr(3)
      43. u(3).Realteil = -u(1).Realteil / 2
      44. u(3).Imaginärteil = -u(1).Realteil * Sqr(3)
      45. v(3).Realteil = -v(1).Realteil / 2
      46. v(3).Imaginärteil = -v(1).Realteil * Sqr(3)
      47. Else
      48. uvRadikand.Betrag = Sqr(-p ^ 3 / 27)
      49. arg = -q / (2 * uvRadikand.Betrag)
      50. uvRadikand.Argument = Atn(-arg / Sqr(-arg * arg + 1)) + 2 * Atn(1)
      51. Wurzeln = kompWurzelK(PnachK(uvRadikand), 3)
      52. For i = 1 To 3
      53. u(i).Realteil = Wurzeln(i - 1).Realteil
      54. u(i).Imaginärteil = 0
      55. v(i).Realteil = Wurzeln(i - 1).Realteil
      56. v(i).Imaginärteil = 0
      57. Next
      58. End If
      59. For i = 1 To 3
      60. y(i) = kompAddK(u(i), v(i))
      61. Next
      62. End If
      63. Abzug.Realteil = r / 3
      64. Abzug.Imaginärteil = 0
      65. For i = 1 To 3
      66. x(i) = kompSubtrK(y(i), Abzug)
      67. Next
      68. Nullstellen3 = NullstSort(x)
      69. End If
      71. End Function
      74. Function Nullstellen4(a4 As Double, a3 As Double, a2 As Double, a1 As Double, a0 As Double) As komplexK()
      75. 'Liefert die Nullstellen für eine Funktion der Form f(x)=a4x^4+a3x^3+a2x^2+a1x+a0.
      77. Dim x(1 To 4) As komplexK
      78. Dim a As Double, b As Double, c As Double, d As Double
      79. Dim Wurzeln() As komplexK, i As Integer, Index As Integer
      80. Dim y1 As Double, A12(1 To 2) As Double
      82. If a4 = 0 Then
      83. Nullstellen4 = Nullstellen3(a3, a2, a1, a0)
      84. Else
      85. 'auf Normalform bringen: x^4+ax^3+bx^2+cx+d=0
      86. a = a3 / a4
      87. b = a2 / a4
      88. c = a1 / a4
      89. d = a0 / a4
      90. 'kubische Gleichung: y^3-by^2+(ca-4d)y+4bd-da^2-c^2=0
      91. Wurzeln = Nullstellen3(1, -b, c * a - 4 * d, 4 * b * d - d * a ^ 2 - c ^ 2)
      92. Index = 1
      93. For i = 2 To 3
      94. If Abs(Wurzeln(i).Imaginärteil) < Abs(Wurzeln(Index).Imaginärteil) Then Index = i
      95. If Abs(Wurzeln(i).Imaginärteil) = Abs(Wurzeln(Index).Imaginärteil) _
      96. And Wurzeln(i).Realteil > Wurzeln(Index).Realteil Then Index = i
      97. Next
      98. y1 = Wurzeln(Index).Realteil
      99. A12(1) = Sqr(4 * y1 + a ^ 2 - 4 * b)
      100. A12(2) = -A12(1)
      101. For i = 1 To 2
      102. Wurzeln = Nullstellen2(1, (a + A12(i)) / 2, (y1 + (a * y1 - 2 * c) / A12(i)) / 2)
      103. x(2 * i - 1) = Wurzeln(1)
      104. x(2 * i) = Wurzeln(2)
      105. Next
      106. Nullstellen4 = NullstSort(x)
      107. End If
      109. End Function

      Visual Basic-Quellcode

      1. Function Ableitung(Koeffizienten() As Double) As Double()
      2. 'Liefert die Ableitung der Funktion mit den "Koeffizienten".
      4. Dim koeff() As Double, i As Integer
      6. If UBound(Koeffizienten) = 0 Then
      7. ReDim koeff(0)
      8. koeff(0) = 0
      9. Else
      10. ReDim koeff(UBound(Koeffizienten) - 1)
      11. For i = 0 To UBound(koeff)
      12. koeff(i) = (i + 1) * Koeffizienten(i + 1)
      13. Next
      14. End If
      15. Ableitung = koeff
      17. End Function
      20. Function AbspaltungReell(Nullstelle As Double, Koeffizienten() As Double) As Double()
      21. 'Spaltet eine reelle Nullstelle von der Funktion mit den "Koeffizienten" ab (Polynomdivision).
      23. Dim koeff() As Double, i As Integer, Rest As Double
      25. ReDim koeff(UBound(Koeffizienten) - 1)
      26. koeff(UBound(koeff)) = Koeffizienten(UBound(Koeffizienten))
      27. For i = UBound(koeff) - 1 To 0 Step -1
      28. koeff(i) = Koeffizienten(i + 1) + koeff(i + 1) * Nullstelle
      29. Next
      30. Rest = Koeffizienten(0) + koeff(0) * Nullstelle
      31. If Abs(Rest) > 10 ^ -15 Then
      32. If MsgBox(Nullstelle & vbCrLf & "ist keine Nullstelle:" & vbCrLf & vbCrLf _
      33. & "Divisionsrest: " & Rest & vbCrLf & vbCrLf _
      34. & "Soll die Nullstelle akzeptiert werden?", vbCritical + vbYesNo) = vbNo Then Stop
      35. End If
      36. AbspaltungReell = koeff
      38. End Function
      41. Function AbspaltungKomplex(Nullstelle As komplexK, Koeffizienten() As Double) As Double()
      42. 'Spaltet eine komplexe Nullstelle von der Funktion mit den "Koeffizienten" ab (Polynomdivision).
      44. Dim koeff() As Double, i As Integer, Rest As Double
      46. ReDim koeff(UBound(Koeffizienten) - 2)
      47. koeff(UBound(koeff)) = Koeffizienten(UBound(Koeffizienten))
      48. koeff(UBound(koeff) - 1) = _
      49. Koeffizienten(UBound(Koeffizienten) - 1) + 2 * koeff(UBound(koeff)) * Nullstelle.Realteil
      50. For i = UBound(koeff) - 2 To 0 Step -1
      51. koeff(i) = Koeffizienten(i + 2) _
      52. - koeff(i + 2) * (Nullstelle.Realteil ^ 2 + Nullstelle.Imaginärteil ^ 2) _
      53. + 2 * koeff(i + 1) * Nullstelle.Realteil
      54. Next
      55. Rest = Koeffizienten(1) _
      56. - koeff(1) * (Nullstelle.Realteil ^ 2 + Nullstelle.Imaginärteil ^ 2) _
      57. + 2 * koeff(0) * Nullstelle.Realteil
      58. If Abs(Rest) > 10 ^ -15 Then
      59. If MsgBox(kompTextK(Nullstelle) & vbCrLf & kompTextK(konjugiertK(Nullstelle)) & vbCrLf _
      60. & "sind keine Nullstellen:" & vbCrLf & vbCrLf & "Divisionsrest: " & Rest & vbCrLf & vbCrLf _
      61. & "Soll die Nullstelle akzeptiert werden?", vbCritical + vbYesNo) = vbNo Then Stop
      62. End If
      63. AbspaltungKomplex = koeff
      65. End Function
      68. Function NullstIteration(Startwert As komplexK, Koeffizienten() As Double) As komplexK
      69. 'Liefert eine Nullstelle der Funktion mit den "Koeffizienten",
      70. 'gewonnen durch Iteration, ausgehend vom "Startwert".
      72. Dim i As Integer, AblKoeff() As Double, AblWert As komplexK
      73. Dim x0 As komplexK, x1 As komplexK, neuerStart As komplexK
      75. x0 = Startwert
      76. AblKoeff = Ableitung(Koeffizienten)
      77. AblWert = FWert(x0, Ableitung(Koeffizienten))
      78. If AblWert.Realteil <> 0 Or AblWert.Imaginärteil <> 0 Then
      79. For i = 1 To 100
      80. x1 = kompSubtrK(x0, kompDivK(FWert(x0, Koeffizienten), FWert(x0, AblKoeff)))
      81. If Abs(x1.Realteil - x0.Realteil) < 10 ^ -15 And Abs(x1.Imaginärteil - x0.Imaginärteil) < 10 ^ -15 Then
      82. NullstIteration = x1
      83. Exit Function
      84. End If
      85. x0 = x1
      86. Next
      87. End If
      88. If Startwert.Imaginärteil = 0 Then
      89. neuerStart.Realteil = Startwert.Realteil
      90. neuerStart.Imaginärteil = 1
      91. Else
      92. neuerStart.Realteil = Startwert.Realteil + 1
      93. neuerStart.Imaginärteil = 0
      94. End If
      95. NullstIteration = NullstIteration(neuerStart, Koeffizienten)
      97. End Function

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „roddy“ ()

      Visual Basic-Quellcode

      1. Function Nullstellen_Array(Koeffizienten() As Double) As komplexK()
      2. 'Ermittelt die Nullstellen der Funktion mit den "Koeffizienten".
      4. Dim koeff() As Double, x() As komplexK, Index As Integer
      5. Dim i As Integer, SubstExp As Integer
      6. Dim koeff0() As Double, x0() As komplexK, Index0 As Integer
      7. Dim Startwert As komplexK
      8. Dim x1() As komplexK, Wurzeln() As komplexK, j As Integer
      10. koeff = Koeffizienten
      11. If UBound(koeff) = 0 Then
      12. Nullstellen_Array = Nullstellen0(koeff(0))
      13. Exit Function
      14. End If
      15. ReDim x(1 To UBound(koeff))
      16. Index = 0
      17. 'Abspaltung der Nullstellen mit x=0:
      18. While koeff(0) = 0
      19. If Index = UBound(x) Then
      20. Nullstellen_Array = Nullstellen0(0)
      21. Exit Function
      22. End If
      23. Index = Index + 1
      24. x(Index).Realteil = 0
      25. x(Index).Imaginärteil = 0
      26. koeff = AbspaltungReell(0, koeff)
      27. Wend
      28. 'Substitution mit z=x^SubstExp
      29. SubstExp = 0
      30. For i = 1 To UBound(koeff)
      31. If koeff(i) <> 0 Then
      32. If SubstExp = 0 Then
      33. SubstExp = i
      34. Else
      35. SubstExp = ggT(SubstExp, i)
      36. End If
      37. If SubstExp = 1 Then Exit For
      38. End If
      39. Next
      40. If SubstExp <= 1 Then
      41. koeff0 = koeff
      42. Else
      43. ReDim koeff0(UBound(koeff) / SubstExp)
      44. For i = 0 To UBound(koeff0)
      45. koeff0(i) = koeff(i * SubstExp)
      46. Next
      47. End If
      48. If UBound(koeff0) > 0 Then
      49. ReDim x0(1 To UBound(koeff0))
      50. Index0 = 0
      51. Startwert.Realteil = 0
      52. Startwert.Imaginärteil = 0
      53. While UBound(koeff0) > 4
      54. Index0 = Index0 + 1
      55. x0(Index0) = NullstIteration(Startwert, koeff0)
      56. If Abs(x0(Index0).Imaginärteil) < 10 ^ -15 Then
      57. koeff0 = AbspaltungReell(x0(Index0).Realteil, koeff0)
      58. Else
      59. Index0 = Index0 + 1
      60. x0(Index0) = konjugiertK(x0(Index0 - 1))
      61. koeff0 = AbspaltungKomplex(x0(Index0), koeff0)
      62. End If
      63. Wend
      64. Select Case UBound(koeff0)
      65. Case 4: x1 = Nullstellen4(koeff0(4), koeff0(3), koeff0(2), koeff0(1), koeff0(0))
      66. Case 3: x1 = Nullstellen3(koeff0(3), koeff0(2), koeff0(1), koeff0(0))
      67. Case 2: x1 = Nullstellen2(koeff0(2), koeff0(1), koeff0(0))
      68. Case 1: x1 = Nullstellen1(koeff0(1), koeff0(0))
      69. Case 0: x1 = Nullstellen0(koeff0(0))
      70. End Select
      71. For i = 1 To UBound(x1)
      72. Index0 = Index0 + 1
      73. x0(Index0) = x1(i)
      74. Next
      75. If Index0 <> UBound(x0) Then Stop
      76. For i = 1 To UBound(x0)
      77. Wurzeln = kompWurzelK(x0(i), SubstExp)
      78. For j = 1 To SubstExp
      79. Index = Index + 1
      80. x(Index) = Wurzeln(j - 1)
      81. Next
      82. Next
      83. End If
      84. If Index <> UBound(x) Then Stop
      85. Nullstellen_Array = NullstSort(x)
      87. End Function
      90. Function Nullstellen_ParamArray(ParamArray Koeffizienten() As Variant) As komplexK()
      91. 'Liefert die Nullstellen der Funktion mit den "Koeffizienten"
      93. Dim koeff() As Double, i As Integer
      95. ReDim koeff(UBound(Koeffizienten))
      96. For i = 0 To UBound(koeff)
      97. koeff(i) = Koeffizienten(i)
      98. Next
      99. Nullstellen_ParamArray = Nullstellen_Array(koeff)
      101. End Function
      104. Function Nullstellen(Funktion As String) As komplexK()
      105. 'Liefert die Nullstellen der "Funktion" der Form
      106. '45x^5-3,5x^2+2x-1 (Beispiel);
      107. '45x5-3,5x2+2x-1 (anderes Beispiel).
      109. Nullstellen = Nullstellen_Array(KoeffAusText(Funktion))
      111. End Function

      Visual Basic-Quellcode

      1. Function Extremstellen(Koeffizienten() As Double) As ExtremwertTyp
      2. 'Liefert die Extremstellen der Funktion mit den "Koeffizienten"
      4. Dim Ableitung1() As Double, Ableitung2() As Double
      5. Dim Extreme() As komplexK, Sammlung As ExtremwertTyp, i As Integer
      7. Ableitung1 = Ableitung(Koeffizienten)
      8. Ableitung2 = Ableitung(Ableitung1)
      9. Extreme = Nullstellen_Array(Ableitung1)
      10. With Sammlung
      11. ReDim .relMaxima(0), .relMinima(0), .Sattelpunkte(0)
      12. If UBound(Extreme) = -1 Then ReDim .Sattelpunkte(-1 To -1)
      13. For i = 1 To UBound(Extreme)
      14. Select Case Sgn(FWert(Extreme(i), Ableitung2).Realteil)
      15. Case -1
      16. If UBound(.relMaxima) = 0 Then
      17. ReDim .relMaxima(1)
      18. Else
      19. ReDim Preserve .relMaxima(UBound(.relMaxima) + 1)
      20. End If
      21. .relMaxima(UBound(.relMaxima)) = Extreme(i)
      22. Case 1
      23. If UBound(.relMinima) = 0 Then
      24. ReDim .relMinima(1)
      25. Else
      26. ReDim Preserve .relMinima(UBound(.relMinima) + 1)
      27. End If
      28. .relMinima(UBound(.relMinima)) = Extreme(i)
      29. Case 0
      30. If UBound(.Sattelpunkte) = 0 Then
      31. ReDim .Sattelpunkte(1)
      32. Else
      33. ReDim Preserve .Sattelpunkte(UBound(.Sattelpunkte) + 1)
      34. End If
      35. .Sattelpunkte(UBound(.Sattelpunkte)) = Extreme(i)
      36. End Select
      37. Next
      38. End With
      39. Extremstellen = Sammlung
      41. End Function
      44. Function Wendepunkte(Koeffizienten() As Double) As komplexK()
      45. 'Liefert die Wendepunkte der Funktion mit den "Koeffizienten"
      47. Wendepunkte = Nullstellen_Array(Ableitung(Ableitung(Koeffizienten)))
      49. End Function
      52. Function KurvDisk_Array(Koeffizienten() As Double) As String
      53. 'Liefert eine Liste mit Nullstellen, Extremstellen und Wendepunkten
      55. Dim Extreme As ExtremwertTyp
      57. KurvDisk_Array = NullstellenListe(Nullstellen_Array(Koeffizienten), mNullstelle)
      58. Extreme = Extremstellen(Koeffizienten)
      59. KurvDisk_Array = KurvDisk_Array & vbCrLf & vbCrLf & NullstellenListe(Extreme.relMaxima, mMaximum)
      60. KurvDisk_Array = KurvDisk_Array & vbCrLf & vbCrLf & NullstellenListe(Extreme.relMinima, mMinimum)
      61. KurvDisk_Array = KurvDisk_Array & vbCrLf & vbCrLf & NullstellenListe(Extreme.Sattelpunkte, mSattelpunkt)
      62. KurvDisk_Array = KurvDisk_Array & vbCrLf & vbCrLf & NullstellenListe(Wendepunkte(Koeffizienten), mWendepunkt)
      64. End Function
      67. Function KurvDisk_ParamArray(ParamArray Koeffizienten() As Variant) As String
      68. 'Liefert eine Liste mit Nullstellen, Extremstellen und Wendepunkten
      70. Dim koeff() As Double, i As Integer
      72. ReDim koeff(UBound(Koeffizienten))
      73. For i = 0 To UBound(koeff)
      74. koeff(i) = Koeffizienten(i)
      75. Next
      76. KurvDisk_ParamArray = KurvDisk_Array(koeff)
      78. End Function
      81. Function Kurvendiskussion(Funktion As String) As String
      82. 'Liefert eine Liste mit Nullstellen, Extremstellen und Wendepunkten
      83. 'aufgrund eines Textes der Form
      84. '45x^5-3,5x^2+2x-1 (Beispiel);
      85. '45x5-3,5x2+2x-1 (anderes Beispiel).
      86. '1/2x^2-x+5 (anderes Beispiel).
      88. Kurvendiskussion = KurvDisk_Array(KoeffAusText(Funktion))
      90. End Function

      Eigentlich brauchst du nur die Codes kopieren und in dein Code-Fenster einfügen.

      Trotzdem habe ich mal eine ZIP-Datei mit den Modulen, die den Code enthalten angehängt:

      VBA-Mathe Teil 2.zip

      Falls du spezielle Fragen zu dem Code hast, auch was davon man braucht um bestimmte Dinge zu erreichen, kann ich die gerne beantworten.


      Nebenbei: Ich bin gerade dabei, ein Klassenmodul zu schreiben, mit dessen Hilfe man eine bestimmte Größe eines Dreiecks ermitteln kann (z. B. eine Seite, eine Höhe, ein Winkel, der Flächeninhalt usw.), sofern man genügend Größen eingegeben hat, um die gesuchte Größe ermitteln zu können. Das soll dann z. B. so aussehen:

      Visual Basic-Quellcode

      1. Dim dr As New Dreieck
      2. dr.SeiteA = 5
      3. dr.HöheHa = 10
      4. MsgBox dr.Flächeninhalt


      Im Beispiel würde dann eine MsgBox mit dem Text "25" erscheinen.

      Dies soll aber genauso möglich sein:

      Visual Basic-Quellcode

      1. Dim dr As New Dreieck
      2. dr.Flächeninhalt = 25
      3. dr.SeiteA = 5
      4. MsgBox dr.HöheHa


      Die MsgBox würde dann "10" zurückgeben.


      Das wird dann Bestandteil von Teil 3 sein. Wann das soweit ist, kann ich noch nicht sagen.

      Aber eins kann ich sagen: Auszuknobeln, wie man das auf die Beine stellen kann, macht richtig Spaß.

      Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „roddy“ ()

      @ Darius:

      Nein, ich habe nicht Mathe studiert. Aber Mathe war immer mein bestes Fach. Mein Wissen habe ich aus der Schule (mittlere Reife), durch Anschauen von Telekolleg Mathematik und aus Mathe-Fachbüchern.

      Ich beschäftige mich in der Freizeit einfach gern mit Mathematik. Was mir dann als Nebeneffekt manchmal im Alltag und im Berufsleben hilft und nicht zu vergessen: beim VB-Programmieren, mein zweites großes Hobby.


      Mad Andy:

      dass wir den ganzen Sch... in der Schule (hauptsächlich 11., 12.) wissen müssen/mussten


      Nur so am Rande: Die Berechnungsverfahren zur Lösung von Gleichungen 3. und 4. Grades beispielsweise (Funktionen Nullstellen3 und Nullstellen4 in meinem Sourcecode) könnte ich nicht aus den Gedächtnis abrufen. Das ist dann auch für mich etwas zu kompliziert, mir das zu merken.

      Zur Info:

      Bei der Funktion "kompTextK" stand in Zeile 28 statt dem Malpunkt (·) ein ?. Nachdem ich auf "Bearbeiten" gegangen bin, und den Punkt nochmal drübergeschrieben habe, ist er jetzt da.

      Das ? ist auch irgendwie in die ZIP-Datei gelangt, die ich nun auch korrigiert habe.

      Ich weiß ist kein Thema in dem Forum hier aber glaubst du roddy es wäre möglich den SC in Java zu schreiben??

      da ich ungern deinen schönen Code verhunzen will indem ich den in (äusserst schlechtes) Java umwandel. Oder muss man da komplett anders rangehen kenn mich da nit so mit aus^^"

      Update-Info:

      Ähnliches Problem wie oben, nur mit einem Gedankenstrich (–), den ich bei der Darstellung von komplexen Zahlen als Minuszeichen verwende, z. B. in "1 – 5 · i". Ich hab an der betreffenden Stelle im Code "–" durch Chr(150) ersetzt.

      Ich muss in Zukunft vor dem Posten den Code nochmal durchgehen und Zeichen, die Probleme machen könnten, im Auge behalten und nach dem Posten kontrollieren.

    Facebook
    Telefonspende