PureBoard

Verfasst: **08.02.2008 02:01**

Hallo liebe Community!

Ich will hier nur mal schnell mein kleines Nebenprojekt vorstellen, das von
meinen kommenden Mathe-Funktionen verwendet wird.
Es handelt sich um ein Interface, mit dem man eigentlich nur rechnen
kann. Bisher sind diese grundlegenden Dinge drin:

Value_New(type.l)
Erstellt eine neue Value des übergebenen Typs (#Value_Rational,
#Value_Real, #Value_Complex).
Free()
Löscht die Value und gibt den Speicher wieder frei.
Value()
Gibt den direkten Pointer zum jeweiligen Datentyp (Value_Rat,
Value_Real, Value_Complex) zurück.
NewFromType()
Erstellt eine neue Value des selben Typs.
Copy()
Erstellt eine Kopie.
Str(nbDecimals.l)
Gibt Value als String und auf nbDecimals Nachkommastellen gerundet
zurück.
Val(String.s)
Parst einen String und weist der Value den Wert darin zu.
Flip(*v)
Tauscht den Inhalt mit *v.
Set(*v)
Setzt den Wert auf *v.
Get(*v)
Weist *v den Wert der Value zu. (ändert nicht den Typ von *v)
Add(*v)
Addiert *v zur Value.
Sub(*v)
Subtrahiert *v von Value.
Mul(*v)
Multipliziert Value mit *v.
Div(*v)
Dividiert Value durch *v.
Pow(*v)
Potenziert Value mit *v. (funktioniert noch nicht zwei komplexen Typen)
Null()
Liefert #True, wenn Value = 0 ist.
Neg()
Negiert Value.
SetNull()
Setzt Value auf Null.
SetOne()
Setzt Value auf Eins.
Invert()
Bildet das Inverse zur Value.
Convert(type.l, nbDecimals.l)
Konvertiert eine Value zu einen anderen Typ. nbDecimals gibt die
Genauigkeit an um den Typ Real oder Complex zu Rational zu
konvertieren. Beim Konvertieren von Complex in einen anderen Typen
geht der imaginäre Teil verloren.

Bei allen Funktionen, bei denen die Value durch eine andere Value
geändert wird, ist darauf zu achten, dass sich dadurch der Typ ändern
kann. Zum Beispiel wird Real(3.12)+Complex(1+2i) zu Complex(4.12+2i).

///Edit 1:
Pow für komplexe Zahlen nach Stargates Procedure ausgebessert.
Danke nochmal an Stargate.

///Edit 2: (14.02.2008)
So, jetzt gibt es einen neuen unbestimmten Typ 'Undefined'.
Wenn man 'Value_New()' ohne Parameter oder mit '#Value_Undefined'
aufruft, erhält man eine Value ohne Typ. Dadurch gibt es ein paar
Neuerungen und Dinge, auf die man achten sollte, wenn man keinen IMA
herausfordern will:
Die folgende List gilt nur für den Typ 'Undefined':

Str()
Gibt einfach den String "Undefined" zurück.
Val(String.s)
Versucht den Typ der Zahl herauszubekommen und ändert ihn zu Rational, Real oder Complex. Typische Schreibweisen:
Rational: "3" oder "3/4" oder "-3/4" oder "3/-4" oder "-3/-4"
Real: "3.0" oder "-3.0"
Complex: "3+4i" oder "-3+4i" oder "3-4i" oder "-3-4i" oder "3i+4" oder "-3i+4" oder "3i-4" oder "-3i-4" oder das selbe mit Kommazahlen
Set(*v)
Weist den Wert aus *v zu und ändert automatisch den Typ.
Get(*v)
Invalid Memory Access.
Add(*v)
Macht das selbe wie Set()
Sub()
Macht das selbe wie Set(), aber negiert den Wert anschließend.
Mul(), Div(), Pow()
Invalid Memory Access
Null(), Neg(), SetNull(), SetOne(), Invert(), Convert()
Tut nichts.

Die Val()-Funktion bei 'Undefined' ist noch ausbaufähig. Bei Bugs bitte
melden!

///Edit 3:
Ich habe einen Fehler bei Pow() berichtigt, der bei komplexen Zahlen mit
negativem Realteil auftritt, und noch eine Sqr()-Funktion hinzugefügt.

Jetzt aber der Code:

Code: Alles auswählen

EnableExplicit

;#############################
;##     Value-Interface     ##
;#############################
;##   (c) Nicolas Göddel    ##
;##  written in PureBasic   ##
;#############################
;---------------
;Hints:
;- Complex > Real > Rational (o = Add, Sub, Mul, Div, Pow)
;  - (Rational o Real)    -> Real
;  - (Rational o Complex) -> Complex
;  - (Real o Complex)     -> Complex

#Value_Errors = #True

Declare Value_New(type.l, *Value = 0)

Enumeration
  #Value_Undefined
  #Value_Rational
  #Value_Real
  #Value_Complex
EndEnumeration

Interface Value
  Free()
  Value()
  NewFromType()
  Copy()
  Str.s(nbDecimals.l = -1)
  Val(string.s)
  Flip(*v)
  Set(*v)
  Get(*v)
  Add(*v)
  Sub(*v)
  Mul(*v)
  Div(*v)
  Pow(*v)
  Null()
  Neg()
  SetNull()
  SetOne()
  Invert()
  Convert(type.l, nbDecimals.l = 10)
  Sqr()
EndInterface

Structure Value_Rat
  a.q
  b.q
EndStructure
Structure Value_Real
  r.d
EndStructure
Structure Value_Complex
  r.d
  i.d
EndStructure

Structure Value_S
  *VTable
  *f.Value
  ;type.l           ;No type-definition, because the VTable types it too
  StructureUnion
    value.l         ;The Value()-Method pointers to this
    rat.Value_Rat
    real.Value_Real
    complex.Value_Complex
  EndStructureUnion
EndStructure

Procedure Value_ggT(*x.Value_Rat) ;Steinscher Algorithmus
  Protected k.l = 0, t.q, a.q = *x\a, b.q = *x\b
  If *x\a = 0
    *x\b = 1
    ProcedureReturn
  EndIf
  If *x\b < 0
    *x\a = -*x\a
    *x\b = -*x\b
  EndIf
  a = *x\a
  If a < 0 : a = -a : EndIf
  b = *x\b
  While Not (a & 1 Or b & 1)
    a >> 1
    b >> 1
    k + 1
  Wend
  If a & 1 : t = -b : Else : t = a : EndIf
  While t
    While Not t & 1
      t >> 1
    Wend
    ;If t > 0 : a = t : Else : b = -t : EndIf
    ;t = a - b
    If t > 0 : a = t : t - b : Else : b = -t : t + a : EndIf
  Wend
  a << k
  *x\a / a
  *x\b / a
EndProcedure
Macro exp(x) ;exponentialfunktion
  Pow(2.71828182845905, x)
EndMacro

;- Undefined
Procedure Value_Undefined_Copy(*x.Value_S)
  ProcedureReturn *x\f\NewFromType()
EndProcedure

Procedure.s Value_Undefined_Str(*x.Value_S, nbDecimals.l)
  ProcedureReturn "undefined"
EndProcedure

Procedure Value_Undefined_Val(*x.Value_S, String.s)

  Protected s1.s, s2.s, m.l
  s1 = StringField(String, 1, "/")
  s2 = StringField(String, 2, "/")
  
  If s2
    *x\VTable = ?Value_VTable_Rational
    *x\rat\a = ValQ(s1)
    *x\rat\b = ValQ(s2)
    Value_ggT(*x\rat)
  Else
    If Not FindString(s1, ".", 1) And Not FindString(s1, "i", 1)
      *x\VTable = ?Value_VTable_Rational
      *x\rat\a = ValQ(s1)
      *x\rat\b = 1
      Value_ggT(*x\rat)
    Else
      If Not FindString(s1, "i", 1)
        *x\VTable = ?Value_VTable_Real
        *x\real\r = ValD(s1)
      Else
        m = FindString(s1, "-", 2) 
        If m
          s2 = Mid(s1, m, Len(s1))
          s1 = Left(s1, m - 1)
        Else
          m = FindString(s1, "+", 2)
          s2 = Mid(s1, m, Len(s1))
          s1 = Left(s1, m - 1)
        EndIf
        If FindString(s1, "i", 1) : Swap s1, s2 : EndIf
        *x\VTable = ?Value_VTable_Complex
        *x\complex\r = ValD(s1)
        *x\complex\i = ValD(s2)
      EndIf
    EndIf
  EndIf
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Undefined_Flip(*x.Value_S, *v.Value_S)
    Protected  rat.Value_Rat
  
  Select *v\VTable
    Case ?Value_VTable_Undefined
      ;do nothing
    Case ?Value_VTable_Rational
      *x\rat\a = *v\rat\a
      *x\rat\b = *v\rat\b
      Swap *x\VTable, *v\VTable
    Case ?Value_VTable_Real
      *x\real\r = *v\real\r
      Swap *x\VTable, *v\VTable
    Case ?Value_VTable_Complex
      *x\complex\r = *v\complex\r
      *x\complex\i = *v\complex\i
      Swap *x\VTable, *v\VTable
    EndSelect
  ProcedureReturn *x
EndProcedure

Procedure Value_Undefined_Add(*x.Value_S, *v.Value_S)
  ProcedureReturn *x\f\Set(*v)
EndProcedure

Procedure Value_Undefined_Sub(*x.Value_S, *v.Value_S)
  *x\f\Set(*v)
  ProcedureReturn *x\f\Neg()
EndProcedure

Procedure Value_Undefined_DoNothing(*x.Value_S)
  ProcedureReturn *x
EndProcedure

;- Rational
Procedure Value_Rational_Convert(*x.Value_S, type.l, dummy.l = 0)
  Protected v.Value_Rat
  
  If type = #Value_Rational
    ProcedureReturn *x
  EndIf
  
  v\a = *x\rat\a
  v\b = *x\rat\b
  
  Select type
    Case #Value_Real
      *x\VTable = ?Value_VTable_Real
      *x\real\r = v\a / v\b
    Case #Value_Complex
      *x\VTable = ?Value_VTable_Complex
      *x\complex\r = v\a / v\b
      *x\complex\i = 0.0
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Rational_Copy(*x.Value_S)
  Protected *Value.Value_S = *x\f\NewFromType()
  
  CompilerIf #Value_Errors
  If Not *Value : ProcedureReturn #False : EndIf
  CompilerEndIf
  
  *Value\rat\a = *x\rat\a
  *Value\rat\b = *x\rat\b
  
  ProcedureReturn *Value
EndProcedure

Procedure.s Value_Rational_Str(*x.Value_S, dummy.l)
  If *x\rat\b = 1
    ProcedureReturn StrQ(*x\rat\a)
  Else
    ProcedureReturn StrQ(*x\rat\a) + "/" + StrQ(*x\rat\b)
  EndIf
EndProcedure

Procedure Value_Rational_Val(*x.Value_S, string.s)
  *x\rat\a = ValQ(string)
  If FindString(string, "/", 1)
    *x\rat\b = ValQ(StringField(string, 2, "/"))
  Else
    *x\rat\b = 1
  EndIf
  Value_ggT(*x\rat)
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Rational_Flip(*x.Value_S, *v.Value_S)
  Protected  rat.Value_Rat
  
  Select *v\VTable
    Case ?Value_VTable_Rational
      Swap *x\rat\a, *v\rat\a
      Swap *x\rat\b, *v\rat\b
    Case ?Value_VTable_Undefined
      *v\rat\a = *x\rat\a
      *v\rat\b = *x\rat\b
      Swap *x\VTable, *v\VTable
    Case ?Value_VTable_Real
      rat\a = *x\rat\a
      rat\b = *x\rat\b
      *x\real\r = *v\real\r
      *v\rat\a = rat\a
      *v\rat\b = rat\b
      Swap *x\VTable, *v\VTable
    Case ?Value_VTable_Complex
      rat\a = *x\rat\a
      rat\b = *x\rat\b
      *x\complex\r = *v\complex\r
      *x\complex\i = *v\complex\i
      *v\rat\a = rat\a
      *v\rat\b = rat\b
      Swap *x\VTable, *v\VTable
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Rational_Get(*x.Value_S, *v.Value_S) ;*x\Set(*v) = *v\Get(*x), if *x\type = *v\type
  Select *v\VTable
    Case ?Value_VTable_Rational
      *v\rat\a = *x\rat\a
      *v\rat\b = *x\rat\b
    Case ?Value_VTable_Real
      *v\real\r = *x\rat\a / *x\rat\b
    Case ?Value_VTable_Complex
      *v\complex\r = *x\rat\a / *x\rat\b
      *v\complex\i = 0.0
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Rational_Add(*x.Value_S, *v.Value_S)
  Select *v\VTable
    Case ?Value_VTable_Rational
      *x\rat\a * *v\rat\b + *x\rat\b * *v\rat\a
      *x\rat\b * *v\rat\b
      Value_ggT(*x\rat)
    Case ?Value_VTable_Real
      *x\f\Convert(#Value_Real)
      *x\f\Add(*v)
    Case ?Value_VTable_Complex
      *x\f\Convert(#Value_Complex)
      *x\f\Add(*v)
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Rational_Sub(*x.Value_S, *v.Value_S)
  Select *v\VTable
    Case ?Value_VTable_Rational
      *x\rat\a * *v\rat\b - *x\rat\b * *v\rat\a
      *x\rat\b * *v\rat\b
      Value_ggT(*x\rat)
    Case ?Value_VTable_Real
      *x\f\Convert(#Value_Real)
      *x\f\Sub(*v)
    Case ?Value_VTable_Complex
      *x\f\Convert(#Value_Complex)
      *x\f\Sub(*v)
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Rational_Mul(*x.Value_S, *v.Value_S)
  Select *v\VTable
    Case ?Value_VTable_Rational
      *x\rat\a * *v\rat\a
      *x\rat\b * *v\rat\b
      Value_ggT(*x\rat)
    Case ?Value_VTable_Real
      *x\f\Convert(#Value_Real)
      *x\f\Mul(*v)
    Case ?Value_VTable_Complex
      *x\f\Convert(#Value_Complex)
      *x\f\Div(*v)
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Rational_Div(*x.Value_S, *v.Value_S)
  Select *v\VTable
    Case ?Value_VTable_Rational
      *x\rat\a * *v\rat\b
      *x\rat\b * *v\rat\a
      Value_ggT(*x\rat)
    Case ?Value_VTable_Real
      *x\f\Convert(#Value_Real)
      *x\f\Sub(*v)
    Case ?Value_VTable_Complex
      *x\f\Convert(#Value_Complex)
      *x\f\Sub(*v)
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Rational_Pow(*x.Value_S, *v.Value_S)
  Select *v\VTable
    Case ?Value_VTable_Rational
      If *v\rat\b = 1
        *x\rat\a = Pow(*x\rat\a, *v\rat\a)
        *x\rat\b = Pow(*x\rat\b, *v\rat\a)
      Else
        *x\f\Convert(#Value_Real)
        *x\f\Pow(*v)
      EndIf
    Case ?Value_VTable_Real
      *x\f\Convert(#Value_Real)
      *x\f\Pow(*v)
    Case ?Value_VTable_Complex
      *x\f\Convert(#Value_Complex)
      *x\f\Pow(*v)
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Rational_Null(*x.Value_S)
  If *x\rat\a = 0
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure Value_Rational_Neg(*x.Value_S)
  *x\rat\a = -*x\rat\a
  ProcedureReturn *x
EndProcedure

Procedure Value_Rational_SetNull(*x.Value_S)
  *x\rat\a = 0
  *x\rat\b = 1
  ProcedureReturn *x
EndProcedure

Procedure Value_Rational_SetOne(*x.Value_S)
  *x\rat\a = 1
  *x\rat\b = 1
  ProcedureReturn *x
EndProcedure

Procedure Value_Rational_Invert(*x.Value_S)
  Swap *x\rat\a, *x\rat\b
  ProcedureReturn *x
EndProcedure

Procedure Value_Rational_Sqr(*x.Value_S)
  Protected i.d
  
  If *x\rat\a > 0
    *x\VTable = ?Value_VTable_Real
    i = *x\rat\a / *x\rat\b
    *x\real\r = Sqr(i)
  ElseIf *x\rat\a < 0
    *x\VTable = ?Value_VTable_Complex
    i = -*x\rat\a / *x\rat\b
    *x\complex\r = 0.0
    *x\complex\i = Sqr(i)
  EndIf
  
  ProcedureReturn *x
EndProcedure

;- Real
Procedure Value_Real_Copy(*x.Value_S)
  Protected *Value.Value_S = *x\f\NewFromType()
  
  CompilerIf #Value_Errors
  If Not *Value : ProcedureReturn #False : EndIf
  CompilerEndIf
  
  *Value\real\r = *x\real\r
  
  ProcedureReturn *Value
EndProcedure

Procedure.s Value_Real_Str(*x.Value_S, nbDecimals.l)
  If nbDecimals = -1
    ProcedureReturn StrD(*x\real\r)
  Else
    ProcedureReturn StrD(*x\real\r, nbDecimals)
  EndIf
EndProcedure

Procedure Value_Real_Val(*x.Value_S, string.s)
  *x\real\r = ValD(string)
  ProcedureReturn *x
EndProcedure

Procedure Value_Real_Flip(*x.Value_S, *v.Value_S)
  Protected real.Value_Real
  
  Select *v\VTable
    Case ?Value_VTable_Real
      Swap *x\real\r, *v\real\r
    Case ?Value_VTable_Undefined
      *v\real\r = *x\real\r
      Swap *x\VTable, *v\VTable
    Case ?Value_VTable_Rational
      real\r = *x\real\r
      *x\rat\a = *v\rat\a
      *x\rat\b = *v\rat\b
      *v\real\r = real\r
      Swap *x\VTable, *v\VTable
    Case ?Value_VTable_Complex
      real\r = *x\real\r
      *x\complex\r = *v\complex\r
      *x\complex\i = *v\complex\i
      *v\real\r = real\r
      Swap *x\VTable, *v\VTable
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Real_Get(*x.Value_S, *v.Value_S) ;*x\Set(*v) = *v\Get(*x), if *x\type = *v\type
  Select *v\VTable
    Case ?Value_VTable_Real
      *v\real\r = *x\real\r
    Case ?Value_VTable_Complex
      *v\complex\r = *x\real\r
      *v\complex\i = 0.0
    Case ?Value_VTable_Rational
      ProcedureReturn -1
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Real_Add(*x.Value_S, *v.Value_S)
  Select *v\VTable
    Case ?Value_VTable_Real
      *x\real\r + *v\real\r
    Case ?Value_VTable_Rational
      *x\real\r + (*v\rat\a / *v\rat\b)
    Case ?Value_VTable_Complex
      *x\f\Convert(#Value_Complex)
      *x\f\Add(*v)
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Real_Sub(*x.Value_S, *v.Value_S)
  Select *v\VTable
    Case ?Value_VTable_Real
      *x\real\r - *v\real\r
    Case ?Value_VTable_Rational
      *x\real\r - (*v\rat\a / *v\rat\b)
    Case ?Value_VTable_Complex
      *x\f\Convert(#Value_Complex)
      *x\f\Sub(*v)
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Real_Mul(*x.Value_S, *v.Value_S)
  Select *v\VTable
    Case ?Value_VTable_Real
      *x\real\r * *v\real\r
    Case ?Value_VTable_Rational
      *x\real\r * *v\rat\a / *v\rat\b
    Case ?Value_VTable_Complex
      *x\f\Convert(#Value_Complex)
      *x\f\Mul(*v)
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Real_Div(*x.Value_S, *v.Value_S)
  Select *v\VTable
    Case ?Value_VTable_Real
      *x\real\r / *v\real\r
    Case ?Value_VTable_Rational
      *x\real\r * (*v\rat\b / *v\rat\a)
    Case ?Value_VTable_Complex
      *x\f\Convert(#Value_Complex)
      *x\f\Div(*v)
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Real_Pow(*x.Value_S, *v.Value_S)
  Select *v\VTable
    Case ?Value_VTable_Real
      *x\real\r = Pow(*x\real\r, *v\real\r)
    Case ?Value_VTable_Rational
      *x\real\r = Pow(*x\real\r, *v\rat\a / *v\rat\b)
    Case ?Value_VTable_Complex
      *x\f\Convert(#Value_Complex)
      *x\f\Pow(*v)
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Real_Null(*x.Value_S)
  If *x\real\r = 0.0
    ProcedureReturn #True
  EndIf
  
  ProcedureReturn #False
EndProcedure

Procedure Value_Real_Neg(*x.Value_S)
  *x\real\r * -1
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Real_SetNull(*x.Value_S)
  *x\real\r = 0.0
  ProcedureReturn *x
EndProcedure

Procedure Value_Real_SetOne(*x.Value_S)
  *x\real\r = 1.0
  ProcedureReturn *x
EndProcedure

Procedure Value_Real_Invert(*x.Value_S)
  *x\real\r = 1 / *x\real\r
  ProcedureReturn *x
EndProcedure

Procedure Value_Real_Convert(*x.Value_S, type.l, nbDecimals.l)
  Protected v.Value_Real, mul.d = Pow(10, nbDecimals)
  
  If type = #Value_Real
    ProcedureReturn *x
  EndIf
  
  v\r = *x\real\r
  
  Select type
    Case #Value_Rational
      *x\VTable = ?Value_VTable_Rational
      *x\rat\a = IntQ(v\r * mul)
      *x\rat\b = IntQ(mul)
      Value_ggT(*x\rat)
    Case #Value_Complex
      *x\VTable = ?Value_VTable_Complex
      *x\complex\r = v\r
      *x\complex\i = 0.0
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Real_Sqr(*x.Value_S)
  Protected i.d
  
  If *x\real\r >= 0
    *x\real\r = Sqr(*x\real\r)
  Else
    i = -*x\real\r
    *x\VTable = ?Value_VTable_Complex
    *x\complex\r = 0.0
    *x\complex\i = Sqr(i)
  EndIf
  
  ProcedureReturn *x
EndProcedure

;- Complex
Procedure Value_Complex_Copy(*x.Value_S)
  Protected *Value.Value_S = *x\f\NewFromType()
  
  CompilerIf #Value_Errors
  If Not *Value : ProcedureReturn #False : EndIf
  CompilerEndIf
  
  *Value\complex\r = *x\complex\r
  *Value\complex\i = *x\complex\i
  
  ProcedureReturn *Value
EndProcedure

Procedure.s Value_Complex_Str(*x.Value_S, nbDecimals.l)
  Protected s.s
  
  If nbDecimals = -1
    s = StrD(*x\complex\r)
    If *x\complex\i >= 0.0 : s + "+" : EndIf
    ProcedureReturn s + StrD(*x\complex\i) + "i"
  Else
    s = StrD(*x\complex\r, nbDecimals)
    If *x\complex\i >= 0.0 : s + "+" : EndIf
    ProcedureReturn s + StrD(*x\complex\i, nbDecimals) + "i"
  EndIf
EndProcedure

Procedure Value_Complex_Val(*x.Value_S, string.s)
  *x\complex\r = ValD(string)
  If FindString(string, "-", 2)
    *x\complex\i = -ValD(StringField(Mid(string, 2, Len(string)), 2, "-"))
  Else
    *x\complex\i = ValD(StringField(string, 2, "+"))
  EndIf
  ProcedureReturn *x
EndProcedure

Procedure Value_Complex_Flip(*x.Value_S, *v.Value_S)
  Protected complex.Value_Complex
  
  Select *v\VTable
    Case ?Value_VTable_Complex
      Swap *x\complex\r, *v\complex\r
      Swap *x\complex\i, *v\complex\i
    Case ?Value_VTable_Undefined
      *v\complex\r = *x\complex\r
      *v\complex\i = *x\complex\i
      Swap *x\VTable, *v\VTable
    Case ?Value_VTable_Rational
      complex\r = *x\complex\r
      complex\i = *x\complex\i
      *x\rat\a = *v\rat\a
      *x\rat\b = *v\rat\b
      *v\complex\r = complex\r
      *v\complex\i = complex\i
      Swap *x\VTable, *v\VTable
    Case ?Value_VTable_Real
      complex\r = *x\complex\r
      complex\i = *x\complex\i
      *x\real\r = *v\real\r
      *v\complex\r = complex\r
      *v\complex\i = complex\i
      Swap *x\VTable, *v\VTable
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Complex_Get(*x.Value_S, *v.Value_S)
  Select *v\VTable
    Case ?Value_VTable_Complex
      *v\complex\r = *x\complex\r
      *v\complex\i = *x\complex\i
    Default
      ProcedureReturn -1
  EndSelect
  ProcedureReturn *x
EndProcedure

Procedure Value_Complex_Add(*x.Value_S, *v.Value_S)
  Select *v\VTable
    Case ?Value_VTable_Complex
      *x\complex\r + *v\complex\r
      *x\complex\i + *v\complex\i
    Case ?Value_VTable_Rational
      *x\complex\r + (*v\rat\a / *v\rat\b)
    Case ?Value_VTable_Real
      *x\complex\r + *v\real\r
  EndSelect
  ProcedureReturn *x
EndProcedure

Procedure Value_Complex_Sub(*x.Value_S, *v.Value_S)
  Select *v\VTable
    Case ?Value_VTable_Complex
      *x\complex\r - *v\complex\r
      *x\complex\i - *v\complex\i
    Case ?Value_VTable_Rational
      *x\complex\r - (*v\rat\a / *v\rat\b)
    Case ?Value_VTable_Real
      *x\complex\r - *v\real\r
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Complex_Mul(*x.Value_S, *v.Value_S)
  Protected d.d
  
  Select *v\VTable
    Case ?Value_VTable_Complex
      d = *x\complex\r * *v\complex\r - *x\complex\i * *v\complex\i
      *x\complex\i * *v\complex\r + *x\complex\r * *v\complex\i
      *x\complex\r = d
    Case ?Value_VTable_Rational
      d = *v\rat\a / *v\rat\b
      *x\complex\r * d
      *x\complex\i * d
    Case ?Value_VTable_Real
      *x\complex\r * *v\real\r
      *x\complex\i * *v\real\r
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Complex_Div(*x.Value_S, *v.Value_S)
  Protected z.d, d.d
  
  Select *v\VTable
    Case ?Value_VTable_Complex
      z = 1 / (*v\complex\r * *v\complex\r + *v\complex\i * *v\complex\i)
      d = (*x\complex\r * *v\complex\r + *x\complex\i * *v\complex\i) * z
      *x\complex\i = (*x\complex\i * *v\complex\r - *x\complex\r * *v\complex\i) * z
      *x\complex\r = d
    Case ?Value_VTable_Rational
      d = *v\rat\b / *v\rat\a
      *x\complex\r * d
      *x\complex\i * d
    Case ?Value_VTable_Real
      *x\complex\r / *v\real\r
      *x\complex\i / *v\real\r
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Complex_Pow(*x.Value_S, *v.Value_S)
  Protected complex.Value_Complex, log.Value_Complex, prod.Value_Complex
  
  Select *v\VTable
    Case ?Value_VTable_Complex
      complex\r = *v\complex\r
      complex\i = *v\complex\i
    Case ?Value_VTable_Rational
      complex\r = *v\rat\a / *v\rat\b
      complex\i = 0.0
    Case ?Value_VTable_Real
      complex\r = *v\real\r
      complex\i = 0.0
    Default
      ProcedureReturn
  EndSelect
  
  log\r = Log(*x\complex\r * *x\complex\r + *x\complex\i * *x\complex\i) * 0.5
  log\i = ATan(*x\complex\i / *x\complex\r)
  prod\r = complex\r * log\r - complex\i * log\i
  prod\i = complex\r * log\i + complex\i * log\r
  prod\r = exp(prod\r)
  If *x\complex\r >= 0.0
    *x\complex\r = prod\r * Cos(prod\i)
    *x\complex\i = prod\r * Sin(prod\i)
  Else
    *x\complex\r = -prod\r * Sin(prod\i)
    *x\complex\i = prod\r * Cos(prod\i)
  EndIf
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Complex_Null(*x.Value_S)
  If *x\complex\r = 0.0 And *x\complex\i = 0.0
    ProcedureReturn #True
  EndIf
  
  ProcedureReturn #False
EndProcedure

Procedure Value_Complex_Neg(*x.Value_S)
  *x\complex\r * -1
  *x\complex\i * -1
  ProcedureReturn *x
EndProcedure

Procedure Value_Complex_SetNull(*x.Value_S)
  *x\complex\r = 0.0
  *x\complex\i = 0.0
  ProcedureReturn *x
EndProcedure

Procedure Value_Complex_SetOne(*x.Value_S)
  *x\complex\r = 1.0
  *x\complex\i = 0.0
  ProcedureReturn *x
EndProcedure

Procedure Value_Complex_Invert(*x.Value_S)
  Protected z.d
  
  z = 1 / (*x\complex\r * *x\complex\r + *x\complex\i * *x\complex\i)
  *x\complex\i * -z
  *x\complex\r * z
  ProcedureReturn *x
EndProcedure

Procedure Value_Complex_Convert(*x.Value_S, type.l, nbDecimals.l)
  Protected v.Value_Complex, mul.d = Pow(10, nbDecimals)
  
  If type = #Value_Complex
    ProcedureReturn *x
  EndIf
  
  v\r = *x\complex\r
  v\i = *x\complex\i
  
  Select type
    Case #Value_Rational
      *x\VTable = ?Value_VTable_Rational
      *x\rat\a = IntQ(v\r * mul)
      *x\rat\b = IntQ(mul)
      Value_ggT(*x\rat)
    Case #Value_Real
      *x\VTable = ?Value_VTable_Complex
      *x\real\r = v\r
  EndSelect
  
  ProcedureReturn *x
EndProcedure

Procedure Value_Complex_Sqr(*x.Value_S)
  Protected complex.Value_Complex, log.Value_Complex, prod.Value_Complex
  
  complex\r = 0.5
  complex\i = 0.0
  
  log\r = Log(*x\complex\r * *x\complex\r + *x\complex\i * *x\complex\i) * 0.5
  log\i = ATan(*x\complex\i / *x\complex\r)
  prod\r = complex\r * log\r - complex\i * log\i
  prod\i = complex\r * log\i + complex\i * log\r
  prod\r = exp(prod\r)
  If *x\complex\r >= 0.0
    *x\complex\r = prod\r * Cos(prod\i)
    *x\complex\i = prod\r * Sin(prod\i)
  Else
    *x\complex\r = -prod\r * Sin(prod\i)
    *x\complex\i = prod\r * Cos(prod\i)
  EndIf
  
  ProcedureReturn *x
EndProcedure

;- Main
Procedure Value_Free(*x.Value_S)
  FreeMemory(*x)
EndProcedure

Procedure Value_Value(*x.Value_S)
  ProcedureReturn @*x\value
EndProcedure

Procedure Value_NewFromType(*x.Value_S)
  Protected *Value.Value_S, *v.Value
  
  *Value = AllocateMemory(SizeOf(Value_S))
  CompilerIf #Value_Errors
  If Not *Value : ProcedureReturn #False : EndIf
  CompilerEndIf
  
  *v = *Value
  *Value\VTable = *x\VTable
  *Value\f = *Value
  If *x\VTable <> ?Value_VTable_Undefined
    *v\SetNull()
  EndIf
  
  ProcedureReturn *Value
EndProcedure

Procedure Value_Set(*x.Value_S, *v.Value_S)
  *x\VTable = *v\VTable
  Select *v\VTable
    Case ?Value_VTable_Undefined
      ;do nothing
    Case ?Value_VTable_Rational
      *x\rat\a = *v\rat\a
      *x\rat\b = *v\rat\b
    Case ?Value_VTable_Real
      *x\real\r = *v\real\r
    Case ?Value_VTable_Complex
      *x\complex\r = *v\complex\r
      *x\complex\i = *v\complex\i
  EndSelect
  ProcedureReturn *x
EndProcedure

Macro CreateVTable(type)
DataSection
  Value_VTable_#type#:
    Data.l @Value_Free(), @Value_Value(), @Value_NewFromType()
    Data.l @Value_#type#_Copy(), @Value_#type#_Str(), @Value_#type#_Val(), @Value_#type#_Flip(), @Value_Set(), @Value_#type#_Get()
    Data.l @Value_#type#_Add(), @Value_#type#_Sub(), @Value_#type#_Mul(), @Value_#type#_Div(), @Value_#type#_Pow(), @Value_#type#_Null()
    Data.l @Value_#type#_Neg(), @Value_#type#_SetNull(), @Value_#type#_SetOne(), @Value_#type#_Invert(), @Value_#type#_Convert()
    Data.l @Value_#type#_Sqr()
EndDataSection  
EndMacro
CreateVTable(Rational)
CreateVTable(Real)
CreateVTable(Complex)
DataSection
  Value_VTable_Undefined:
    Data.l @Value_Free(), @Value_Value(), @Value_NewFromType()
    Data.l @Value_Undefined_Copy(), @Value_Undefined_Str(), @Value_Undefined_Val(), 0, @Value_Set(), 0
    Data.l @Value_Undefined_Add(), @Value_Undefined_Sub(), 0, 0, 0, @Value_Undefined_DoNothing()
    Data.l @Value_Undefined_DoNothing(), @Value_Undefined_DoNothing(), @Value_Undefined_DoNothing(), @Value_Undefined_DoNothing(), @Value_Undefined_DoNothing()
    Data.l 0
EndDataSection
Procedure Value_New(type.l = #Value_Undefined, *Value.Value_S = 0)
  Protected *v.Value
  
  
  If Not *Value
    *Value = AllocateMemory(SizeOf(Value_S))
    If Not *Value : ProcedureReturn #False : EndIf
  EndIf
  
  *v = *Value
  
  Select type
    Case #Value_Undefined
      *Value\VTable = ?Value_VTable_Undefined
    Case #Value_Rational
      *Value\VTable = ?Value_VTable_Rational
      *v\SetNull()
    Case #Value_Real
      *Value\VTable = ?Value_VTable_Real
      *v\SetNull()
    Case #Value_Complex
      *Value\VTable = ?Value_VTable_Complex
      *v\SetNull()
  EndSelect
  
  *Value\f = *v
  
  ProcedureReturn *Value
EndProcedure
DisableExplicit

Noch ein kleines Beispiel:

Code: Alles auswählen

Define *v1.Value, *v2.Value, *v3.Value, *v4.Value

*v1 = Value_New(#Value_Rational)
*v1\Val("2/3")
*v2 = Value_New(#Value_Rational)
*v2\Val("4/3")

Debug *v1\Str()
*v1\Pow(*v2)
*v1\Flip(*v2)
Debug *v1\Str()
Debug *v2\Str()

*v3 = Value_New(#Value_Complex)
*v3\Val("3+4i")
*v4 = *v3\Copy()
*v4\Invert()
Debug *v3\Str()
Debug *v4\Str()
*v3\Mul(*v4)
Debug *v3\Str()

Verfasst: **08.02.2008 02:09**

da war aber einer schneller ^^
http://www.purearea.net/pb/showcase/sho ... 815634b7b0
das ist n richtig gute Lib und die Hilfe hat der Typ auch recht anschaulich gemacht.

(Soll aber nicht heißen das du nicht weiter machen sollst^^, ist halt nur eine Information)

Verfasst: **08.02.2008 02:22**

Aha, wusste ich nicht.

Aber ich hab es mir gerade heruntergeladen und gemerkt, dass mir das gar
nichts bringt. Ich nutze nämlich Linux und damit kann ich noch nicht mal die
Hilfe öffnen.

Weiter machen tu ich auf jeden Fall. Es macht doch gerade so viel Spaß.
Wenn ich die Matrix-Funktionen auch in ein nettes Interface gepackt hab,
kommen erstmal Polynome dran.

Achja, wäre trotzdem nett, wenn du die Include mal antesten würdest.
Und du weißt nicht zufällig wie ich zwei komplexe Zahlen potenziere?

Verfasst: **08.02.2008 02:43**

NicTheQuick hat geschrieben: Achja, wäre trotzdem nett, wenn du die Include mal antesten würdest.
Und du weißt nicht zufällig wie ich zwei komplexe Zahlen potenziere?

1. jo mache ich ^^

2. das geht meiner meinung nicht :
Potentiert man eine Komplexe Zahl mit einer Reelen Zahl so entspricht das ja in der Gauß'schen Zahlenebene einer Rotations des Vektors um das Zentrum , wo bei der Exponent den Winkel bestimmt und den Vektor verlängert. (ich denke mal n Bild ist nicht nötig, du hast ja auch Mathe in der UNI)
Soo, wenn nun aber der Exponent selber auch komplex ist wüste ich nicht wie das aussehen sollte, nur das dann Theoretisch eine 3. Dimension eingeschlagen werden würde.
Ich werde mal drüber nachdenken und dann vllt mein Ergebnis posten

EDIT: Das wäre ja mit einer Potenzierung eines 2D-Vektors mit einerm 2D-Vektor vergleichbar....

EDIT2: habe aber gerade n Idee und versuche sie umzusetzten :
Sei a,b Komplex:
a^b = e^(b*ln(a))
damit wäre wieder alles lösbar, e^Komplex geht, ln(Komplex) geht, und Komplex *Komplex geht auch ....

Verfasst: **08.02.2008 03:49**

habe es geschafft:

Code: Alles auswählen


Structure Value_Complex 
  r.d 
  i.d 
EndStructure 

#e = 2.71828182845905

Procedure PowC(*Basis.Value_Complex, *Exponent.Value_Complex,  *Wert.Value_Complex)
 ; a^b : e^b*log(a)
 Log.Value_Complex
 Log\r = Log(*Basis\r * *Basis\r + *Basis\i * *Basis\i) / 2
 Log\i = ATan(*Basis\i / *Basis\r)
 Prod.Value_Complex 
 Prod\r = *Exponent\r * Log\r - *Exponent\i * Log\i
 Prod\i = *Exponent\r * Log\i + *Exponent\i * Log\r
 *Wert\r = Pow(#e,Prod\r)*Cos(Prod\i)
 *Wert\i = Pow(#e,Prod\r)*Sin(Prod\i)
EndProcedure

A.Value_Complex
B.Value_Complex

C.Value_Complex

A\r = 0 : A\i = 1
B\r = 2 : B\i = 0

PowC(A, B, C)

Debug " "+StrD(C\r)+"+i"+StrD(C\i)

Am geilsten finde ich ja das i^i ein Reeller Wert ist

Verfasst: **08.02.2008 09:05**

Geile Sache!

Ich wusste, dass i^i ein reeller Wert ist und hab dafür auch irgendwo den
Beweis, aber wie es allgemein geht, wusste ich nicht. Ich hab auch irgendwo
in Wikipedia mal gelesen, dass bestimmte Potenzen nicht definiert oder sogar
doppelt bestimmt sind.

Ich werde deinen Code vllt. heute noch überprüfen und dann bei mir
einbauen.

Also Danke!

Verfasst: **08.02.2008 10:47**

jo ich weiß, in den "echten" berechungen tauscht noch n 2*k*PI auf, was das ganze um 360° drehen könnte, was sicherlcih zur Lösungsmenge gehört aber im normalen gebrauch völlig überflüssig ist, da es ja wieder ich die gleiche richtung zeigt.

Verfasst: **08.02.2008 12:08**

Hab deinen Code jetzt eingebaut. Siehe Edit oben.
Auch Google bestätigt ein paar Beispiele, die ich mal eingetippt habe.

Verfasst: **14.02.2008 13:00**

Es gibt wieder ein Update. Siehe oben.

Verfasst: **15.02.2008 11:21**

@NicTheQuick

schon mal mein OOP-PreCompiler ausprobiert. Brauchst dann dich um eine sachen nicht mehr kümmern wie Interface anlegen, etc.

http://www.purebasic.fr/german/viewtopi ... 574#183574

FF

PureBoard

Value-Interface für rationale, reelle und komplexe Zahlen

Value-Interface für rationale, reelle und komplexe Zahlen