Mathe: Complex

Mathematik komplexer Zahlen.
WRITEME Diese Routinen sind noch nicht ausführlich getestet. Sie sollten von einem professionellen Mathematiker überprüft werden.
FIXME Sqr(-1) Negative Werte Sqr() ergeben eine Komplexe-Zahl. Die Formeln sind dafür noch nicht angepaßt, ArcSin zB. in den Berechnungen ergeben ein Fehler wenn die Werte < 1 sind. CmxTest zeigt diese Fehler.
FIXME SUB DIV muß noch mit vertauschten Parameter realisiert werden
FIXME später können wenn sinnvoll einige Routinen noch in ASM umgesetzt werden.
 
'===============================================================================
'======= Komplexe Zahlen Mathematik
 
'FIXME Sqr(-1) Negative Werte Sqr() ergeben eine Komplexe-Zahl. Die Formeln sind dafür noch nicht angepaßt, ArcSin zB. in den Berechnungen ergeben ein Fehler wenn die Werte < 1 sind. CmxTest zeigt diese Fehler.
 
 
 
Public Type Complex
    Re  As Double       '- Reale Zahl
    Im  As Double       '- Imaginäre Zahl
End Type
 
Private Const CrossOver_A As Double = 1.5
Private Const CrossOver_B As Double = 0.6417
 
 
 
Public Type IntegerXY
    X  As Long
    Y  As Long
End Type
 
 
 
Public Type CmxFraktalType
    Pos         As Complex
    PosMin      As Complex
    PosMax      As Complex
 
    IterMax     As Long
    Baylout     As Double
    Funktion    As Long
    Potenz      As Long
End Type
 
 
 
 
'-------------------------------------------------------------------------------
'------- Basis Operationen
 
Public Function Cmx_Add(ByRef Cmx1 As Complex, ByRef Cmx2 As Complex) As Complex
    Cmx_Add.Re = Cmx1.Re + Cmx2.Re
    Cmx_Add.Im = Cmx1.Im + Cmx2.Im
End Function
 
Public Function Cmx_AddRe(ByRef Cmx1 As Complex, ByVal ValRe As Double) As Complex
    Cmx_AddRe.Re = Cmx1.Re + ValRe
    Cmx_AddRe.Im = Cmx1.Im
End Function
 
Public Function Cmx_AddIm(ByRef Cmx1 As Complex, ByVal ValIm As Double) As Complex
    Cmx_AddIm.Re = Cmx1.Re
    Cmx_AddIm.Im = Cmx1.Im + ValIm
End Function
 
 
Public Function Cmx_Sub(ByRef Cmx1 As Complex, ByRef Cmx2 As Complex) As Complex
    Cmx_Sub.Re = Cmx1.Re - Cmx2.Re
    Cmx_Sub.Im = Cmx1.Im - Cmx2.Im
End Function
 
Public Function Cmx_SubRe(ByRef Cmx1 As Complex, ByVal ValRe As Double) As Complex
    Cmx_SubRe.Re = Cmx1.Re - ValRe
    Cmx_SubRe.Im = Cmx1.Im
End Function
 
Public Function Cmx_SubIm(ByRef Cmx1 As Complex, ByVal ValIm As Double) As Complex
    Cmx_SubIm.Re = Cmx1.Re
    Cmx_SubIm.Im = Cmx1.Im - ValIm
End Function
 
 
Public Function Cmx_Mul(ByRef Cmx1 As Complex, ByRef Cmx2 As Complex) As Complex
    Cmx_Mul.Re = (Cmx1.Re * Cmx2.Re) - (Cmx1.Im * Cmx2.Im)
    Cmx_Mul.Im = (Cmx1.Re * Cmx2.Im) + (Cmx1.Im * Cmx2.Re)
End Function
 
Public Function Cmx_MulRe(ByRef Cmx1 As Complex, ByVal ValRe As Double) As Complex
    Cmx_MulRe.Re = Cmx1.Re * ValRe
    Cmx_MulRe.Im = Cmx1.Im * ValRe
End Function
 
Public Function Cmx_MulIm(ByRef Cmx1 As Complex, ByVal ValIm As Double) As Complex
    Cmx_MulIm.Re = Cmx1.Im * -ValIm
    Cmx_MulIm.Im = Cmx1.Re * ValIm
End Function
 
 
Public Function Cmx_Div(ByRef Cmx1 As Complex, ByRef Cmx2 As Complex) As Complex
    S# = 1 / Cmx_Abs2(Cmx2)
 
    Cmx_Div.Re = ((Cmx1.Re * Cmx2.Re) + (Cmx1.Im * Cmx2.Im)) * S#
    Cmx_Div.Im = ((Cmx1.Im * Cmx2.Re) - (Cmx1.Re * Cmx2.Im)) * S#
End Function
 
Public Function Cmx_DivRe(ByRef Cmx1 As Complex, ByVal ValRe As Double) As Complex
    Cmx_DivRe.Re = Cmx1.Re / ValRe
    Cmx_DivRe.Im = Cmx1.Im / ValRe
End Function
 
Public Function Cmx_DivIm(ByRef Cmx1 As Complex, ByVal ValIm As Double) As Complex
    Cmx_DivIm.Re = Cmx1.Im / ValIm
    Cmx_DivIm.Im = -Cmx1.Re / ValIm
End Function
 
 
Public Function Cmx_Conjugate(ByRef Cmx1 As Complex) As Complex
    Cmx_Conjugate.Re = Cmx1.Re
    Cmx_Conjugate.Im = -Cmx1.Im
End Function
 
Public Function Cmx_Negative(ByRef Cmx1 As Complex) As Complex
    Cmx_Negative.Re = -Cmx1.Re
    Cmx_Negative.Im = -Cmx1.Im
End Function
 
Public Function Cmx_Inverse(ByRef Cmx1 As Complex) As Complex
    S# = 1 / Cmx_Abs2(Cmx1)
 
    Cmx_Inverse.Re = Cmx1.Re * S#
    Cmx_Inverse.Im = -Cmx1.Im * S#
End Function
 
 
 
 
 
'-------------------------------------------------------------------------------
'------- Basis Operationen Potenz
 
Public Function Cmx_Sqr(ByRef Cmx1 As Complex) As Complex
 
   If Cmx1.Re = 0 And Cmx1.Im = 0 Then
     Cmx_Sqr.Re = 0
     Cmx_Sqr.Im = 0
   Else
     ReAbs# = Abs(Cmx1.Re)
     ImAbs# = Abs(Cmx1.Im)
 
    If ReAbs# >= ImAbs# Then
      T# = ImAbs# / ReAbs#
      W# = Sqr(ReAbs#) * Sqr(0.5 * (1 + Sqr(1 + T# * T#)))
    Else
      T# = ReAbs# / ImAbs#
      W# = Sqr(ImAbs#) * Sqr(0.5 * (T# + Sqr(1 + T# * T#)))
    End If
 
    If Cmx1.Re >= 0 Then
      Cmx_Sqr.Re = W#
      Cmx_Sqr.Im = Cmx1.Im / (2# * W#)
    Else
      If (Cmx1.Im >= 0) Then vi# = W# Else vi# = -W#
      Cmx_Sqr.Re = Cmx1.Im / (2# * vi#)
      Cmx_Sqr.Im = vi#
    End If
   End If
 
End Function
 
Public Function Cmx_SqrRe(ByVal ValRe As Double) As Complex
   If ValRe >= 0 Then
     Cmx_SqrRe.Re = Sqr(ValRe)
     Cmx_SqrRe.Im = 0
   Else
     Cmx_SqrRe.Re = 0
     Cmx_SqrRe.Im = Sqr(-ValRe)
   End If
End Function
 
 
Public Function Cmx_Exp(ByRef Cmx1 As Complex) As Complex
    Rho# = Exp(Cmx1.Re)
    Theta# = Cmx1.Im
 
    Cmx_Exp.Re = Rho# * Cos(Theta#)
    Cmx_Exp.Im = Rho# * Sin(Theta#)
End Function
 
 
Public Function Cmx_Pow(ByRef Cmx1 As Complex, ByRef Cmx2 As Complex) As Complex
 
   If Cmx1.Re = 0 And Cmx1.Im = 0 Then
     Cmx_Pow.Re = 0
     Cmx_Pow.Im = 0
   Else
     Logr# = Cmx_LogAbs(Cmx1)
     Theta# = Cmx_Arg(Cmx1)
 
     Rho# = Exp(Logr# * Cmx2.Re - Cmx2.Im * Theta#)
     Beta# = Theta# * Cmx2.Re + Cmx2.Im * Logr#
 
     Cmx_Pow.Re = Rho# * Cos(Beta#)
     Cmx_Pow.Im = Rho# * Sin(Beta#)
   End If
 
End Function
 
Public Function Cmx_PowRe(ByRef Cmx1 As Complex, ByVal ValRe As Double) As Complex
   If Cmx1.Re = 0 And Cmx1.Im = 0 Then
     Cmx_PowRe.Re = 0
     Cmx_PowRe.Im = 0
   Else
     Logr# = Cmx_LogAbs(Cmx1)
     Theta# = Cmx_Arg(Cmx1)
     Rho# = Exp(Logr# * ValRe)
     Beta# = Theta# * ValRe
     Cmx_PowRe.Re = Rho# * Cos(Beta#)
     Cmx_PowRe.Im = Rho# * Sin(Beta#)
   End If
End Function
 
 
Public Function Cmx_Log(ByRef Cmx1 As Complex) As Complex
    Logr# = Cmx_LogAbs(Cmx1)
    Theta# = Cmx_Arg(Cmx1)
 
    Cmx_Log.Re = Logr#
    Cmx_Log.Im = Theta#
End Function
 
Public Function Cmx_Log10(ByRef Cmx1 As Complex) As Complex
    Cmx_Log10 = Cmx_MulRe(Cmx_Log(Cmx1), 1 / Log(10#))
End Function
 
Public Function Cmx_LogX(ByRef Cmx1 As Complex, ByRef Cmx2 As Complex) As Complex
    Cmx_LogX = Cmx_Div(Cmx_Log(Cmx1), Cmx_Log(Cmx2))
End Function
 
 
 
 
 
'-------------------------------------------------------------------------------
'------- Basis Eigenschaften
 
Public Function Cmx_Arg(ByRef Cmx1 As Complex) As Double
   If Cmx1.Re = 0 And Cmx1.Im = 0 Then
     Cmx_Arg = 0
   Else
     Cmx_Arg = ArcTan2(Cmx1.Im, Cmx1.Re)
   End If
End Function
 
Public Function Cmx_Abs(ByRef Cmx1 As Complex) As Double
    Cmx_Abs = Sqr((Cmx1.Re * Cmx1.Re) + (Cmx1.Im * Cmx1.Im))
End Function
 
Public Function Cmx_Abs2(ByRef Cmx1 As Complex) As Double
    Cmx_Abs2 = ((Cmx1.Re * Cmx1.Re) + (Cmx1.Im * Cmx1.Im))
End Function
 
Public Function Cmx_LogAbs(ByRef Cmx1 As Complex) As Double
 
    ReAbs# = Abs(Cmx1.Re)
    ImAbs# = Abs(Cmx1.Im)
    Dim max#, U#
 
   If ReAbs# >= ImAbs# Then
     max = ReAbs#
     U# = ImAbs# / ReAbs#
   Else
     max = ImAbs#
     U# = ReAbs# / ImAbs#
   End If
 
    ' Handle underflow wenn U# nahe an 0
 
    Cmx_LogAbs = Log(max) + 0.5 * Log1P(U# * U#)
 
End Function
 
 
 
 
 
'-------------------------------------------------------------------------------
'------- Geometrie
 
Public Function Cmx_Hypot(ByVal Val1 As Double, ByRef Val2 As Double) As Double
    Cmx_Hypot = Sqr((Val1 * Val1) + (Val2 * Val2))
End Function
 
Public Function Cmx_HypotP2(ByVal Val1 As Double, ByRef Val2 As Double) As Double
    Cmx_HypotP2 = ((Val1 * Val1) + (Val2 * Val2))
End Function
 
Public Function Cmx_HypotCmx(ByRef Cmx1 As Complex) As Double
    Cmx_HypotCmx = Sqr((Cmx1.Re * Cmx1.Re) + (Cmx1.Im * Cmx1.Im))
End Function
 
Public Function Cmx_HypotCmxP2(ByRef Cmx1 As Complex) As Double
    Cmx_HypotCmxP2 = ((Cmx1.Re * Cmx1.Re) + (Cmx1.Im * Cmx1.Im))
End Function
 
Public Function Cmx_Set(ByVal ValRe As Double, ByVal ValIm As Double) As Complex
    Cmx_Set.Re = ValRe
    Cmx_Set.Im = ValIm
End Function
 
 
 
 
 
'-------------------------------------------------------------------------------
'------- Funktionen
 
Public Function Log1P(ByRef Val1 As Double) As Double
    Y# = 1 + Val1
    Log1P = Log(Y#) - ((Y# - 1) - Val1) / Y#  '! Eliminiert Fehler mit der IEEE Arithmetic
End Function
 
 
 
 
 
'-------------------------------------------------------------------------------
'------- Konversion
 
Public Function Cmx_Rect(ByVal ValRe As Double, ByVal ValIm As Double) As Complex
    Cmx_Rect.Re = ValRe
    Cmx_Rect.Im = ValIm
End Function
 
Public Function Cmx_Polar(ByVal Radius As Double, ByVal Theta As Double) As Complex
    Cmx_Polar.Re = Radius * Cos(Theta)
    Cmx_Polar.Im = Radius * Sin(Theta)
End Function
 
Public Sub Cmx_PolarTo(ByRef RadiusRet As Double, ByRef ThetaRet As Double, ByRef Cmx1 As Complex)
    RadiusRet = Cmx_HypotCmx(Cmx1)
    ThetaRet = ArcTan2(Cmx1.Re, Cmx1.Im)
End Sub
 
 
 
 
 
'-------------------------------------------------------------------------------
'------- Trigonometrie
 
Public Function Cmx_Sin(ByRef Cmx1 As Complex) As Complex
 
   If Cmx1.Im = 0 Then
     ' avoid returing negative zero (-0.0) for the imaginary part
     Cmx_Sin.Re = Sin(Cmx1.Re)
     Cmx_Sin.Im = 0
   Else
     Cmx_Sin.Re = Sin(Cmx1.Re) * ArcCos(Cmx1.Im)
     Cmx_Sin.Im = Cos(Cmx1.Re) * ArcSin(Cmx1.Im)
   End If
 
End Function
 
Public Function Cmx_Cos(ByRef Cmx1 As Complex) As Complex
   If Cmx1.Im = 0 Then
     ' avoid returing negative zero (-0.0) for the imaginary part
     Cmx_Cos.Re = Cos(Cmx1.Re)
     Cmx_Cos.Im = 0
   Else
     Cmx_Cos.Re = Cos(Cmx1.Re) * ArcCos(Cmx1.Im)
     Cmx_Cos.Im = Sin(Cmx1.Re) * ArcSin(-Cmx1.Im)
   End If
End Function
 
Public Function Cmx_Tan(ByRef Cmx1 As Complex) As Complex
 
   If Abs(Cmx1.Im) < 1 Then
     D# = (Cos(Cmx1.Re)) ^ 2 + (ArcSin(Cmx1.Im)) ^ 2
 
     Cmx_Tan.Re = 0.5 * Sin(2 * Cmx1.Re) / D#
     Cmx_Tan.Im = 0.5 * ArcSin(2 * Cmx1.Im) / D#
   Else
     U# = Exp(-Cmx1.Im)
     C# = 2 * U# / (1 - (U#) ^ 2)
     D# = 1 + (Cos(Cmx1.Re)) ^ 2 * (C#) ^ 2
 
     S# = (C#) ^ 2
     T# = 1# / HypSin(Cmx1.Im)
 
     Cmx_Tan.Re = 0.5 * Sin(2 * Cmx1.Re) * S# / D#
     Cmx_Tan.Im = T# / D#
   End If
 
End Function
 
 
Public Function Cmx_Sec(ByRef Cmx1 As Complex) As Complex
    Cmx_Sec = Cmx_Inverse(Cmx_Cos(Cmx1))
End Function
 
Public Function Cmx_Csc(ByRef Cmx1 As Complex) As Complex
    Cmx_Csc = Cmx_Inverse(Cmx_Sin(Cmx1))
End Function
 
Public Function Cmx_Cot(ByRef Cmx1 As Complex) As Complex
    Cmx_Cot = Cmx_Inverse(Cmx_Tan(Cmx1))
End Function
 
 
 
 
 
'-------------------------------------------------------------------------------
'------- Trigonometrie Arcus
 
Public Function Cmx_ArcSin(ByRef Cmx1 As Complex) As Complex
 
   If Cmx1.Im = 0 Then
     Cmx_ArcSin = Cmx_ArcSinRe(Cmx1.Re)
   Else
     ReAbs# = Abs(Cmx1.Re)
     ImAbs# = Abs(Cmx1.Im)
     R# = Cmx_Hypot(ReAbs# + 1, ImAbs#)
     S# = Cmx_Hypot(ReAbs# - 1, ImAbs#)
     A# = 0.5 * (R# + S#)
     B# = ReAbs# / A#
     Y2# = ImAbs# * ImAbs#
 
    If B# <= CrossOver_B# Then
      Real# = ArcSin(B#)
    Else
     If ReAbs# <= 1 Then
       D# = 0.5 * (A# + ReAbs#) * (Y2# / (R# + ReAbs# + 1) + (S# + (1 - ReAbs#)))
       Real# = Atn(ReAbs# / Sqr(D#))
     Else
       Apx# = A# + ReAbs#
       D# = 0.5 * (Apx# / (R# + ReAbs# + 1) + Apx# / (S# + (ReAbs# - 1)))
       Real# = Atn(ReAbs# / (ImAbs# * Sqr(D#)))
     End If
    End If
 
    If A# <= CrossOver_A# Then
     If ReAbs# < 1 Then
       Am1# = 0.5 * (Y2# / (R# + (ReAbs# + 1)) + Y2# / (S# + (1 - ReAbs#)))
     Else
       Am1# = 0.5 * (Y2# / (R# + (ReAbs# + 1)) + (S# + (ReAbs# - 1)))
     End If
 
      Imag# = Log1P(Am1# + Sqr(Am1# * (A# + 1)))
    Else
      Imag# = Log(A# + Sqr(A# * A# - 1))
    End If
 
     If (Cmx1.Re >= 0) Then Cmx_ArcSin.Re = Real# Else Cmx_ArcSin.Re = -Real#
     If (Cmx1.Im >= 0) Then Cmx_ArcSin.Im = Imag# Else Cmx_ArcSin.Im = -Imag#
   End If
 
End Function
 
Public Function Cmx_ArcSinRe(ByVal ValRe As Double) As Complex
   If Abs(ValRe) <= 1 Then
     Cmx_ArcSinRe.Re = ArcSin(ValRe)
     Cmx_ArcSinRe.Im = 0
   Else
    If ValRe < 0 Then
      Cmx_ArcSinRe.Re = -M_PI_2
      Cmx_ArcSinRe.Im = HypArcCos(-ValRe)
    Else
      Cmx_ArcSinRe.Re = M_PI_2
      Cmx_ArcSinRe.Im = -HypArcCos(ValRe)
    End If
   End If
End Function
 
 
Public Function Cmx_ArcCos(ByRef Cmx1 As Complex) As Complex
 
   If Cmx1.Im = 0 Then
     Cmx_ArcCos = Cmx_ArcCosRe(Cmx1.Re)
   Else
     ReAbs# = Abs(Cmx1.Re)
     ImAbs# = Abs(Cmx1.Im)
     R# = Cmx_Hypot(ReAbs# + 1, ImAbs#)
     S# = Cmx_Hypot(ReAbs# - 1, ImAbs#)
     A# = 0.5 * (R# + S#)
     B# = ReAbs# / A#
     Y2# = ImAbs# * ImAbs#
 
    If B# <= CrossOver_B# Then
      Real# = ArcCos(B#)
    Else
     If ReAbs# <= 1 Then
       D# = 0.5 * (A# + ReAbs#) * (Y2# / (R# + ReAbs# + 1) + (S# + (1 - ReAbs#)))
       Real# = Atn(Sqr(D#) / ReAbs#)
     Else
       Apx# = A# + ReAbs#
       D# = 0.5 * (Apx# / (R# + ReAbs# + 1) + Apx# / (S# + (ReAbs# - 1)))
       Real# = Atn((ImAbs# * Sqr(D#)) / ReAbs#)
     End If
    End If
 
    If A# <= CrossOver_A# Then
 
     If ReAbs# < 1 Then
       Am1# = 0.5 * (Y2# / (R# + (ReAbs# + 1)) + Y2# / (S# + (1 - ReAbs#)))
     Else
       Am1# = 0.5 * (Y2# / (R# + (ReAbs# + 1)) + (S# + (ReAbs# - 1)))
     End If
 
      Imag# = Log1P(Am1# + Sqr(Am1# * (A# + 1)))
    Else
      Imag# = Log(A# + Sqr(A# * A# - 1))
    End If
 
     If (Cmx1.Re >= 0) Then Cmx_ArcCos.Re = Real# Else Cmx_ArcCos.Re = M_PI - Real#
     If (Cmx1.Im >= 0) Then Cmx_ArcCos.Im = -Imag# Else Cmx_ArcCos.Im = Imag#
   End If
 
End Function
 
Public Function Cmx_ArcCosRe(ByVal ValRe As Double) As Complex
   If Abs(ValRe) <= 1 Then
     Cmx_ArcCosRe.Re = ArcCos(ValRe)
     Cmx_ArcCosRe.Im = 0
   Else
    If ValRe < 0 Then
      Cmx_ArcCosRe.Re = M_PI
      Cmx_ArcCosRe.Im = -HypArcCos(-ValRe)
    Else
      Cmx_ArcCosRe.Re = 0
      Cmx_ArcCosRe.Im = HypArcCos(ValRe)
    End If
   End If
End Function
 
 
Public Function Cmx_ArcTan(ByRef Cmx1 As Complex) As Complex
 
   If Cmx1.Im = 0 Then
     Cmx_ArcTan.Re = Atn(Cmx1.Re)
     Cmx_ArcTan.Im = 0
   Else
     ' FIXME: This is Cmx1 naive implementation which does not fully
     ' take into account cancellation errors, overflow, underflow
     ' etc.  It would benefit from the Hull et al treatment.
     R# = Cmx_HypotCmx(Cmx1)
 
     U# = 2 * Cmx1.Im / (1 + R# * R#)
 
     ' FIXME: the following cross-over should be optimized but 0.1 seems to work ok
    If Abs(U#) < 0.1 Then
      Imag# = 0.25 * (Log1P(U#) - Log1P(-U#))
    Else
      A# = Cmx_Hypot(Cmx1.Re, Cmx1.Im + 1)
      B# = Cmx_Hypot(Cmx1.Re, Cmx1.Im - 1)
      Imag# = 0.5 * Log(A# / B#)
    End If
 
    If Cmx1.Re = 0 Then
     If Cmx1.Im > 1 Then
       Cmx_ArcTan.Re = M_PI_2
       Cmx_ArcTan.Im = Imag#
     ElseIf (Cmx1.Im < -1) Then
       Cmx_ArcTan.Re = -M_PI_2
       Cmx_ArcTan.Im = Imag#
     Else
       Cmx_ArcTan.Re = 0
       Cmx_ArcTan.Im = Imag#
     End If
    Else
      Cmx_ArcTan.Re = 0.5 * ArcTan2(2 * Cmx1.Re, ((1 + R#) * (1 - R#)))
      Cmx_ArcTan.Im = Imag#
    End If
   End If
 
End Function
 
 
Public Function Cmx_ArcSec(ByRef Cmx1 As Complex) As Complex
    Cmx_ArcSec = Cmx_ArcCos(Cmx_Inverse(Cmx1))
End Function
 
Public Function Cmx_ArcSecRe(ByVal ValRe As Double) As Complex
   If ValRe <= -1 Or ValRe >= 1 Then
     Cmx_ArcSecRe.Re = ArcCos(1 / ValRe)
     Cmx_ArcSecRe.Im = 0
   Else
    If ValRe >= 0 Then
      Cmx_ArcSecRe.Re = 0
      Cmx_ArcSecRe.Im = HypArcCos(1 / ValRe)
    Else
      Cmx_ArcSecRe.Re = M_PI
      Cmx_ArcSecRe.Im = -HypArcCos(-1 / ValRe)
    End If
   End If
End Function
 
 
Public Function Cmx_ArcCsc(ByRef Cmx1 As Complex) As Complex
    Cmx_ArcCsc = Cmx_ArcSin(Cmx_Inverse(Cmx1))
End Function
 
Public Function Cmx_ArcCscRe(ByVal ValRe As Double) As Complex
   If ValRe <= -1 Or ValRe >= 1 Then
     Cmx_ArcCscRe.Re = ArcSin(1 / ValRe)
     Cmx_ArcCscRe.Im = 0
   Else
    If ValRe >= 0 Then
      Cmx_ArcCscRe.Re = M_PI_2
      Cmx_ArcCscRe.Im = -HypArcCos(1 / ValRe)
    Else
      Cmx_ArcCscRe.Re = -M_PI_2
      Cmx_ArcCscRe.Im = HypArcCos(-1 / ValRe)
    End If
   End If
End Function
 
 
Public Function Cmx_ArcCot(ByRef Cmx1 As Complex) As Complex
   If Cmx1.Re = 0 And Cmx1.Im = 0 Then
     Cmx_ArcCot.Re = M_PI_2
     Cmx_ArcCot.Im = 0
   Else
     Cmx_ArcCot = Cmx_Inverse(Cmx1)
     Cmx_ArcCot = Cmx_ArcTan(Cmx_ArcCot)
   End If
End Function
 
 
 
 
 
'-------------------------------------------------------------------------------
'------- Trigonometrie Hyperbolicus
 
Public Function Cmx_HypSin(ByRef Cmx1 As Complex) As Complex
    Cmx_HypSin.Re = ArcSin(Cmx1.Re) * Cos(Cmx1.Im)
    Cmx_HypSin.Im = ArcCos(Cmx1.Re) * Sin(Cmx1.Im)
End Function
 
Public Function Cmx_HypCos(ByRef Cmx1 As Complex) As Complex
    Cmx_HypCos.Re = ArcCos(Cmx1.Re) * Cos(Cmx1.Im)
    Cmx_HypCos.Im = ArcSin(Cmx1.Re) * Sin(Cmx1.Im)
End Function
 
Public Function Cmx_HypTan(ByRef Cmx1 As Complex) As Complex
   If Abs(Cmx1.Re) < 1 Then
     D# = (Cos(Cmx1.Im)) ^ 2 + (ArcSin(Cmx1.Re)) ^ 2
 
     Cmx_HypTan.Re = ArcSin(Cmx1.Re) * ArcCos(Cmx1.Re) / D#
     Cmx_HypTan.Im = 0.5 * Sin(2 * Cmx1.Im) / D#
   Else
     D# = (Cos(Cmx1.Im)) ^ 2 + (ArcSin(Cmx1.Re)) ^ 2
     F# = 1 + (Cos(Cmx1.Im) / ArcSin(Cmx1.Re)) ^ 2
 
     Cmx_HypTan.Re = 1 / (HypSin(Cmx1.Re) * F#)
     Cmx_HypTan.Im = 0.5 * Sin(2 * Cmx1.Im) / D#
   End If
End Function
 
 
Public Function Cmx_HypSec(ByRef Cmx1 As Complex) As Complex
    Cmx_HypSec = Cmx_Inverse(Cmx_HypCos(Cmx1))
End Function
 
Public Function Cmx_HypCsc(ByRef Cmx1 As Complex) As Complex
    Cmx_HypCsc = Cmx_Inverse(Cmx_HypSin(Cmx1))
End Function
 
Public Function Cmx_HypCot(ByRef Cmx1 As Complex) As Complex
    Cmx_HypCot = Cmx_Inverse(Cmx_HypTan(Cmx1))
End Function
 
 
 
 
 
'-------------------------------------------------------------------------------
'------- Trigonometrie Arcus Hyperbolicus
 
Public Function Cmx_HypArcSin(ByRef Cmx1 As Complex) As Complex
    Dim Z As Complex
 
    Z = Cmx_MulIm(Cmx1, 1)
    Z = Cmx_ArcSin(Z)
    Z = Cmx_MulIm(Z, -1)
    Cmx_HypArcSin = Z
End Function
 
Public Function Cmx_HypArcCos(ByRef Cmx1 As Complex) As Complex
    Dim Z As Complex
 
    Z = Cmx_ArcCos(Cmx1)
    If Z.Im > 0 Then Real# = -1 Else Real# = 1
    Z = Cmx_MulIm(Z, Real#)
    Cmx_HypArcCos = Z
End Function
 
Public Function Cmx_HypArcCosRe(ByVal ValRe As Double) As Complex
   If ValRe >= 1 Then
     Cmx_HypArcCosRe.Re = HypArcCos(ValRe)
     Cmx_HypArcCosRe.Im = 0
   Else
    If ValRe >= -1 Then
      Cmx_HypArcCosRe.Re = 0
      Cmx_HypArcCosRe.Im = ArcCos(ValRe)
    Else
      Cmx_HypArcCosRe.Re = HypArcCos(-ValRe)
      Cmx_HypArcCosRe.Im = M_PI
    End If
   End If
End Function
 
Public Function Cmx_HypArcTan(ByRef Cmx1 As Complex) As Complex
   If Cmx1.Im = 0 Then
     Cmx_HypArcTan = Cmx_HypArcTanRe(Cmx1.Re)
   Else
     Dim Z As Complex
 
     Z = Cmx_MulIm(Cmx1, 1)
     Z = Cmx_ArcTan(Z)
     Z = Cmx_MulIm(Z, -1)
     Cmx_HypArcTan = Z
   End If
End Function
 
Public Function Cmx_HypArcTanRe(ByVal ValRe As Double) As Complex
   If ValRe > -1 And ValRe < 1 Then
     Cmx_HypArcTanRe.Re = HypArcTan(ValRe)
     Cmx_HypArcTanRe.Im = 0
   Else
     Cmx_HypArcTanRe.Re = HypArcTan(1 / ValRe)
     If (ValRe < 0) Then Cmx_HypArcTanRe.Im = M_PI_2 Else Cmx_HypArcTanRe.Im = -M_PI_2
   End If
End Function
 
Public Function Cmx_HypArcSec(ByRef Cmx1 As Complex) As Complex
    Cmx_HypArcSec = Cmx_HypArcCos(Cmx_Inverse(Cmx1))
End Function
 
Public Function Cmx_HypArcCsc(ByRef Cmx1 As Complex) As Complex
    Cmx_HypArcCsc = Cmx_HypArcSin(Cmx_Inverse(Cmx1))
End Function
 
Public Function Cmx_HypArcCot(ByRef Cmx1 As Complex) As Complex
    Cmx_HypArcCot = Cmx_HypArcTan(Cmx_Inverse(Cmx1))
End Function
 
 
 
Public Function Cmx_PowInt(ByRef Cmx1 As Complex, ByVal Val2 As Long) As Complex
'=== z^n Wobei n eine Ganzzahl ist zwischen 2 bis 4
 
   Select Case Val2
    Case 2
      Cmx_PowInt.Re = Cmx1.Re * Cmx1.Re - Cmx1.Im * Cmx1.Im
      Cmx_PowInt.Im = (Cmx1.Re * Cmx1.Im) * 2
    Case 3
      Cmx_PowInt.Re = (Cmx1.Re * Cmx1.Re * Cmx1.Re) - (Cmx1.Re * Cmx1.Im * Cmx1.Im * 3)
      Cmx_PowInt.Im = (Cmx1.Re * Cmx1.Re * Cmx1.Im * 3) - (Cmx1.Im * Cmx1.Im * Cmx1.Im)
    Case 4
      Dim HCmx As Complex
      HCmx.Re = (Cmx1.Re * Cmx1.Re * Cmx1.Re) - (Cmx1.Re * Cmx1.Im * Cmx1.Im * 3)
      HCmx.Im = (Cmx1.Re * Cmx1.Re * Cmx1.Im * 3) - (Cmx1.Im * Cmx1.Im * Cmx1.Im)
      Cmx_PowInt.Re = (HCmx.Re * Cmx1.Re) - (HCmx.Im * Cmx1.Im)
      Cmx_PowInt.Im = (HCmx.Im * Cmx1.Re) + (HCmx.Re * Cmx1.Im)
   End Select
 
End Function
 
Public Function Cmx_PowFlt(ByRef Cmx1 As Complex, ByVal Val2 As Double) As Complex
'=== z^n wobei n keien GanzZahl sein muß.
    'WRITEME
End Function
 
 
 
 
 
'-------------------------------------------------------------------------------
'------- Mandel/Julia
 
Public Sub CmxFraktal(ByRef PictureCmx As PictureBox, ByRef Fraktal As CmxFraktalType)
  With Fraktal
 
 
   '- Deklaration
    Dim PicMax  As IntegerXY
 
    Dim LenXY   As Complex
 
    Dim CmxCSet As Complex
 
    Dim CCmx    As Complex
    Dim ZCmx    As Complex
 
    Dim HCmx    As Complex
 
 
 
   '--- Initialisierung
    ProzessStop = False
 
    PicMax.X = PictureCmx.Width / Screen.TwipsPerPixelX
    PicMax.Y = PictureCmx.Height / Screen.TwipsPerPixelY
 
    Sp# = 2
    FakXzuY# = PicMax.Y / PicMax.X
 
    .PosMin.Re = Sp# * -1
    .PosMin.Im = Sp# * -FakXzuY#
    .PosMax.Re = Sp# * 1
    .PosMax.Im = Sp# * FakXzuY#
 
    If .IterMax <= 0 Then .IterMax = 128
    If .Baylout <= 0 Then .Baylout = 2 ^ 16
    If .Potenz < 2 Then .Potenz = 2     'Z^.Potenz 2 3 4
    If .Potenz > 4 Then .Potenz = 4
    If .Funktion < 0 Then .Potenz = 0   '0->Mandel, 1->Julia
    If .Funktion > 1 Then .Potenz = 1
 
    LenXY = Cmx_Sub(.PosMax, .PosMin)
 
 
 
 
 
   '--- Berechnen initialisieren
   Select Case .Funktion
    Case 0 '- Mandel
      CmxCSet = Cmx_Set(0, 0)
     If .Potenz = 2 Then
       .PosMin.Re = .PosMin.Re - LenXY.Re / 4
       .PosMax.Re = .PosMax.Re - LenXY.Re / 4
     End If
    Case 1 '- Julia
      CmxCSet = Cmx_Set(-0.75, 0.2)
      CCmx = CmxCSet
   End Select
 
 
 
  '- Pixelteilung für beschleunigte Anzeige
  For SpeedStep& = 1 To 4
   Select Case SpeedStep&
    Case 1: StartX& = 1: StartY& = 1
    Case 2: StartX& = 2: StartY& = 2
    Case 3: StartX& = 2: StartY& = 1
    Case 4: StartX& = 1: StartY& = 2
   End Select
 
 
   '--- Berechnen
   For PosX& = 0 + StartX& To PicMax.X Step 2
     .Pos.Re = .PosMin.Re + (LenXY.Re / PicMax.X * PosX&)
 
    For PosY& = 0 + StartY& To PicMax.Y Step 2
      .Pos.Im = .PosMin.Im + (LenXY.Im / PicMax.Y * PosY&)
 
     '- StartWerte setzen
     Select Case .Funktion
      Case 0 '- Mandel
        ZCmx = CmxCSet
        CCmx = .Pos
      Case 1 '- Julia
        ZCmx = .Pos
        'CCmx = CmxCSet
     End Select
 
 
     '- Itrations-Schleife
      IterPos& = 0
     Do
 
      '- Z^.Potenz
      Select Case .Potenz
       Case 2
         ZCmx = Cmx_Mul(ZCmx, ZCmx)
         ZCmx = Cmx_Add(ZCmx, CCmx)
       Case 3
         ZCmx = Cmx_PowInt(ZCmx, 3)
         ZCmx = Cmx_Add(ZCmx, CCmx)
       Case 4
         ZCmx = Cmx_PowInt(ZCmx, 4)
         ZCmx = Cmx_Add(ZCmx, CCmx)
      End Select
 
       'ZCmx = ZCmx
       Z# = Cmx_HypotCmxP2(ZCmx)
 
      '- Iterations-Check
       IterPos& = IterPos& + 1
      If IterPos& >= .IterMax Then
        Color1& = 0
       Exit Do
      ElseIf Z# > .Baylout Then
        Color1& = IterPos& Mod 256
       Exit Do
      'else '+ Periodizitäts-Check im Innern des Sees
      End If
 
     Loop
 
 
     '- Farbe Berechnen
     If Color1& < 1 Then
       ColorFak! = 0
     Else
       ColorFak! = LogX(Color1&, 256)
     End If
      ColorR! = ColorFak! ^ 9
      ColorG! = ColorFak! ^ 3
      ColorB! = ColorFak! ^ 1
 
      ColorR! = ColorR! * 256
      ColorG! = ColorG! * 256
      ColorB! = ColorB! * 256
 
      PointPosX& = (PosX& - 1) * Screen.TwipsPerPixelX
      PointPosY& = (PosY& - 1) * Screen.TwipsPerPixelY
     If SpeedStep& = 1 Then
       PictureCmx.Line (PointPosX&, PointPosY&)-(PointPosX& + Screen.TwipsPerPixelX, PointPosY& + Screen.TwipsPerPixelY), RGB(ColorR!, ColorG!, ColorB!), BF
       'Complex_Form.PSet (PointPosX&, PointPosY&), RGB(ColorR!, ColorG!, ColorB!)
     Else
       PictureCmx.PSet (PointPosX&, PointPosY&), RGB(ColorR!, ColorG!, ColorB!)
     End If
 
 
    Next PosY&
 
     DoEvents
     If ProzessStop Then GoTo SubEnd
   Next PosX&
 
 
  Next SpeedStep&
 
 
SubEnd:
  End With
End Sub
 
 
 
 
 
'-------------------------------------------------------------------------------
'------- TestRoutine
 
Public Sub CmxTest()
'On Error Resume Next
 
   '-
    Dim Cmx1 As Complex
    Dim Cmx2 As Complex
    Dim Cmx3 As Complex
 
    Dim ValRe  As Double
    Dim ValIm  As Double
    Dim Radius As Double
    Dim Theta  As Double
 
 
    Dim TestCmx As Complex
    Dim TestVal As Double
 
 
   '-
    Cmx1.Re = 0.3: Cmx1.Im = 0.8
    Cmx2.Re = 0.4: Cmx2.Im = 0.7
    Cmx3.Re = 1.4: Cmx3.Im = 1.7
 
    ValRe = 0.7
    ValIm = 0.9
    Radius = 0.1
    Theta = 0.2
 
 
   '-
    TestCmx = Cmx_Add(Cmx1, Cmx2)
    TestCmx = Cmx_AddRe(Cmx1, ValRe)
    TestCmx = Cmx_AddIm(Cmx1, ValIm)
    TestCmx = Cmx_Sub(Cmx1, Cmx2)
    TestCmx = Cmx_SubRe(Cmx1, ValRe)
    TestCmx = Cmx_SubIm(Cmx1, ValIm)
    TestCmx = Cmx_Mul(Cmx1, Cmx2)
    TestCmx = Cmx_MulRe(Cmx1, ValRe)
    TestCmx = Cmx_MulIm(Cmx1, ValIm)
    TestCmx = Cmx_Div(Cmx1, Cmx2)
    TestCmx = Cmx_DivRe(Cmx1, ValRe)
    TestCmx = Cmx_DivIm(Cmx1, ValIm)
 
    TestVal = Cmx_Arg(Cmx1)
    TestVal = Cmx_Abs(Cmx1)
    TestVal = Cmx_Abs2(Cmx1)
    TestVal = Cmx_LogAbs(Cmx1)
 
    TestCmx = Cmx_Rect(ValRe, ValIm)
    TestCmx = Cmx_Polar(Radius, Theta)
 
    TestCmx = Cmx_Conjugate(Cmx1)
    TestCmx = Cmx_Negative(Cmx1)
    TestCmx = Cmx_Inverse(Cmx1)
 
    TestCmx = Cmx_Sqr(Cmx1)
    TestCmx = Cmx_SqrRe(ValRe)
    TestCmx = Cmx_Exp(Cmx1)
    TestCmx = Cmx_Pow(Cmx1, Cmx2)
    TestCmx = Cmx_PowRe(Cmx1, ValRe)
    TestCmx = Cmx_Log(Cmx1)
    TestCmx = Cmx_Log10(Cmx1)
    TestCmx = Cmx_LogX(Cmx1, Cmx2)
 
    TestCmx = Cmx_Sin(Cmx1)
    TestCmx = Cmx_Cos(Cmx1)
    TestCmx = Cmx_Tan(Cmx1)
    TestCmx = Cmx_Sec(Cmx1)
    TestCmx = Cmx_Csc(Cmx1)
    TestCmx = Cmx_Cot(Cmx1)
 
    TestCmx = Cmx_ArcSin(Cmx1)
    TestCmx = Cmx_ArcSinRe(ValRe)
    TestCmx = Cmx_ArcCos(Cmx1)
    TestCmx = Cmx_ArcCosRe(ValRe)
    TestCmx = Cmx_ArcTan(Cmx1)
    TestCmx = Cmx_ArcSec(Cmx1)
    TestCmx = Cmx_ArcSecRe(ValRe)
    TestCmx = Cmx_ArcCsc(Cmx1)
    TestCmx = Cmx_ArcCscRe(ValRe)
    TestCmx = Cmx_ArcCot(Cmx1)
 
    TestCmx = Cmx_HypSin(Cmx1)
    TestCmx = Cmx_HypCos(Cmx1)
    TestCmx = Cmx_HypTan(Cmx1)
    TestCmx = Cmx_HypSec(Cmx1)
    TestCmx = Cmx_HypCsc(Cmx1)
    TestCmx = Cmx_HypCot(Cmx1)
 
    TestCmx = Cmx_HypArcSin(Cmx1)
    TestCmx = Cmx_HypArcCos(Cmx1)
    TestCmx = Cmx_HypArcCosRe(ValRe)
    TestCmx = Cmx_HypArcTan(Cmx1)
    TestCmx = Cmx_HypArcTanRe(ValRe)
    TestCmx = Cmx_HypArcSec(Cmx1)
    TestCmx = Cmx_HypArcCsc(Cmx1)
    TestCmx = Cmx_HypArcCot(Cmx1)
 
End Sub
Ansichten

Mathe: Complex
