You can do a search for it in the MSDN Library CHM Help and mark it as a "favorite" there as well. You'll probably get hits on two VBA entries and a VB6 entry along with a lot of red herrings if you search on "Operator Precedence"
Last edited by dilettante; Mar 22nd, 2018 at 07:56 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
It took me a while to figure out why dilettante's VEval class was faster than my SimpleEval over 100k iterations. It turned out that having a local array like `Dim aValStack(0 To 1000) As Double` in a function induces a penalty for clearing it's members to zeroes, so just switching to `Static` arrays doubled my speed.
Nevertheless I peeked at the assembly code VB6 was producing for the simple parser and got really frustrated with the inefficiencies produced by array indexing and what not. So came up with the idea to hoist a small C compiler (namely Obfuscated Tiny C Compiler), embed it as a machine code thunk and re-write my shunting yard implementation in the subset of C this compiler supports. I had to tweak OTCC to support inline assembly for the floating-point operations and other bits and pieces but the result is worth it.
Currently the following inline C version of the parser is 3 times faster that VB6 impl SimpleEval from above (w/ `Static` optimizations).
thinBasic Code:
' << big snip >>
' Complete code in the attached zip
Public Function InlineSimpleEval(sText As String) As Double
Considering how crippled the OTCC codegen is (it's using a single accumulator register eax and occasionally ecx for support on more complex constructs) I'm baffled how really bad VB6 "optimizing" performance is.
Here is a link to the original C version that can be compiled both w/ VC++ and OTCC: test.c
cheers,
</wqw>
Last edited by wqweto; Mar 29th, 2018 at 09:05 AM.
OP: I have been looking at your Source Code you posted in the OP Post #1. You have specified you want to add and multiply sums together. How many do you want do work out, because you have an endless Do Loop, without any breaking limiting factors that I can see in your Code. You have to work out a break test, for the Code to end the program or then it will just perpetually work on the sums. is this what you want to do, because then it just looks like a virus to me, because of a perpetual loop without any escaping break test, for that matter of fact, even. So then you should be able to come up with the breaking event of the Do ... Loop Until a = 0, because how can you work over zero in a sums program, that has no end. do you wish to also then be able to as you have said before in this thread you want decimals of to what point of zero.
I have a huge free products range, of computer software in which you can download using any kind of 64-Bit Web Browser. Also there is coming a Social Networking section that I am making on my Website...
|Ambra Productions Inc. | The Black Sun Society | The Black Shield | Ambra College | Church of the Black Sun | Ambra Productions Inc's Homepage | Boomtick Event's Venues: Ambar Nightclub, Jack Rabbit Slim's, Villa Nightclub and Lucy's Bar | Pasta Ambra | Fish Feast Company | Wallet Wizard | Ambrose Liquor | Ambar Tavern | Ambra University |
Do you wish to do unpaid work for me??? If so, the PM me on this Forum, and then we can get to work, programming for the future of computers go by the name of ThEiMp. This is my ghost writers name. Also my nickname, means that I am: The Imperial of the Technology Industry, so then to make it really short, I just then wrote: The Imp, which is where I get the nickname from...
It took me a while to figure out why dilettante's VEval class was faster than my SimpleEval over 100k iterations. It turned out that having a local array like `Dim aValStack(0 To 1000) As Double` in a function induces a penalty for clearing it's members to zeroes, so just switching to `Static` arrays doubled my speed.
Nevertheless I peeked at the assembly code VB6 was producing for the simple parser and got really frustrated with the inefficiencies produced by array indexing and what not. So came up with the idea to hoist a small C compiler (namely Obfuscated Tiny C Compiler), embed it as a machine code thunk and re-write my shunting yard implementation in the subset of C this compiler supports. I had to tweak OTCC to support inline assembly for the floating-point operations and other bits and pieces but the result is worth it.
Currently the following inline C version of the parser is 3 times faster that VB6 impl SimpleEval from above (w/ `Static` optimizations).
thinBasic Code:
' << big snip >>
' Complete code in the attached zip
Public Function SimpleEval(sText As String) As Double
Considering how crippled the OTCC codegen is (it's using a single accumulator register eax and occasionally ecx for support on more complex constructs) I'm baffled how really bad VB6 "optimizing" performance is.
Here is a link to the original C version that can be compiled both w/ VC++ and OTCC: test.c
cheers,
</wqw>
-- Just work on a Text Resource of the Data and then work using srKeyWord and loop through the keywords like int and #define
I have a huge free products range, of computer software in which you can download using any kind of 64-Bit Web Browser. Also there is coming a Social Networking section that I am making on my Website...
|Ambra Productions Inc. | The Black Sun Society | The Black Shield | Ambra College | Church of the Black Sun | Ambra Productions Inc's Homepage | Boomtick Event's Venues: Ambar Nightclub, Jack Rabbit Slim's, Villa Nightclub and Lucy's Bar | Pasta Ambra | Fish Feast Company | Wallet Wizard | Ambrose Liquor | Ambar Tavern | Ambra University |
Do you wish to do unpaid work for me??? If so, the PM me on this Forum, and then we can get to work, programming for the future of computers go by the name of ThEiMp. This is my ghost writers name. Also my nickname, means that I am: The Imperial of the Technology Industry, so then to make it really short, I just then wrote: The Imp, which is where I get the nickname from...
@TheImp, the OP code works fine with any amount of x and + and decimals in it. theres no error handling, meaning it can only deal with a proper string. but the thread is not about the OP code, instead is a question if theres better evaluators, and Olaf gave me a very nice code that works very fast. today Im still using his code with + x and - as I needed that in one formula. Since then we have other evaluators from different members, all quite nice and interesting, I learned a lot. The last one from wqweto is yet another way and again, impressed with the knowledge some of the members have.
Currently the following inline C version of the parser is 3 times faster that VB6 impl SimpleEval from above (w/ `Static` optimizations).
...
I'm baffled how really bad VB6 "optimizing" performance is.
Your original VB6-implementation is slower for two reasons:
- GoSub (instead of a function)
- the VBA.Val() function-call (instead of direct parsing)
Below I've changed your original slightly in this regard - and it is now (native compiled, with all extended options) -
about 3 times as fast as the inline-C-version.
I've put this into a *.bas
Code:
Option Explicit
Private Enum eTokens
TOK_FINAL = 0
TOK_RPAREN = 1
TOK_ADD = 2
TOK_MOD = 3
TOK_IDIV = 4
TOK_MUL = 5
TOK_UNARY = 6
TOK_POWER = 7
TOK_LPAREN = 8
TOK_NUM = 9
TOK_WHITE = 10
End Enum
Private aLookup(0 To 255) As eTokens, aValStack(0 To 1000) As Double, aOpStack(0 To 1000) As Long
Public Function SimpleEval(sText As String) As Double
Static WC() As Byte
Dim i As Long, UB As Long
Dim lValIdx As Long, lOpIdx As Long
Dim Tok As Long, PrevTok As Long
'--- one-time init of token type lookup
If aLookup(32) = 0 Then
For i = 0 To UBound(aLookup)
Select Case i
Case 40: aLookup(i) = TOK_LPAREN ' "("
Case 41: aLookup(i) = TOK_RPAREN ' ")"
Case 43, 45: aLookup(i) = TOK_ADD ' "+", "-"
Case 42, 47: aLookup(i) = TOK_MUL ' "*", "/"
Case 94: aLookup(i) = TOK_POWER ' "^"
Case 92: aLookup(i) = TOK_IDIV ' "\"
Case 37: aLookup(i) = TOK_MOD ' "%"
Case 48 To 57, 46: aLookup(i) = TOK_NUM ' "0" To "9", "."
Case Else: aLookup(i) = TOK_WHITE
End Select
Next
End If
WC = sText 'assign the text to a WChar-Byte-Vector
UB = UBound(WC) 'buffer the UBound (we pass this around into FastVal)
For i = 0 To UB Step 2
Tok = aLookup(WC(i))
If Tok = TOK_NUM Then
lValIdx = lValIdx + 1
aValStack(lValIdx) = FastVal(WC, i, UB) 'FastVal will increment i correctly
ElseIf Tok = TOK_ADD Then
If PrevTok >= TOK_ADD And PrevTok < TOK_NUM Then
Tok = TOK_UNARY
End If
End If
If Tok >= TOK_ADD And Tok < TOK_NUM Then
If Tok <> TOK_UNARY Then '--- right assoc
EvalOpStack lOpIdx, Tok, lValIdx
End If
lOpIdx = lOpIdx + 1
aOpStack(lOpIdx) = Tok * &H10000 + WC(i)
End If
If Tok <> TOK_WHITE Then PrevTok = Tok
Next
EvalOpStack lOpIdx, TOK_FINAL, lValIdx
SimpleEval = aValStack(lValIdx)
aValStack(lValIdx) = 0 'clear the bottom of the Value-Stack
End Function
Private Sub EvalOpStack(lOpIdx As Long, lTokPreced As Long, lValIdx As Long)
For lOpIdx = lOpIdx To 1 Step -1
If aOpStack(lOpIdx) < lTokPreced * &H10000 Then Exit For
lValIdx = lValIdx - 1
Select Case aOpStack(lOpIdx) And &HFFFF&
Case 43 ' "+"
If aOpStack(lOpIdx) > TOK_UNARY * &H10000 Then
lValIdx = lValIdx + 1
Else
aValStack(lValIdx) = aValStack(lValIdx) + aValStack(lValIdx + 1)
End If
Case 45 ' "-"
If aOpStack(lOpIdx) > TOK_UNARY * &H10000 Then
lValIdx = lValIdx + 1
aValStack(lValIdx) = -aValStack(lValIdx)
Else
aValStack(lValIdx) = aValStack(lValIdx) - aValStack(lValIdx + 1)
End If
Case 42 ' "*"
aValStack(lValIdx) = aValStack(lValIdx) * aValStack(lValIdx + 1)
Case 47 ' "/"
aValStack(lValIdx) = aValStack(lValIdx) / aValStack(lValIdx + 1)
Case 94 ' "^"
aValStack(lValIdx) = aValStack(lValIdx) ^ aValStack(lValIdx + 1)
Case 92 ' "\"
aValStack(lValIdx) = aValStack(lValIdx) \ aValStack(lValIdx + 1)
Case 37 ' "%"
aValStack(lValIdx) = aValStack(lValIdx) Mod aValStack(lValIdx + 1)
Case 40 ' "("
lValIdx = lValIdx + 1
If lTokPreced > TOK_RPAREN Then Exit For
If lTokPreced = TOK_RPAREN Then lOpIdx = lOpIdx - 1: Exit For
End Select
Next
End Sub
Private Function FastVal(WC() As Byte, i As Long, ByVal UB As Long) As Double
Dim NewVal&, IntPart#, FracPart#, FracDivisor#, eSgn&, eInt&
For i = i To UB Step 2
Select Case WC(i)
Case 48 To 57 'numeric
If NewVal = 0 Then NewVal = 1
If eSgn Then
eInt = eInt * 10 + WC(i) - 48
Else
If FracDivisor = 0 Then
IntPart = IntPart * 10 + WC(i) - 48
ElseIf FracDivisor < 10000000000000# Then
FracPart = FracPart * 10 + WC(i) - 48
FracDivisor = FracDivisor * 10
End If
End If
Case 46 'decimal-point
FracDivisor = 1: If NewVal = 0 Then NewVal = 1
Case 69, 101 'e, E
eInt = 0: If NewVal Then eSgn = 1
Case 45 'a leading "-" (only possible after the eSign in this scenario)
If eSgn > 0 Then eSgn = -1 Else Exit For
Case Else: Exit For 'and everything else exits the loop
End Select
Next
If NewVal Then
If FracDivisor Then
FastVal = NewVal * (IntPart + FracPart / FracDivisor)
Else
FastVal = NewVal * IntPart
End If
If eSgn Then FastVal = FastVal * (10 ^ (eSgn * eInt))
End If
i = i - 2
End Function
And that into a Test-Form (after renaming your inline-C-function to SimpleEval2):
Code:
Option Explicit
Private Sub Form_Click()
AutoRedraw = True: Cls
Debug.Print SimpleEval("-.1*1e-1-.1^-3") = -0.1 * 0.1 - 0.1 ^ -3
Debug.Print SimpleEval("(3.5) + 2.9 * (2 + -(1 + 2))") = (3.5) + 2.9 * (2 + -(1 + 2))
Debug.Print SimpleEval("2 \ 3 / 3") = 2 \ 3 / 3
Debug.Print SimpleEval("2 ^ -3 ^ 4") = 2 ^ -3 ^ 4
Debug.Print SimpleEval("2 ^ 3 \ 5 ^ 2 / 5 / 3") = 2 ^ 3 \ 5 ^ 2 / 5 / 3
Dim sExpr As String
Dim dblTimer As Double
Dim lIdx As Long
Dim dblResult As Double
sExpr = "(3.5) + 2.9 * (2 + -(1 + 2))"
dblTimer = Timer
For lIdx = 1 To 100000
dblResult = SimpleEval(sExpr)
Next
Print "SimpleEval1: " & dblResult, Format$(Timer - dblTimer, "0.000")
sExpr = "(3.5) + 2.9 * (2 + -(1 + 2))"
dblTimer = Timer
For lIdx = 1 To 100000
dblResult = SimpleEval2(sExpr)
Next
Print "SimpleEval2: " & dblResult, Format$(Timer - dblTimer, "0.000")
End Sub
The results are (native compiled, 100,000 iterations) about:
- 0.045sec for VB6-SimpleEval
- 0.125sec for the Inline-C-SimpleEval2
BTW, on my machine (not sure if that's a "locale-thingy") the Inline-C-function evaluates: "(3.5) + 2.9 * (2 + -(1 + 2))" to 6 instead of 0.6
Edit: Fixed a bug in FastVal, for the case when no Space-Chars were given (enhanced the Form-TestCode about the test-string: "-.1*1e-1-.1^-3"
Olaf
Last edited by Schmidt; Mar 28th, 2018 at 06:13 PM.
Reason: Fixed a bug in FastVal, when no spaces were given
Switched the inline C version to a translation of it (updated the .zip attachment above) and now your version and inline version are with very close performance when VB6 code is compiled w/ all optimizations on.
It's quite impressive that both simple CDbl and Val calls are slower that OlafSimpleEval when compiled with optimizations.
Yep, I've always found, that the VB6-native-compiler was quite on par with the VC-version-6 (tested that intensively years ago,
where C2.exe was only about 10-15% slower at that time - when both versions had all possible optimizations checked in).
More recently (though still about 3 years back), I've compared VB6-native-code versus TCC (0.9.26) -
and found VB6-C2.exe to be about 10-20% faster than what the (not really optimizing) TCC was able to produce.
So, with all options checked, there is no real reason why e.g. "fast Pixel-Loops" shouldn't be
performed in normal VB6-code (since I saw you comment on that, in other threads)...
And sure, one has to "work around" a few things to "get those inner loops fast" (e.g. the missing shift-operators
come to mind) - but that can usually be solved (at little expense in more code) via LookupTable-techniques.
Originally Posted by wqweto
But then realisticly no one should disable arrays bounds checking in production code IMO.
That's why such (usually welltested, manually making sure the Bounds are correct) code belongs into Dll-Projects
(which then can have their own appropriate, optimized Compiler-Settings, independently from the Main-Project).
And BTW, your Inline-C-Code will not perform any bounds-checks, if I'm not mistaken -
(so to compare realistically, we should allow the VB6-native compiler the same thing).
In the (bigger, "official") TCC, there's an Array-Bound-check available via Compiler-switch,
but in older TCC-versions it was deactivated (had no effect) - do you know, whether the
current version of the TCC (0.9.27) has this stuff activated again (behaving in a reliable way)?
As for your results - there is one other thing that the C-Code does, which in my "tuned SimpleEval"
was "thrown out" (because the main-boost came from replacing Val)...
And that's the SafeArray-spanning over the Chars of the ExpressionString (to avoid the "full copy").
If we re-introduce that, the tuned SimpleEval will gain another factor 2 over you (latest) C-Version.
Here is the Code for a ClassEncapsulation which is using this SafeArr-Binding (I named the Class cMathExpr):
Code:
Option Explicit
Private Enum eTokens
TOK_FINAL = 0
TOK_RPAREN = 1
TOK_ADD = 2
TOK_MOD = 3
TOK_IDIV = 4
TOK_MUL = 5
TOK_UNARY = 6
TOK_POWER = 7
TOK_LPAREN = 8
TOK_NUM = 9
TOK_WHITE = 10
End Enum
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Sub GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any)
Private WC%(), saWC&(0 To 5), TokLUT(0 To 255) As eTokens, ValStack#(0 To 999), OpStack&(0 To 999)
Private Sub Class_Initialize()
saWC(0) = 1: saWC(1) = 2 'init the safearry-struct for cDims and cbElements
GetMem4 VarPtr(saWC(0)), ByVal ArrPtr(WC) 'bind the struct to the 16Bit-Int-array WC
Dim iC As Long
For iC = 0 To UBound(TokLUT) 'init the Token-Lookup-Table
Select Case iC
Case 40: TokLUT(iC) = TOK_LPAREN ' "("
Case 41: TokLUT(iC) = TOK_RPAREN ' ")"
Case 43, 45: TokLUT(iC) = TOK_ADD ' "+", "-"
Case 42, 47: TokLUT(iC) = TOK_MUL ' "*", "/"
Case 94: TokLUT(iC) = TOK_POWER ' "^"
Case 92: TokLUT(iC) = TOK_IDIV ' "\"
Case 37: TokLUT(iC) = TOK_MOD ' "%"
Case 48 To 57, 46: TokLUT(iC) = TOK_NUM ' "0" To "9", "."
Case Else: TokLUT(iC) = TOK_WHITE
End Select
Next
End Sub
Private Sub Class_Terminate()
GetMem4 0&, ByVal ArrPtr(WC) 'release the Binding of WC%()
End Sub
Public Function Evaluate(sText As String) As Double
Dim Tok As eTokens, PrevTok As eTokens
Dim iC As Long, iV As Long, iO As Long, UB As Long
saWC(3) = StrPtr(sText) ' pvData
saWC(4) = Len(sText) ' cElements
UB = saWC(4) - 1 ' buffer the UBound (we pass this around into FastVal)
For iC = 0 To UB
Tok = TokLUT(WC(iC))
If Tok = TOK_NUM Then
iV = iV + 1
ValStack(iV) = FastVal(iC, UB) 'FastVal will increment iC correctly
ElseIf Tok = TOK_ADD Then
If PrevTok >= TOK_ADD And PrevTok < TOK_NUM Then
Tok = TOK_UNARY
End If
End If
If Tok >= TOK_ADD And Tok < TOK_NUM Then
If Tok <> TOK_UNARY Then '--- right assoc
EvalOpStack Tok, iO, iV
End If
iO = iO + 1
OpStack(iO) = Tok * &H10000 + WC(iC)
End If
If Tok <> TOK_WHITE Then PrevTok = Tok
Next
EvalOpStack TOK_FINAL, iO, iV
Evaluate = ValStack(iV)
ValStack(iV) = 0 'clear the bottom of the Value-Stack
End Function
Private Sub EvalOpStack(ByVal Tok As eTokens, iO As Long, iV As Long)
For iO = iO To 1 Step -1
If OpStack(iO) < Tok * &H10000 Then Exit For
iV = iV - 1
Select Case OpStack(iO) And &HFFFF&
Case 43 ' "+"
If OpStack(iO) > TOK_UNARY * &H10000 Then
iV = iV + 1
Else
ValStack(iV) = ValStack(iV) + ValStack(iV + 1)
End If
Case 45 ' "-"
If OpStack(iO) > TOK_UNARY * &H10000 Then
iV = iV + 1
ValStack(iV) = -ValStack(iV)
Else
ValStack(iV) = ValStack(iV) - ValStack(iV + 1)
End If
Case 42 ' "*"
ValStack(iV) = ValStack(iV) * ValStack(iV + 1)
Case 47 ' "/"
ValStack(iV) = ValStack(iV) / ValStack(iV + 1)
Case 94 ' "^"
ValStack(iV) = ValStack(iV) ^ ValStack(iV + 1)
Case 92 ' "\"
ValStack(iV) = ValStack(iV) \ ValStack(iV + 1)
Case 37 ' "%"
ValStack(iV) = ValStack(iV) Mod ValStack(iV + 1)
Case 40 ' "("
iV = iV + 1
If Tok > TOK_RPAREN Then Exit For
If Tok = TOK_RPAREN Then iO = iO - 1: Exit For
End Select
Next
End Sub
Private Function FastVal(iC As Long, ByVal UB As Long) As Double
Dim NewVal&, IntPart#, FracPart#, FracDivisor#, eSgn&, eInt&
For iC = iC To UB
Select Case WC(iC)
Case 48 To 57 'numeric
If NewVal = 0 Then NewVal = 1
If eSgn Then
eInt = eInt * 10 + WC(iC) - 48
ElseIf FracDivisor = 0 Then
IntPart = IntPart * 10 + WC(iC) - 48
ElseIf FracDivisor < 10000000000000# Then
FracPart = FracPart * 10 + WC(iC) - 48
FracDivisor = FracDivisor * 10
End If
Case 46 'decimal-point
FracDivisor = 1: If NewVal = 0 Then NewVal = 1
Case 45 'a leading "-" (only possible after the eSign in this scenario)
If eSgn > 0 Then eSgn = -1 Else Exit For
Case 69, 101 'e, E
eInt = 0: If NewVal Then eSgn = 1
Case Else: Exit For 'everything else exits the loop
End Select
Next
iC = iC - 1
If NewVal Then
If FracDivisor Then
FastVal = NewVal * (IntPart + FracPart / FracDivisor)
Else
FastVal = NewVal * IntPart
End If
If eSgn Then FastVal = FastVal * (10 ^ (eSgn * eInt))
End If
End Function
Here again my Form-TestCode:
Code:
Private Sub Form_Click()
AutoRedraw = True: Cls
Dim sExpr As String
Dim dblTimer As Double
Dim lIdx As Long
Dim dblResult As Double
Dim MathExpr As cMathExpr
Set MathExpr = New cMathExpr
Debug.Print MathExpr.Evaluate("-.1*1e-1-.1^-3") = -0.1 * 0.1 - 0.1 ^ -3
Debug.Print MathExpr.Evaluate("(3.5) + 2.9 * (2 + -(1 + 2))") = (3.5) + 2.9 * (2 + -(1 + 2))
Debug.Print MathExpr.Evaluate("2 \ 3 / 3") = 2 \ 3 / 3
Debug.Print MathExpr.Evaluate("2 ^ -3 ^ 4") = 2 ^ -3 ^ 4
Debug.Print MathExpr.Evaluate("2 ^ 3 \ 5 ^ 2 / 5 / 3") = 2 ^ 3 \ 5 ^ 2 / 5 / 3
sExpr = "(3.5) + 2.9 * (2 + -(1 + 2))"
dblTimer = Timer
For lIdx = 1 To IIf(App.LogMode, 10 ^ 6, 10 ^ 5)
dblResult = SimpleEval(sExpr)
Next
Print "SimpleEvalFastVal: " & dblResult, Format$(Timer - dblTimer, "0.000")
sExpr = "(3.5) + 2.9 * (2 + -(1 + 2))"
dblTimer = Timer
For lIdx = 1 To IIf(App.LogMode, 10 ^ 6, 10 ^ 5)
dblResult = MathExpr.Evaluate(sExpr)
Next
Print "MathExpr.Evaluate: " & dblResult, Format$(Timer - dblTimer, "0.000")
End Sub
Native compiled (all Options), MathExpr.Evaluate times out at about 0.25sec here on my machine (for 1Mio iterations).
Olaf
Last edited by Schmidt; Mar 29th, 2018 at 12:30 PM.
We have to help the OP to learn by his/her experiences. so then OP please post your source code in this thread. then we will be able to check it for syntax errors, etc
I have a huge free products range, of computer software in which you can download using any kind of 64-Bit Web Browser. Also there is coming a Social Networking section that I am making on my Website...
|Ambra Productions Inc. | The Black Sun Society | The Black Shield | Ambra College | Church of the Black Sun | Ambra Productions Inc's Homepage | Boomtick Event's Venues: Ambar Nightclub, Jack Rabbit Slim's, Villa Nightclub and Lucy's Bar | Pasta Ambra | Fish Feast Company | Wallet Wizard | Ambrose Liquor | Ambar Tavern | Ambra University |
Do you wish to do unpaid work for me??? If so, the PM me on this Forum, and then we can get to work, programming for the future of computers go by the name of ThEiMp. This is my ghost writers name. Also my nickname, means that I am: The Imperial of the Technology Industry, so then to make it really short, I just then wrote: The Imp, which is where I get the nickname from...
Just tested cMathExpr class agains VC++ optimized *Release* build of my InlineSimpleEval plain C version. Turns out Advanced Optimizations compiled cMathExpr has a small edge.
This closes the case for me as obviously my optimization efforts snowballed out of control.
At least the Runtime TCC spin-off project has some useful applications outside this particular parser problem.
I'd like to have the possibility to add and set "Variables" in the expression.
How to do it ? (using Post #50)
Adding VarHandling to the Evaluator would probably slow down the Evaluation by factor 2
(then operating in the range of 2 Mio Operations/sec from its former 4MegaOps/sec).
And then you'd be in the performancerange of e.g. the MS-VBScripting.Engine.
For example, if you'd want to use that in your ImageTools (to allow for some kind of "Userdefined Pixel-Processing-Functions"),
you could make an attempt already with either the ScriptControl or the RC5-Scripting-support -
as shown below (achieving about 1Mio calls per second into the Pixel-Processing-UDF, performing 3 simple evaluations there):
Code:
Option Explicit
Private SC As cActiveScript
Private Sub Form_Load()
Set SC = New_c.ActiveScript("VBScript", False, False)
End Sub
Private Sub Form_Click()
Dim SB As cStringBuilder, CO As Object, T!
Set SB = New_c.StringBuilder 'let's build a Pixel-UDF for a simple "darkening"
SB.AppendNL "Sub UDF(srcR, srcG, srcB, dstR, dstG, dstB)"
SB.AppendNL " dstR = srcR * 0.5"
SB.AppendNL " dstG = srcG * 0.5"
SB.AppendNL " dstB = srcB * 0.5"
SB.AppendNL "End Sub"
SC.AddCode SB.ToString 'compile the UDF
Set CO = SC.CodeObject 'get the Code-Object (for faster calling from outside)
T = Timer
Dim i As Long, dstR, dstG, dstB
For i = 1 To 10^6
CO.UDF 2, 22, 222, dstR, dstG, dstB 'LateBound-call into the script (the 3 dstVariants are set ByRef)
Next
Debug.Print dstR, dstG, dstB
Caption = Timer - T
End Sub
HTH
Olaf
Last edited by Schmidt; Apr 1st, 2018 at 04:53 PM.
Thank you Olaf!
Very interesting and Fast. (Tons faster than cFormula...)
The output variables seems that must be declared as Variant (This made me struggle a little bit)
PS:
How to check if the expression is a Valid one ? (maybe with error handling?)
EDIT:
Are there some other examples (Links) about ActiveScript?... 'cause I'm quite ignorant about this.. and it's a very powerfull tool.
How to check if the expression is a Valid one ? (maybe with error handling?)
Just wrap the expression up in a small Script -Sub or -Function (using simple String-Concatenation) -
and then Add this "dynamically constructed" routine via:
SC.AddCode YourDynamicallyConstructedRoutine
After making the above call, you can immediately ask the Scripting-Instance:
If Len(SC.LastErrString) Then MsgBox SC.LastErrString
to inform your user in case any error happened...
The above SC-Variable can also be defined WithEvents (then you will get Error-Reports dynamically in an Event).
Originally Posted by reexre
Are there some other examples (Links) about ActiveScript?... 'cause I'm quite ignorant about this.. and it's a very powerfull tool.
It supports quite a lot more than the "regular MS-ScriptControl" (especially with regards to dynamic Event-Support) -
so you can even write "dynamic, userdefinable GUIs" with it - like the following example shows...
Into a normal *.bas-Module (adjust the Project-Settings, to start from Sub Main)
Code:
Option Explicit
Sub Main()
Dim SC As cActiveScript, SB As cStringBuilder
Set SC = New_c.ActiveScript
Set SB = New_c.StringBuilder
'first we add Code for a VBScript-Class (a simple Cairo-Widget)
SB.AppendNL "Class cwMyWidget"
SB.AppendNL " Dim W"
SB.AppendNL " Sub Class_Initialize()"
SB.AppendNL " Set W = Cairo.WidgetBase"
SB.AppendNL " W.Moveable = True"
SB.AppendNL " AddEventSinkOn Me, 'W_Paint', 6"
SB.AppendNL " End Sub"
SB.AppendNL " Property Get Widget(): Set Widget = W: End Property"
SB.AppendNL " Property Get Widgets(): Set Widgets = W.Widgets: End Property"
SB.AppendNL " Sub W_Paint(ByVal CC, ByVal x, ByVal y, ByVal dx, ByVal dy, ByVal UserObj)"
SB.AppendNL " CC.Paint 1, Cairo.CreateSolidPatternLng(vbMagenta, 0.3)"
SB.AppendNL " S = 'Hello World' & vbCrLf & 'from ' & W.Key & vbCrLf & '(move me around)'"
SB.AppendNL " CC.DrawText 0, 0, dx, dy, CStr(S), False, vbCenter, 4, True"
SB.AppendNL " End Sub"
SB.AppendNL "End Class"
'finally we add the Main-Code (using a Cairo-Form, two Widget-Class-Instances from the code above, and a RC5-cTimer)
SB.AppendNL "Set Form = Cairo.WidgetForms.Create(vbSizable, 'Form-Caption', True, 480, 320)"
SB.AppendNL " Form.Widgets.Add New cwMyWidget, 'MyWidget1', 10, 10, 150, 150"
SB.AppendNL " Form.Widgets.Add New cwMyWidget, 'MyWidget2', 60, 60, 150, 150"
SB.AppendNL "Set Timer1 = New_c.Timer(600, True): AddEventSupportFor 'Timer1'"
SB.AppendNL "Sub Timer1_Timer()"
SB.AppendNL " Form.Caption= 'Form-Caption: ' & Now"
SB.AppendNL "End Sub"
SB.AppendNL "Form.Show vbModal"
'the main-code (since it is not wrapped in a Routine) is now immediately executed "On Add"
SC.AddCode Replace(SB.ToString, "'", """") '<- replace the single-quotes we've used in above code-defs with the needed double-quotes
'we reach this point only, after the (modal) CairoForm we created in the Script above was closed...
Set SB = Nothing
Set SC = Nothing
New_c.CleanupRichClientDll
End Sub
Is anyone still watching this post? I've been using Olaf's handy string parser but encountered an error.
Just wondering if it is worthwhile pursuing a fix.
There is a computer disease that anybody who works with computers knows about. It's a very serious disease and it interferes completely with the work. The trouble with computers is that you 'play' with them!
Richard P. Feynman
Usually everyone ends up with a "real" recursive descent parser and "real" AST when "simple math" requirements baloon to calling functions from the main app, context aware parsing and what not. And this is usually how Lua and most other scripting languages started, something similar is what I'm currently using in my projects too.
A very simple "75 -75 +100" results -100.
Somethings wrong.
There is a computer disease that anybody who works with computers knows about. It's a very serious disease and it interferes completely with the work. The trouble with computers is that you 'play' with them!
Richard P. Feynman
Last edited by VB-only; Feb 3rd, 2025 at 08:14 PM.
There is a computer disease that anybody who works with computers knows about. It's a very serious disease and it interferes completely with the work. The trouble with computers is that you 'play' with them!
Richard P. Feynman
There is a computer disease that anybody who works with computers knows about. It's a very serious disease and it interferes completely with the work. The trouble with computers is that you 'play' with them!
Richard P. Feynman
In the first step the command is split in the following:
L = "75"
R = "75 + 100"
So the formula gets
Eval = Eval("75") - Eval("75 + 100")
This results in:
Eval = 75 - 175
And that's not correct because + and - should be of the same order and thus the formula should be handled from left to right expression by expression
75 - 75 + 100 -> 0 + 100 -> 100
yeah. I didnt notice it before.
most be because I was just using + and *, as I stripped down the function to just that.
later I needed - as well, but it was not used long, as I changed it into a pre-calculated method, so no need for any evaluation.
using both + and - they both need to be included in the sequence, not one by one.
theres a order of things and also it depends if we use pemdas or bodmas.
In the first step the command is split in the following:
L = "75"
R = "75 + 100"
The split is wrong. If you do it this way then R should be
R = "-75 + 100" and the operator should be + as +- together gives -
So
L = "75"
R = "-75 + 100" which = 25
So 75 + 25 = 100 which is as required.
Effectively you do 75 + (-75 + 100). When evaluating equal precedence not left to right (except power which is right to left) you have to deal with negative numbers properly by effectvely making - into +-.
If you dealt with * / the same it would probably work as
2*-3*4 would be L = 2 and R = -3 *4 which gives 2 * -12 giving -24 as expected. It's only when you have + and - being used for 2 different functions (unary and binary) that you have to be careful.
All advice is offered in good faith only. You are ultimately responsible for the effects of your programs and the integrity of the machines they run on. Anything I post, code snippets, advice, etc is licensed as Public Domain https://creativecommons.org/publicdomain/zero/1.0/
Most of the parsers here handle the "75 -75 +100" debacle just fine. It's just a small bug in Olaf's original expression evaluator he'll probably fix in no time. His cMathExpr class works fine for instance.
Btw, there is no RPN parser/evaluator here so might be a good idea to add some working example to this thread but shunting yard algorithm is good enough for me.
Ok, thanks very much. That fixes that problem but another, also similar is:
100 - .5 * ( - 5 ), result is -497.5
I hope I'm not just chasing my tail here.
There is a computer disease that anybody who works with computers knows about. It's a very serious disease and it interferes completely with the work. The trouble with computers is that you 'play' with them!
Richard P. Feynman
On second thought, that last expression is not a valid geometry construct. Getting such an invalid error is an indication to reconfigure the equation.
There is a computer disease that anybody who works with computers knows about. It's a very serious disease and it interferes completely with the work. The trouble with computers is that you 'play' with them!
Richard P. Feynman
> On second thought, that last expression is not a valid geometry construct. Getting such an invalid error is an indication to reconfigure the equation.
What this even mean? Which parser do you use? From which post?
Already mentioned but find the cMathExpr class (by Olaf) in post #50 which takes care of unary minus right associativity and evaluates 100 - .5 * ( - 5 ) to 102.5
Already mentioned but find the cMathExpr class (by Olaf) in post #50 which takes care of unary minus right associativity and evaluates 100 - .5 * ( - 5 ) to 102.5
I've been asking and trying to figure out why we're farting around with the earlier simplistic versions too, but no response. Only thing I can think of is that VB-only is "class averse" and only wants to use a standard module
And if that's the case, then just throw this into a .bas and use the cMathExpr class from post #50 to solve all of your problems:
Code:
Option Explicit
Public Function Evaluate(sText As String) As Double
Static so_MathExpr As cMathExpr
If so_MathExpr Is Nothing Then Set so_MathExpr = New cMathExpr
Evaluate = so_MathExpr.Evaluate(sText)
End Function
I don't like classes. A simple module is all that's needed in my situation.
There is a computer disease that anybody who works with computers knows about. It's a very serious disease and it interferes completely with the work. The trouble with computers is that you 'play' with them!
Richard P. Feynman
Anyway, You can move the class code to a standard module, but then you'd need to make sure you manually cleanup the SafeArray binding when you close your app. Something like this (untested, but should point you in the right direction):
Code:
Option Explicit
Private Enum eTokens
TOK_FINAL = 0
TOK_RPAREN = 1
TOK_ADD = 2
TOK_MOD = 3
TOK_IDIV = 4
TOK_MUL = 5
TOK_UNARY = 6
TOK_POWER = 7
TOK_LPAREN = 8
TOK_NUM = 9
TOK_WHITE = 10
End Enum
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Sub GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any)
Private WC%(), saWC&(0 To 5), TokLUT(0 To 255) As eTokens, ValStack#(0 To 999), OpStack&(0 To 999)
Public Function Evaluate(sText As String) As Double
Static EverCalled As Boolean
Dim Tok As eTokens, PrevTok As eTokens
Dim iC As Long, iV As Long, iO As Long, UB As Long
If Not EverCalled Then
EverCalled = True
saWC(0) = 1: saWC(1) = 2 'init the safearry-struct for cDims and cbElements
GetMem4 VarPtr(saWC(0)), ByVal ArrPtr(WC) 'bind the struct to the 16Bit-Int-array WC
For iC = 0 To UBound(TokLUT) 'init the Token-Lookup-Table
Select Case iC
Case 40: TokLUT(iC) = TOK_LPAREN ' "("
Case 41: TokLUT(iC) = TOK_RPAREN ' ")"
Case 43, 45: TokLUT(iC) = TOK_ADD ' "+", "-"
Case 42, 47: TokLUT(iC) = TOK_MUL ' "*", "/"
Case 94: TokLUT(iC) = TOK_POWER ' "^"
Case 92: TokLUT(iC) = TOK_IDIV ' "\"
Case 37: TokLUT(iC) = TOK_MOD ' "%"
Case 48 To 57, 46: TokLUT(iC) = TOK_NUM ' "0" To "9", "."
Case Else: TokLUT(iC) = TOK_WHITE
End Select
Next
End If
If Trim$(sText) = vbNullString Then
' Pass empty formula to cleanup
EverCalled = False
GetMem4 0&, ByVal ArrPtr(WC) 'release the Binding of WC%()
Exit Function
End If
saWC(3) = StrPtr(sText) ' pvData
saWC(4) = Len(sText) ' cElements
UB = saWC(4) - 1 ' buffer the UBound (we pass this around into FastVal)
For iC = 0 To UB
Tok = TokLUT(WC(iC))
If Tok = TOK_NUM Then
iV = iV + 1
ValStack(iV) = FastVal(iC, UB) 'FastVal will increment iC correctly
ElseIf Tok = TOK_ADD Then
If PrevTok >= TOK_ADD And PrevTok < TOK_NUM Then
Tok = TOK_UNARY
End If
End If
If Tok >= TOK_ADD And Tok < TOK_NUM Then
If Tok <> TOK_UNARY Then '--- right assoc
EvalOpStack Tok, iO, iV
End If
iO = iO + 1
OpStack(iO) = Tok * &H10000 + WC(iC)
End If
If Tok <> TOK_WHITE Then PrevTok = Tok
Next
EvalOpStack TOK_FINAL, iO, iV
Evaluate = ValStack(iV)
ValStack(iV) = 0 'clear the bottom of the Value-Stack
End Function
Private Sub EvalOpStack(ByVal Tok As eTokens, iO As Long, iV As Long)
For iO = iO To 1 Step -1
If OpStack(iO) < Tok * &H10000 Then Exit For
iV = iV - 1
Select Case OpStack(iO) And &HFFFF&
Case 43 ' "+"
If OpStack(iO) > TOK_UNARY * &H10000 Then
iV = iV + 1
Else
ValStack(iV) = ValStack(iV) + ValStack(iV + 1)
End If
Case 45 ' "-"
If OpStack(iO) > TOK_UNARY * &H10000 Then
iV = iV + 1
ValStack(iV) = -ValStack(iV)
Else
ValStack(iV) = ValStack(iV) - ValStack(iV + 1)
End If
Case 42 ' "*"
ValStack(iV) = ValStack(iV) * ValStack(iV + 1)
Case 47 ' "/"
ValStack(iV) = ValStack(iV) / ValStack(iV + 1)
Case 94 ' "^"
ValStack(iV) = ValStack(iV) ^ ValStack(iV + 1)
Case 92 ' "\"
ValStack(iV) = ValStack(iV) \ ValStack(iV + 1)
Case 37 ' "%"
ValStack(iV) = ValStack(iV) Mod ValStack(iV + 1)
Case 40 ' "("
iV = iV + 1
If Tok > TOK_RPAREN Then Exit For
If Tok = TOK_RPAREN Then iO = iO - 1: Exit For
End Select
Next
End Sub
Private Function FastVal(iC As Long, ByVal UB As Long) As Double
Dim NewVal&, IntPart#, FracPart#, FracDivisor#, eSgn&, eInt&
For iC = iC To UB
Select Case WC(iC)
Case 48 To 57 'numeric
If NewVal = 0 Then NewVal = 1
If eSgn Then
eInt = eInt * 10 + WC(iC) - 48
ElseIf FracDivisor = 0 Then
IntPart = IntPart * 10 + WC(iC) - 48
ElseIf FracDivisor < 10000000000000# Then
FracPart = FracPart * 10 + WC(iC) - 48
FracDivisor = FracDivisor * 10
End If
Case 46 'decimal-point
FracDivisor = 1: If NewVal = 0 Then NewVal = 1
Case 45 'a leading "-" (only possible after the eSign in this scenario)
If eSgn > 0 Then eSgn = -1 Else Exit For
Case 69, 101 'e, E
eInt = 0: If NewVal Then eSgn = 1
Case Else: Exit For 'everything else exits the loop
End Select
Next
iC = iC - 1
If NewVal Then
If FracDivisor Then
FastVal = NewVal * (IntPart + FracPart / FracDivisor)
Else
FastVal = NewVal * IntPart
End If
If eSgn Then FastVal = FastVal * (10 ^ (eSgn * eInt))
End If
End Function
Reply With Quote
Originally Posted by wqweto
