CalculateIt - Mathematische Terme ausrechnen

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Jilocasin
Beiträge: 665
Registriert: 13.05.2006 16:04
Kontaktdaten:

CalculateIt - Mathematische Terme ausrechnen

Beitrag von Jilocasin »

CalculateIt - Mathematische Terme direkt ausrechnen und das Ergebnis als Zahl ausgeben :)

Ein einfaches Beispiel:

Code: Alles auswählen

Debug Calculate("67*6/1+(5^2)")
Die meisten Befehle aus der PureBasic Math-Library können auch direkt verwendet werden:

Beispielsweise:

Code: Alles auswählen

Debug Calculate("Sin(90/180*#Pi)")

Debug Calculate("5 * Round ( 5.49 )")

Debug Calculate("Abs(-1) * Int(4.8)")

Debug Calculate("Degree(Radian(10))")

Sollte es Strings geben, die falsch ausgerechnet werden, bitte melden! Hoffe ich kann spezielle "Unfälle" dann fixen. :D

Code: Alles auswählen

; ******************************
;
;          CalculateIt
;
; ******************************
;
; (c) Daniel Obermeier 2007-2010
;
; ******************************


; Besonderheiten:

; "-7^2" = 49 (Hier wird das Minus in die Berechnung einbezogen, als Ersatz, da eine mathematische Klammer nicht direkt beachtet wird)
; "(-7)^2" = 49 (Hier wird die Klammer automatisch zuerst aufgelöst, wodurch die obere Gleichung entsteht)
; "-(7^2)" = - 49

; Fakultät und NOT wird benutzt wie eine Funktion:
; "Fact(...)"
; "Not(...)"

; Ab Fact(22) aufwärts werden die Ergebnisse der Fakultät durch die Doubles ungenau

; Vorgegebene Konstanten:
; #Pi
; #e

; Verwendbare Funktionen:
; - Abs()
; - ACos()
; - ACosH()
; - ASin()
; - ASinH()
; - ATan()
; - ATanH()
; - Blue()
; - Cos()
; - CosH()
; - Degree()
; - Fact() [Fakultät]
; - Green()
; - Log()
; - Log10()
; - Not() [Logisches NOT]
; - Radian()
; - Red()
; - Round()
; - Int()
; - Sign()
; - Sin()
; - SinH()
; - Sqr()
; - Tan()
; - TanH()

EnableExplicit


Procedure.i IsNumber(String.s)
  Protected CurrentPosition.i = 0
  Protected CheckCharacter.s = ""
  
  If Len(String) = 0
    ProcedureReturn 0
  EndIf
  
  For CurrentPosition = 1 To Len(String)
    CheckCharacter.s = Mid(String, CurrentPosition, 1)
    If Len(String) > 1 And CurrentPosition = 1 And (CheckCharacter = "-" Or CheckCharacter = "+")
       ; Was ist alles zulässig...
    ElseIf CheckCharacter = "."
      ; Was ist alles zulässig...
    ElseIf Str(Val(CheckCharacter)) = CheckCharacter
      ; Was ist alles zulässig...
    Else
      ProcedureReturn 0
    EndIf
  Next
  
  ProcedureReturn 1
EndProcedure


Procedure.s TrimZeros(String.s)
  Protected LastZero.i
  
  If FindString(String, ".", 1)
    For LastZero = Len(String) To 1 Step -1
      If Mid(String, LastZero, 1) <> "0"
        Break
      EndIf
    Next
    
    If Mid(String, LastZero, 1) = "."
      ProcedureReturn Left(String, LastZero - 1)
    Else
      ProcedureReturn Left(String, LastZero)
    EndIf
  Else
    ProcedureReturn String
  EndIf
EndProcedure


Macro StrDD(Value)
  TrimZeros(StrD(Value, 16))
EndMacro


Macro RoundNearest(Content)
  Round(Content, #PB_Round_Nearest)
EndMacro


Procedure.q NotFunction(Value.d)
  ProcedureReturn ~IntQ(Value)
EndProcedure


Procedure.d FactorialFunction(Value.i)
  Protected Index.i
  Protected Result.d = 1
  
  
  For Index = 1 To IntQ(Value)
    Result * Index
  Next
  
  ProcedureReturn Result
EndProcedure

Macro Function(CalculateName, Length, PurebasicName)
  ; Length könnte man durch Len(CalculateName) ersetzen, aber aus Performancegründen geben wir die Stringlänge dann beim Aufruf von Function() an
  ; Wenn PB schlau wäre, könnte er das ja direkt beim kompilieren ersetzen, aber ich vermute Len("123") wird nicht durch "3" ersetzt, sondern wird ins Executable übernommen...
  
  ElseIf Mid(String, BracketFirst - Length, Length) = CalculateName
    LengthLeft - Length
    
    If IsNumber(Mid(String, BracketFirst - 1 - Length, 1))
      String = Left(String, LengthLeft) + "*" + StrDD(PurebasicName(ValD(StringInBrackets))) + Right(String, LengthRight)
    Else
      String = Left(String, LengthLeft) + StrDD(PurebasicName(ValD(StringInBrackets))) + Right(String, LengthRight)
    EndIf
EndMacro


Procedure.s RemoveNeedlessBrackets(String.s)
  Protected BracketFirst.i = 0
  Protected BracketLast.i = 0
  Protected LengthLeft.i = 0
  Protected LengthRight.i = 0
  Protected CurrentPosition.i = 0
  Protected StringInBrackets.s = ""
  
  BracketFirst = 0
  BracketLast = 0
  CurrentPosition = 0
  
  Repeat
    CurrentPosition + 1
    
    If Mid(String, CurrentPosition, 1) = "("
      BracketFirst = CurrentPosition
    EndIf
    If Mid(String, CurrentPosition, 1) = ")"
      BracketLast = CurrentPosition
    EndIf
    
    If BracketFirst And BracketLast
      StringInBrackets.s = Mid(String, BracketFirst + 1, BracketLast - BracketFirst - 1)
      
      If IsNumber(StringInBrackets) ; (zahl) oder f(zahl) -> Dann können wir die Klammern drumherum weghauen / die Funktion auflösen
        LengthLeft = BracketFirst - 1
        LengthRight = Len(String) - BracketLast
        
        If 0 ; In Function steckt das ElseIf, so muss das erste ElseIf unbedingt durch Fehlschlag ausgeführt werden...
          Function("SQR", 3, Sqr)
          Function("NOT", 3, NotFunction)
          Function("FACT", 4, FactorialFunction)
          Function("ASIN", 4, ASin)
          Function("ASINH", 5, ASinH)
          Function("ACOS", 4, Acos)
          Function("ACOSH", 5, AcosH)
          Function("ATAN", 4, Atan)
          Function("ATANH", 5, AtanH)
          Function("SIN", 3, Sin)
          Function("SINH", 4, SinH)
          Function("COS", 3, Cos)
          Function("COSH", 4, CosH)
          Function("DEGREE", 6, Degree)
          Function("TAN", 3, Tan)
          Function("TANH", 4, TanH)
          Function("LOG", 3, Log)
          Function("LOG10", 5, Log10)
          Function("RADIAN", 6, Radian)
          Function("ROUND", 5, RoundNearest)
          Function("ABS", 3, Abs)
          Function("INT", 3, Int)
          Function("SIGN", 4, Sign)
          Function("RED", 3, Red)
          Function("GREEN", 5, Green)
          Function("BLUE", 4, Blue)
        Else
          If IsNumber(Mid(String, BracketFirst - 1, 1))
            String = Left(String, LengthLeft) + "*" + StringInBrackets + Right(String, LengthRight)
          Else
            String = Left(String, LengthLeft) + StringInBrackets + Right(String, LengthRight)
          EndIf
          
        EndIf
        
        CurrentPosition = 1
      EndIf
      
      BracketFirst = 0
      BracketLast = 0
    EndIf
    
  Until CurrentPosition = Len(String)
  
  ProcedureReturn String
EndProcedure





Procedure.s ChangeDoublePrefix(String.s)
  While CountString(String, "--") Or CountString(String, "++") Or CountString(String, "+-") Or CountString(String, "-+")
    String = ReplaceString(String, "--", "+")
    String = ReplaceString(String, "++", "+")
    String = ReplaceString(String, "+-", "-")
    String = ReplaceString(String, "-+", "-")
  Wend
  ProcedureReturn String
EndProcedure



Macro GetStringInBrackets()
  BracketFirst = 0
  BracketLast = 0
  
  For CurrentPosition = 1 To Len(Input)
    If Mid(Input, CurrentPosition, 1) = "("
      BracketFirst = CurrentPosition
     EndIf
    
    If Mid(Input, CurrentPosition, 1) = ")"
       BracketLast = CurrentPosition
    EndIf
    
     If BracketFirst And BracketLast
      StringInBrackets = Mid(Input, BracketFirst + 1, BracketLast - BracketFirst - 1)
      Break
    EndIf
  Next
EndMacro



Macro Calculation(CalculateOperator, PurebasicOperator, ValType, ResultType, IsDivision, IsPower)
      LeftParameter = ""
      RightParameter = ""
      
      If Mid(StringInBrackets, CurrentPosition, 1) = CalculateOperator
        For SearchParameterIndex = CurrentPosition - 1 To 1 Step -1
          If IsNumber(Mid(StringInBrackets, SearchParameterIndex, 1)) = 0
            LeftParameter.s = Mid(StringInBrackets, SearchParameterIndex + 1, CurrentPosition - SearchParameterIndex - 1)
            LengthLeft = BracketFirst + SearchParameterIndex
            
            If Mid(StringInBrackets, SearchParameterIndex, 1) = "-"
              LeftParameter = "-" + LeftParameter
              LengthLeft - 1
            EndIf
            
            Break
          ElseIf SearchParameterIndex = 1
            LeftParameter.s = Mid(StringInBrackets, SearchParameterIndex, CurrentPosition - SearchParameterIndex)
            LengthLeft = BracketFirst
            Break
          EndIf
        Next
        
        For SearchParameterIndex = CurrentPosition + 1 To Len(StringInBrackets) Step 1
          If IsNumber(Mid(StringInBrackets, SearchParameterIndex + 1, 1)) = 0 And Mid(StringInBrackets, CurrentPosition + 1, 1) = "-"
            RightParameter.s = Mid(StringInBrackets, CurrentPosition + 1, SearchParameterIndex - CurrentPosition)
            LengthRight = Len(Input) - (BracketFirst + SearchParameterIndex)
            Break
          ElseIf IsNumber(Mid(StringInBrackets, SearchParameterIndex, 1)) = 0 And Mid(StringInBrackets, CurrentPosition + 1, 1) <> "-"
            RightParameter.s = Mid(StringInBrackets, CurrentPosition + 1, SearchParameterIndex - CurrentPosition - 1)
            LengthRight = Len(Input) - (BracketFirst + SearchParameterIndex - 1)
            Break
          ElseIf SearchParameterIndex = Len(StringInBrackets)
            RightParameter.s = Mid(StringInBrackets, CurrentPosition + 1, SearchParameterIndex - CurrentPosition)
            LengthRight = Len(Input) - (BracketLast) + 1
            Break
          EndIf
        Next
        
        
        
        If IsNumber(LeftParameter) And IsNumber(RightParameter)
          CompilerIf IsDivision
            If ValType(RightParameter)
              ResultType = ValD(LeftParameter) PurebasicOperator ValD(RightParameter)
              Input = Left(Input, LengthLeft) + StrDD(ResultType) + Right(Input, LengthRight)
              
              GetStringInBrackets()
              CurrentPosition = 1
            Else
              ProcedureReturn 0 ; Teilen durch 0
            EndIf
          CompilerElse
            CompilerIf IsPower
              ResultType = Pow(ValType(LeftParameter), ValType(RightParameter))
            CompilerElse
              ResultType = ValType(LeftParameter) PurebasicOperator ValType(RightParameter)
            CompilerEndIf
            Input = Left(Input, LengthLeft) + StrDD(ResultType) + Right(Input, LengthRight)
            
            GetStringInBrackets()
            CurrentPosition = 1
          CompilerEndIf
        EndIf
      EndIf
EndMacro


ProcedureDLL.d Calculate(Input.s)
  Protected ResultFloat.d = 0
  Protected ResultInt.q = 0
  Protected CurrentPosition.i = 0
  Protected SearchParameterIndex.i = 0
  Protected StringInBrackets.s = ""
  Protected LeftParameter.s = ""
  Protected RightParameter.s = ""
  Protected LengthLeft.i = 0
  Protected LengthRight.i = 0
  Protected BracketFirst.i = 0
  Protected BracketLast.i = 0
  Protected FirstInput.s = ""
  
  If CountString(Input, "(") <> CountString(Input, ")")
    ProcedureReturn 0
  EndIf
  
  Input = "(" + UCase(RemoveString(Input, " ")) + ")"
  
  Input = ReplaceString(Input, "#PI", StrDD(#PI))
  Input = ReplaceString(Input, "#E",  StrDD(#E))
  
  Input = ChangeDoublePrefix(Input)
  Input = RemoveNeedlessBrackets(Input)
  
  
  Repeat
    ; Den ersten innersten Klammerstring finden:
    
    FirstInput = Input
    
    GetStringInBrackets()
   
    ; Wir suchen jetzt nach möglichen Berechnungen im innersten Klammerstring, der Priorität nach
    
    For CurrentPosition = 1 To Len(StringInBrackets) ; Prüfen auf Priorität 1: > < % !
      Calculation(">", >>, Val, ResultInt, #False, #False)
      Calculation("<", <<, Val, ResultInt, #False, #False)
      Calculation("%", %, Val, ResultInt, #False, #False)
      Calculation("!", !, Val, ResultInt, #False, #False)
    Next
    
    For CurrentPosition = 1 To Len(StringInBrackets) ; Prüfen auf Priorität 2: | &
      Calculation("|", |, Val, ResultInt, #False, #False)
      Calculation("&", &, Val, ResultInt, #False, #False)
    Next
    
    For CurrentPosition = 1 To Len(StringInBrackets) ; Prüfen auf Priorität 3: ^
      Calculation("^", ^, ValD, ResultFloat, #False, #True)
    Next
    
    For CurrentPosition = 1 To Len(StringInBrackets) ; Prüfen auf Priorität 4: / *
      Calculation("/", /, ValD, ResultFloat, #True, #False)
      Calculation("*", *, ValD, ResultFloat, #False, #False)
    Next
    
    For CurrentPosition = 1 To Len(StringInBrackets) ; Prüfen auf Priorität 5: + -
      Calculation("+", +, ValD, ResultFloat, #False, #False)
      Calculation("-", -, ValD, ResultFloat, #False, #False)
    Next
    
    ; Der bearbeitete StringInBrackets sollte jetzt auf eine Zahl aufgelöst sein
    
    Input = ChangeDoublePrefix(Input)
    Input = RemoveNeedlessBrackets(Input)
    
    If CountString(Input, "(") = 0 And CountString(Input, ")") = 0
      Break
    EndIf
    
    If Input = FirstInput
      ProcedureReturn 0
    EndIf
    
  ForEver
  
  
  ProcedureReturn ValD(Input)
EndProcedure
Zuletzt geändert von Jilocasin am 02.08.2010 15:54, insgesamt 15-mal geändert.
Bild
Jilocasin
Beiträge: 665
Registriert: 13.05.2006 16:04
Kontaktdaten:

Beitrag von Jilocasin »

- Updates und News im ersten Beitrag -
Zuletzt geändert von Jilocasin am 31.07.2010 04:25, insgesamt 1-mal geändert.
Bild
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 7032
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Beitrag von STARGÅTE »

DOCH DOCH,

Weil ich gerade ein Funktionsplotter baue, da brauche ich das, mal sehen wann ich es mal austeste.


TIP, füge noch verschiedene Konstanten ein die er automatisch übersetzt :
PI, e

Und die jeweiligen Umkerfunktionen ArcSin, ArcCos, ArcTan.

EDIT: Irgendwie weiß ich nicht wie ich das Beispiel in 3.3 schreiben soll, kannst du mir helfen ?
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Jilocasin
Beiträge: 665
Registriert: 13.05.2006 16:04
Kontaktdaten:

Beitrag von Jilocasin »

Naja, 3.3 kann keine 8-Byte Variablen soweit ich weiß...
Und bei CallFunction können nach wie vor keine Fließkommawerte zurückgegeben werden :(
Das ist ein wenig blöd...

Die Konstanten hab ich integriert, danke

Vielleicht weiß ja jemand wie man in 3.3 Doubles zurückgeben lassen kann. Zur Not würden es ja auch Floats tun, dann würde ich den Code schnell kopieren und umschreiben :)
Bild
Benutzeravatar
AND51
Beiträge: 5220
Registriert: 01.10.2005 13:15

Beitrag von AND51 »

Interessantes Projekt! Wollte ich auch mal machen, bis ich merkte, dass es doch nicht so schnell geht, wie ich wollte... :lol:

Ich finde es ja gut, dass du z. B: die RGB()-Funktionen drin hast. Das heißt: RGB() hast du ja nicht mal drin, eher nur RED(), GRE() und BLU().
Macht denn so viel Abkürzen wirklich Sinn? Also das würde ich auf jeden Fall ausschreiben oder zumindest es so machen, dass man BLU oder BLUE verwenden kann. Das gleiche auch mit RND...
PB 4.30

Code: Alles auswählen

Macro Happy
 ;-)
EndMacro

Happy End
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 7032
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Beitrag von STARGÅTE »

also .f würde reichen
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Jilocasin
Beiträge: 665
Registriert: 13.05.2006 16:04
Kontaktdaten:

Beitrag von Jilocasin »

@And51:
Ich prüfe aus Performance-Gründen immer nur die drei Ziffern vor der Klammer, habs jetzt in die PureBAsic Befehle geändern unt ASin etc. zugefügt.

@Stargate..
Würde ich ja gerne aber CallFunction schreibt:
Hinweis: diese Funktion ist nicht sehr flexibel und kann nicht mit Double/Quad-Variablen als Parameter oder Fließkomma/Double/Quad - Rückgabewerten umgehen. Die Prototypen sind jetzt stattdessen bevorzugt zu empfehlen.
:(
Bild
Benutzeravatar
AND51
Beiträge: 5220
Registriert: 01.10.2005 13:15

Beitrag von AND51 »

> Würde ich ja gerne aber CallFunction schreibt
Ich habe jetzt nicht alles mitgekriegt, aber warum gibst du dann nicht einfach den Pointer zu einem AllocateMemory zurück, wo du den Float mit PokeF() reinschreibst?

Hoffe, das gehört zum Thema, ansonsten: ignoriert es einfach.
PB 4.30

Code: Alles auswählen

Macro Happy
 ;-)
EndMacro

Happy End
Jilocasin
Beiträge: 665
Registriert: 13.05.2006 16:04
Kontaktdaten:

Beitrag von Jilocasin »

Habs getestet -> Dann kommt beim Auslesen ein "Invalid Memory Access", weil ich mal annehme, dass der Speicherbereich freigegeben wird, wenn die ProcedureDLL geschlossen wird.

Aber ich gebe einfach einen String zurück :lol: *bing, idee*
Der kann dann einfach mit ValF() interpretiert werden

Also Stargate, hier ist deine Version: DOWNLOAD

Dann probier mal

Code: Alles auswählen

ValF(PeekS(CallFunction(0, "Calculate", "1+1")))
Bild
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 7032
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Beitrag von STARGÅTE »

SUPER GEIL, Funzt, bis auf ein paar kleine Berechnungsfehler, die man aber auch nur sieht wenn man das Ding im zusammenhang mit einerm Funktionsplotter benutzt.

Ich jedenfalls habe dasfür auf jedenfall verwendungszweck.

DANKE
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Antworten