Glad I could help.fvillanova wrote: ↑Sun Apr 30, 2023 3:00 pm Hi Idle,
your procedure worked perfectly here.
This test above takes 15 milliseconds on my computer
Now I will be able to process much larger amounts of simulations in a shorter period of time.
thank you so much again!
Comparisons in mathematical simulations
Re: Comparisons in mathematical simulations
-
- User
- Posts: 70
- Joined: Wed May 02, 2012 2:17 am
- Location: Brazil
Re: Comparisons in mathematical simulations
Can anyone explain this mystery!
Idle's procedure returns with different responses when the input variable in the procedure has been used before...
I couldn't understand this!
any help will be appreciated, thanks
Idle's procedure returns with different responses when the input variable in the procedure has been used before...
I couldn't understand this!
any help will be appreciated, thanks
Code: Select all
DisableDebugger
Procedure.i CreateB(*input)
Protected *inp.Unicode = *input
Protected n.u
Protected aux.i
Repeat
n = (*inp\u-48) * 10
*inp+2
n + *inp\u-48
*inp+4
aux | (1 << (n))
Until *inp\u = 0
ProcedureReturn aux>>1
EndProcedure
Global.s input1,input2,ResultB1,ResultB2
; if you process without the line >>> input1="bla ... bla ... bla ..."
; it works perfectly ... but activating the line gives a different result
; in the CreateB Procedure
;input1="bla ... bla ... bla ..."
input1="43 45 57 62" ; Range = from 01 to max 62 = correct values for the procedure
Result1=CreateB(@input1)
ResultB1=Bin(Result1,#PB_Quad)
input2=input1
Result2=CreateB(@input2)
ResultB2=Bin(Result2,#PB_Quad)
If ResultB1<>ResultB2
MessageRequester("Problem!",ResultB1+Chr(13)+ResultB2+Chr(13)+"different results... with the same string!"+Chr(13)+input1+" x "+input2, #PB_MessageRequester_Ok)
End
EndIf
MessageRequester("Finished","Ok ... no error!"+Chr(13)+"try activating the line 22 'bla ... bla ... bla ...'", #PB_MessageRequester_Ok)
Re: Comparisons in mathematical simulations
The issue is that PB is reusing the string memory. if you pass the input sting in by value the problem will go away
or alternative passing by reference with an additional cmp
Code: Select all
Procedure.i CreateB(input.s)
Protected *inp.Unicode = @input
Protected n.u
Protected aux.i
Repeat
n = (*inp\u-48) * 10
*inp+2
n + *inp\u-48
*inp+4
aux | (1 << (n))
Until *inp\u = 0
ProcedureReturn aux>>1
EndProcedure
Global.s input1,input2,ResultB1,ResultB2
; if you process without the line >>> input1="bla ... bla ... bla ..."
; it works perfectly ... but activating the line gives a different result
; in the CreateB Procedure
input1="43 45 57 62 21 16"
input1="43 45 57 62" ; Range = from 01 to max 62 = correct values for the procedure
Debug input1
Result1=CreateB(input1)
input2=input1
Debug input2
Result2=CreateB(input2)
If Result1<>Result2
MessageRequester("Problem!",ResultB1+Chr(13)+ResultB2+Chr(13)+"different results... with the same string!"+Chr(13)+input1+" x "+input2, #PB_MessageRequester_Ok)
End
EndIf
MessageRequester("Finished","Ok ... no error!"+Chr(13)+"try activating the line 22 'bla ... bla ... bla ...'", #PB_MessageRequester_Ok)
Code: Select all
Procedure.i CreateB(*input)
Protected *inp.Unicode = *input
Protected n.u
Protected aux.i
Repeat
n = (*inp\u-48) * 10
*inp+2
n + *inp\u-48
aux | (1 << (n))
*inp+2
If *inp\u <> 0
*inp+2
EndIf
Until *inp\u = 0
ProcedureReturn aux>>1
EndProcedure
Global.s input1,input2,ResultB1,ResultB2
; if you process without the line >>> input1="bla ... bla ... bla ..."
; it works perfectly ... but activating the line gives a different result
; in the CreateB Procedure
input1="43 45"
input1="43 32 57 62" ; Range = from 01 to max 62 = correct values for the procedure
Debug input1
Result1=CreateB(@input1)
input2=input1
Debug input2
Result2=CreateB(@input2)
If Result1<>Result2
MessageRequester("Problem!",ResultB1+Chr(13)+ResultB2+Chr(13)+"different results... with the same string!"+Chr(13)+input1+" x "+input2, #PB_MessageRequester_Ok)
End
EndIf
MessageRequester("Finished","Ok ... no error!"+Chr(13)+"try activating the line 22 'bla ... bla ... bla ...'", #PB_MessageRequester_Ok)
-
- User
- Posts: 70
- Joined: Wed May 02, 2012 2:17 am
- Location: Brazil
Re: Comparisons in mathematical simulations
The example I created to explain the problem is very simple and by placing an alphanumeric string "bla bla bla" the error appears anywayidle wrote: ↑Wed May 10, 2023 12:37 am
or alternative passing by reference with an additional cmpCode: Select all
Procedure.i CreateB(*input) Protected *inp.Unicode = *input Protected n.u Protected aux.i Repeat n = (*inp\u-48) * 10 *inp+2 n + *inp\u-48 aux | (1 << (n)) *inp+2 If *inp\u <> 0 *inp+2 EndIf Until *inp\u = 0 ProcedureReturn aux>>1 EndProcedure Global.s input1,input2,ResultB1,ResultB2 ; if you process without the line >>> input1="bla ... bla ... bla ..." ; it works perfectly ... but activating the line gives a different result ; in the CreateB Procedure input1="43 45" input1="43 32 57 62" ; Range = from 01 to max 62 = correct values for the procedure Debug input1 Result1=CreateB(@input1) input2=input1 Debug input2 Result2=CreateB(@input2) If Result1<>Result2 MessageRequester("Problem!",ResultB1+Chr(13)+ResultB2+Chr(13)+"different results... with the same string!"+Chr(13)+input1+" x "+input2, #PB_MessageRequester_Ok) End EndIf MessageRequester("Finished","Ok ... no error!"+Chr(13)+"try activating the line 22 'bla ... bla ... bla ...'", #PB_MessageRequester_Ok)
without sending this content to the procedure.
My system processes your procedure a few billion times and always with numeric Strings "nn nn nn nn" but even so, at some point the procedure returned a wrong value.
Now with this modification it was perfect, I did a test here with 7.2 billion iterations and it passed without any errors!
congratulations one more time.
thank you very much
was solved
Re: Comparisons in mathematical simulations
Your welcome and it was educational to me to discover pb reuses the string memory sometimes.fvillanova wrote: ↑Wed May 10, 2023 2:27 amThe example I created to explain the problem is very simple and by placing an alphanumeric string "bla bla bla" the error appears anywayidle wrote: ↑Wed May 10, 2023 12:37 am
or alternative passing by reference with an additional cmpCode: Select all
Procedure.i CreateB(*input) Protected *inp.Unicode = *input Protected n.u Protected aux.i Repeat n = (*inp\u-48) * 10 *inp+2 n + *inp\u-48 aux | (1 << (n)) *inp+2 If *inp\u <> 0 *inp+2 EndIf Until *inp\u = 0 ProcedureReturn aux>>1 EndProcedure Global.s input1,input2,ResultB1,ResultB2 ; if you process without the line >>> input1="bla ... bla ... bla ..." ; it works perfectly ... but activating the line gives a different result ; in the CreateB Procedure input1="43 45" input1="43 32 57 62" ; Range = from 01 to max 62 = correct values for the procedure Debug input1 Result1=CreateB(@input1) input2=input1 Debug input2 Result2=CreateB(@input2) If Result1<>Result2 MessageRequester("Problem!",ResultB1+Chr(13)+ResultB2+Chr(13)+"different results... with the same string!"+Chr(13)+input1+" x "+input2, #PB_MessageRequester_Ok) End EndIf MessageRequester("Finished","Ok ... no error!"+Chr(13)+"try activating the line 22 'bla ... bla ... bla ...'", #PB_MessageRequester_Ok)
without sending this content to the procedure.
My system processes your procedure a few billion times and always with numeric Strings "nn nn nn nn" but even so, at some point the procedure returned a wrong value.
Now with this modification it was perfect, I did a test here with 7.2 billion iterations and it passed without any errors!
congratulations one more time.
thank you very much
was solved
Re: Comparisons in mathematical simulations
A slightly different approach ...
x64 ASM version
Code: Select all
Structure s_cb
n.l
s.u
EndStructure
Procedure.i CreateB(*input.s_cb)
Protected aux.i
Repeat
aux | 1 << ((*input\n & $f000f * $a0001) >> 16 & $ff)
If *input\s
*input + 6
Else
Break
EndIf
ForEver
ProcedureReturn aux >> 1
EndProcedure
Code: Select all
Procedure.i CreateB(*input)
!xor rax, rax
!xor edx, edx
!mov r8, [p.p_input]
!.loop:
!mov ecx, [r8]
!add r8, 6
!and ecx, 0xf000f
!imul ecx, 0xa0001
!shr ecx, 16
!bts rax, rcx
!cmp [r8 - 2], dx
!jne .loop
!shr rax, 1
ProcedureReturn
EndProcedure
Windows (x64)
Raspberry Pi OS (Arm64)
Raspberry Pi OS (Arm64)
-
- User
- Posts: 70
- Joined: Wed May 02, 2012 2:17 am
- Location: Brazil
Re: Comparisons in mathematical simulations
wilbert wrote: ↑Wed May 10, 2023 7:36 am A slightly different approach ...
Hi Wilbert,
This CreateB procedure is being used with your other PopCount procedure and both are performing fantastically.
I created this methodology to verify coincidences of occurrences in mathematical simulations with strings of 0 and 1 through the command Bin( xxx & yyy ) that instantly informs me how many positive samples (1) coincide between xxx and yyy using the PopCount yours created, see the current performance:The problem is that this great performance of the PopCount + CreateB procedures is limited to 01 to 64 different values while the Grep procedure works with values from 00 to 99.Code: Select all
DisableDebugger Macro Grep_TestEndOfString() CompilerIf #PB_Compiler_Unicode cmp byte [rdx - 2], 0 CompilerElse cmp byte [rdx - 1], 0 CompilerEndIf EndMacro Macro Grep_GetNumber() CompilerIf #PB_Compiler_Unicode mov ecx, [rdx] add rdx, 6 !shl cx, 12 !shr ecx, 12 CompilerElse mov cx, [rdx] add rdx, 3 !shl cl, 4 !shr ecx, 4 CompilerEndIf !and ecx, 0xff EndMacro Structure GrepBits l.l[5] EndStructure Procedure.i Grep(*String1, *String2) Protected GrepBits.GrepBits EnableASM CompilerIf #PB_Compiler_Processor = #PB_Processor_x64 !lea r8, [p.v_GrepBits] CompilerEndIf !sub eax, eax mov rdx, *String1 cmp byte [rdx], 0 !je grep_exit !align 8 !grep_loop00: Grep_GetNumber() CompilerIf #PB_Compiler_Processor = #PB_Processor_x64 !bts [r8], ecx CompilerElse !bts [p.v_GrepBits], ecx CompilerEndIf Grep_TestEndOfString() !jne grep_loop00 mov rdx, *String2 cmp byte [rdx], 0 !je grep_exit !align 8 !grep_loop11: Grep_GetNumber() CompilerIf #PB_Compiler_Processor = #PB_Processor_x64 !bt [r8], ecx CompilerElse !bt [p.v_GrepBits], ecx CompilerEndIf !adc eax, 0 Grep_TestEndOfString() !jne grep_loop11 !grep_exit: DisableASM ProcedureReturn EndProcedure Procedure PopCount(inp.i) !POPCNT rax,[p.v_inp] ProcedureReturn EndProcedure Procedure.i CreateB(*input) !xor rax, rax !xor edx, edx !mov r8, [p.p_input] !.loop: !mov ecx, [r8] !add r8, 6 !and ecx, 0xf000f !imul ecx, 0xa0001 !shr ecx, 16 !bts rax, rcx !cmp [r8 - 2], dx !jne .loop !shr rax, 1 ProcedureReturn EndProcedure s1.s="07 18 15 61 02 10 08 03" s2.s="01 17 61 07 04 05 18 06 57" x.i=CreateB(@s1) y.i=CreateB(@s2) t1 = ElapsedMilliseconds() For i=1 To 40000000 n=PopCount(x & y) Next Result$="CreateB() and PopCount() limited (01 to 64) = "+StrF((ElapsedMilliseconds()-t1),0)+" ms"+Chr(13) t1 = ElapsedMilliseconds() For i=1 To 40000000 n=Grep(@s1,@s2) Next Result$+"Grep() using (01 to 64) = "+StrF((ElapsedMilliseconds()-t1),0)+" ms"+Chr(13) Global Dim da.s(99) For i=0 To 99: da(i)=RSet(Str(i),2,"0"): Next Procedure.s CreateS(String1.s) Protected.i i Protected.s aux For i=99 To 0 Step-1 If FindString(String1,da(i)) aux+"1" Else aux+"0" EndIf Next ProcedureReturn aux EndProcedure s1.s="92 00 99 80 65 68 04 01" s2.s="37 65 04 92 15 98 00 43 02" s11.s=CreateS(s1) s22.s=CreateS(s2) part1.s=Left(s11,50) part2.s=Right(s11,50) part3.s=Left(s22,50) part4.s=Right(s22,50) x1.i=Val("%"+part1) x2.i=Val("%"+part2) y1.i=Val("%"+part3) y2.i=Val("%"+part4) t1 = ElapsedMilliseconds() For i=1 To 40000000 n=PopCount(x1 & y1)+PopCount(x2 & y2) Next Result$+"CreateS+CreateB+PopCount() with (00 to 99) = "+StrF((ElapsedMilliseconds()-t1),0)+" ms"+Chr(13) t1 = ElapsedMilliseconds() For i=1 To 40000000 n=Grep(@s1,@s2) Next Result$+"Grep() using (00 to 99) = "+StrF((ElapsedMilliseconds()-t1),0)+" ms"+Chr(13) EnableDebugger Debug Result$
I created a routine using values from 00 to 99 making a procedure that previously prepares the data to be used by CreateB and PopCount
And it's incredibly faster than the old Grep procedure
Now I just need to speed up my CreateS procedure.
Does anyone have any ideas on how to speed up my CreateS procedure that pre-processes the data?
Re: Comparisons in mathematical simulations
you can use the bitmodule I posted in my 1st reply, it facilitates arbitrary sized bit arrays binary logic and has bit counts
viewtopic.php?t=57409
viewtopic.php?t=57409
Code: Select all
UseModule BitModule
Procedure.i CreateB(*input)
Protected *inp.Unicode = *input
Protected n.u
Protected ba.IBitArray = New_BitArray()
Repeat
n = (*inp\u-48) * 10
*inp+2
n + *inp\u-48
ba\set(n)
*inp+2
If *inp\u <> 0
*inp+2
EndIf
Until *inp\u = 0
ProcedureReturn ba
EndProcedure
;test code
UseModule BitModule
;bit array class grows as needed
Define.i a
Define.s s1,s2
Define.IBitArray ba1,ba2,ba3
s1 = "92 00 99 80 65 68 04 01"
s2 = "37 65 04 92 15 98 00 43 02"
ba1 = createB(@s1)
ba2 = createb(@s2)
ba3 = ba1\BiNOPNew(ba2,#OP_AND) ;creates a new bit array
Debug ba3\BitCount()
ba1\Free()
ba2\Free()
ba3\Free()
Re: Comparisons in mathematical simulations
Here's my untested first attempt. The change made is to switch from a running string scorecard to using a binary numeric scorecard of the search results. Because of the maximum number of bit positions, two separate numeric variables are used. The numeric scorecard is then converted back to a binary string for output from the procedure.fvillanova wrote: ↑Mon May 15, 2023 11:19 pmDoes anyone have any ideas on how to speed up my CreateS procedure that pre-processes the data?
Below is only the code for procedure CreateS():
Code: Select all
Global Dim da.s(99)
For i=0 To 99: da(i)=RSet(Str(i),2,"0"): Next
Procedure.s CreateS(String1.s)
Protected.i i
Protected.q aux_1, aux_2
For i=99 To 50 Step-1
aux_1 << 1 + Bool(FindString(String1, da(i)) <> 0)
Next
For i=49 To 0 Step-1
aux_2 << 1 + Bool(FindString(String1, da(i)) <> 0)
Next
ProcedureReturn RSet(Bin(aux_1), 50, "0") + RSet(Bin(aux_2), 50, "0")
EndProcedure
Re: Comparisons in mathematical simulations
Here's my second attempt, also untested.
It keeps the scorecard as a string but updates it numerically (so to speak) and does away with many string operations. The only other thing to possibly address would be the string search operations. That would need testing to see if it is actually helpful for strings of the length you've given as examples.
It keeps the scorecard as a string but updates it numerically (so to speak) and does away with many string operations. The only other thing to possibly address would be the string search operations. That would need testing to see if it is actually helpful for strings of the length you've given as examples.
Code: Select all
Structure char_array
u.u[0]
EndStructure
Global Dim da.s(99)
For i=0 To 99: da(i)=RSet(Str(i),2,"0"): Next
Procedure.s CreateS(String1.s)
Protected.i i
Protected aux.s = RSet("", 100, "0")
Protected *aux.char_array = @aux
For i=99 To 0 Step-1
*aux\u[ i] = '0'+ Bool(FindString(String1, da(i)) <> 0)
Next
ProcedureReturn aux.s
EndProcedure
Re: Comparisons in mathematical simulations
I Think you've mis understood the question Demivec
The problem is he wants to set more than 64 bits. He needs a bit array and the string process isn't required
The problem is he wants to set more than 64 bits. He needs a bit array and the string process isn't required
Code: Select all
Procedure.i CreateB(*input) ;s1 = "92 00 99 80 65 68 04 01"
Protected *inp.Unicode = *input
Protected n.u
Protected ba.IBitArray = New_BitArray()
Repeat
n = (*inp\u-48) * 10
*inp+2
n + *inp\u-48
ba\set(n) ;<--- set bit in bit array
*inp+2
If *inp\u <> 0
*inp+2
EndIf
Until *inp\u = 0
ProcedureReturn ba
EndProcedure
Re: Comparisons in mathematical simulations
I agree I may have misunderstood. I focused on his request which seemed to focus on one procedure as part of a whole. It seemed he wanted a string returned from the process. I agree that a bit array is better than a string.
I'll find out more when he responds to the suggestions.
Re: Comparisons in mathematical simulations
Yes he's asking the right question but is pointing to the wrong place to solve it.Demivec wrote: ↑Tue May 16, 2023 2:09 amI agree I may have misunderstood. I focused on his request which seemed to focus on one procedure as part of a whole. It seemed he wanted a string returned from the process. I agree that a bit array is better than a string.
I'll find out more when he responds to the suggestions.
This should be simple enough to use and it can handle sequences of any size now. I already mentioned the bimodule in my 1st reply.
Time for 200,000 count 4 time 56 ms
Code: Select all
;https://www.purebasic.fr/english/viewtopic.php?t=57409
UseModule BitModule
Procedure.i CreateB(*input,*ba.IBitArray=0)
Protected *inp.Unicode = *input
Protected n.u
Repeat
n = (*inp\u-48) * 10
*inp+2
n + *inp\u-48
*ba\set(n)
*inp+2
If *inp\u <> 0
*inp+2
EndIf
Until *inp\u = 0
EndProcedure
Procedure Count(*input1,*input2)
Static.IBitArray ba1,ba2
If Not ba1
ba1 = New_BitArray()
ba2 = New_BitArray()
EndIf
ba1\Clear()
ba2\Clear()
CreateB(*input1,ba1)
Createb(*input2,ba2)
ba1\BiNOP(ba2,#OP_AND)
ProcedureReturn ba1\BitCount()
EndProcedure
;test code
UseModule BitModule
;bit array class grows as needed
Define.i a,cx,et,st,sz
Define.s s1,s2,out
s1 = "92 00 99 80 65 68 04 01"
s2 = "37 65 04 92 15 98 00 43 02"
cx = count(@s1,@s2)
sz = 10000
DisableDebugger
st = ElapsedMilliseconds()
For a = 0 To sz
count(@s1,@s2)
Next
et = ElapsedMilliseconds()
EnableDebugger
out.s = " count " + Str(cx) + " time " + Str(et-st) + " ms"
Debug out
-
- User
- Posts: 70
- Joined: Wed May 02, 2012 2:17 am
- Location: Brazil
Re: Comparisons in mathematical simulations
The count of 4 between the Strings:
s1.s="92 00 99 80 65 68 04 01"
s2.s="37 65 04 92 15 98 00 43 02"
It's not the problem, I already have the solution that does this with incredible speed as I explained above.
100 milliseconds to 400000000 (four hundred million) times, see:
What I need now is to speed up the CreateS() procedure that pre-processes the data that is used in the program.
Demivec's contribution has already helped a lot, is it possible to do it faster? the current position is:I appreciate any contribution to speeding up the CreateS() procedure.
I haven't been able to test other contributions that use the BitModule!
thanks
s1.s="92 00 99 80 65 68 04 01"
s2.s="37 65 04 92 15 98 00 43 02"
It's not the problem, I already have the solution that does this with incredible speed as I explained above.
100 milliseconds to 400000000 (four hundred million) times, see:
Code: Select all
DisableDebugger
Procedure PopCount(inp.i)
!POPCNT rax,[p.v_inp]
ProcedureReturn
EndProcedure
Global Dim da.s(99)
For i=0 To 99: da(i)=RSet(Str(i),2,"0"): Next
Procedure.s CreateS(String1.s)
Protected.i i
Protected.s aux
For i=99 To 0 Step-1
If FindString(String1,da(i))
aux+"1"
Else
aux+"0"
EndIf
Next
ProcedureReturn aux
EndProcedure
s1.s="92 00 99 80 65 68 04 01"
s2.s="37 65 04 92 15 98 00 43 02"
s11.s=CreateS(s1)
s22.s=CreateS(s2)
part1.s=Left(s11,50)
part2.s=Right(s11,50)
part3.s=Left(s22,50)
part4.s=Right(s22,50)
x1.i=Val("%"+part1)
x2.i=Val("%"+part2)
y1.i=Val("%"+part3)
y2.i=Val("%"+part4)
t1 = ElapsedMilliseconds()
For i=1 To 40000000
n=PopCount(x1 & y1)+PopCount(x2 & y2)
Next
Result$+"Count "+Str(n)+" in "+StrF((ElapsedMilliseconds()-t1),0)+" ms ( For 400000000 four hundred million times ) "+Chr(13)
EnableDebugger
Debug Result$
Demivec's contribution has already helped a lot, is it possible to do it faster? the current position is:
Code: Select all
DisableDebugger
Global Dim da.s(99)
For i=0 To 99: da(i)=RSet(Str(i),2,"0"): Next
Procedure.s CreateS_Old(String1.s)
Protected.i i
Protected.s aux
For i=99 To 0 Step-1
If FindString(String1,da(i))
aux+"1"
Else
aux+"0"
EndIf
Next
ProcedureReturn aux
EndProcedure
Procedure.s CreateS_Demivec(String1.s)
Protected.i i
Protected.q aux_1, aux_2
For i=99 To 50 Step-1
aux_1 << 1 + Bool(FindString(String1, da(i)) <> 0)
Next
For i=49 To 0 Step-1
aux_2 << 1 + Bool(FindString(String1, da(i)) <> 0)
Next
ProcedureReturn RSet(Bin(aux_1), 50, "0") + RSet(Bin(aux_2), 50, "0")
EndProcedure
Structure char_array
u.u[0]
EndStructure
Procedure.s CreateS_Demivec_II(String1.s)
Protected.i i
Protected aux.s = RSet("", 100, "0")
Protected *aux.char_array = @aux
For i=99 To 0 Step-1
*aux\u[ i] = '0'+ Bool(FindString(String1, da(i)) <> 0)
Next
ProcedureReturn aux.s
EndProcedure
s1.s="92 00 99 80 65 68 04 01"
s2.s="37 65 04 92 15 98 00 43 02"
t1 = ElapsedMilliseconds()
For i=1 To 10000
s11.s=CreateS_Old(s1)
s22.s=CreateS_Old(s2)
Next
Result$+"My initial CreateS = "+StrF((ElapsedMilliseconds()-t1),0)+" ms - OK"+Chr(13)+s11+Chr(13)+s22+Chr(13)
t1 = ElapsedMilliseconds()
For i=1 To 10000
s11.s=CreateS_Demivec(s1)
s22.s=CreateS_Demivec(s2)
Next
Result$+"Demivec's CreateS = "+StrF((ElapsedMilliseconds()-t1),0)+" ms - OK"+Chr(13)+s11+Chr(13)+s22+Chr(13)
t1 = ElapsedMilliseconds()
For i=1 To 10000
s11.s=CreateS_Demivec_II(s1)
s22.s=CreateS_Demivec_II(s2)
Next
Result$+"Demivec_II's CreateS = "+StrF((ElapsedMilliseconds()-t1),0)+" ms - wrong result"+Chr(13)+s11+Chr(13)+s22+Chr(13)
EnableDebugger
Debug Result$
I haven't been able to test other contributions that use the BitModule!
thanks
Re: Comparisons in mathematical simulations
you just asked to do this with a range of 100 bits. This is what does 100 bits with popcount!
your countS proceedure isn't needed
All you need to know is to call count()
So for your two input strings
it processes the strings directly into bit arrays, ands them together, then pop counts the result, it takes 56 ms for 200,000 loops including the string conversion not just the popcount time. Overall it's quicker.
Compile without debugger
your countS proceedure isn't needed
All you need to know is to call count()
So for your two input strings
Code: Select all
s1 = "92 00 99 80 65 68 04 01"
s2 = "37 65 04 92 15 98 00 43 02"
cx = count(@s1,@s2)
Compile without debugger
Code: Select all
EnableExplicit
DeclareModule BitModule
;BitModule
;Author Idle 17/11/13
;PB 5.42+
;Description
;BitVector ; Sets n number of bits with a given value into a memory stream which automatically grows:
; useful if working with arbitary bitsizes to produce an indexable array or output stream
;BitArray ; set, get or toggle a bit at an index in the array
;useful for membership tests 1 bit per index
;Bloom Filter ;probablistic structure to determine if an item exists in a set.
;useful for membership tests of unbounded data sets
;note can give false positives if a key doesn't exist in the set
;BitTrie ;store and retrieve integer key pair values
;useful as a replacement to a map
;Features
;All data structures can be saved to disk and loaded from file or memory
;bitarray bitvector and bloomfilter include logical operations not, or, xor, and
;v1.3.8
; shiftleft shiftright for bitarray bitvector
;v1.3.7
; fixed bitarray bit order
;v1.3.6
; added get bit count; fixed bug in bittrie reallocation;
;v1.3.5
;NOT, OR, XOR, AND for bitarray bitvector bloomfilter classes
;v1.3.4
;tuned up bloom added more hash functions
;v1.3.3
;improved trie time
;v1.3.2
;Added catch
;v1.3.1
;fixed trie walk
;v1.3
;Added Save and load
;modified Trie to work from file
;V1.2
;Added BitTrie
;v1.1
;changed bitvector get to getbuffer
;added bitvector get(index,bitcount)
Enumeration 1
#OP_OR
#OP_AND
#OP_XOR
EndEnumeration
Interface IBitVector
Set(val,bitcount) ;adds a value to the bitvector stream eg: val=%0101010, bitcount=7
Get(index,bitcount) ;Get bits from the index by number of bits eg index =7, bitcount =3
GetBuffer() ; Returns pointer to the buffer
SetBuffer(*mem,len) ;Set the buffer to use
BinOP(bitvector,OP) ;Perform a binary operation on another bit vector OR XOR AND bitModule::#OP_OR
Not() ;nots the buffer
ShiftLeft() ;shift left number of bits
ShiftRight() ;shift right number of bits
Save(file.s,CompressLevel=9) ;save a compressed bit buffer to file
Load(file.s) ;load a compressed bit buffer from file
Catch(*mem,len) ;catch a saved bit buffer from a datasection
BitSize() ;size of stream in bits
ByteSize() ;size in stream in bytes
BitCount() ;popcount number of bits set
Clear()
Free()
EndInterface
Interface IBitArray
Set(index) ;Set bit at position to 1
ReSet(index) ;Reset bit at position to 0
Toggle(index) ;Toggle value of bit at position
Get(index) ;Check if the bit is set returns > 0 if true
GetBuffer() ; Returns pointer to the buffer
BinOP(bitarray,OP) ;Perform a binary operation on another bit array OR XOR AND bitModule::#OP_OR
BiNOPNew(bitarray,OP) ;Perform a binary operation on another bit array and returns a new bitarray
Not() ;Nots the buffer
ShiftLeft() ;shift left number of bits
ShiftRight() ;shift right number of bits
Save(file.s,CompressLevel=9) ;save compressed bitarray to file
Load(file.s) ;load compressed bitarray from file
Catch(*mem,len) ;catch compressed bitarray from datasection
BitSize() ;size of array in bits
ByteSize() ;size in array in bytes
BitCount()
Clear()
Free()
EndInterface
Interface IBloomFilter
Set(*key,len) ;Set the key ;*key, pointer to the memory string or integer,
Get(*key,len) ;look up a key in the filter
GetBuffer() ; Returns pointer to the buffer
BinOP(bloomfilter,OP) ;Perform a binary operation on another bloom filter OR XOR AND bitModule::#OP_OR
Not() ;Nots the buffer
Save(file.s,CompressLevel=9) ;save compresed bloom to file
Load(file.s) ;load compressed bloom from file
Catch(*mem,len) ;catch compressed bloom from datasection
BitSize()
ByteSize()
BitCount()
Clear()
Free()
EndInterface
Prototype BitTrieCB(value.i,*userdata=0,*userdata1=0)
Interface IBitTrie ;bit Trie
Set(key.i,value=1) ;store a value with the key
Get(key.i) ;get the value with the key
GetBuffer() ;get the pointer to the buffer
Walk(*cb.bitTrieCB,*usrdata=0,*usrdata1=0) ;dumps the trie unordered
Save(file.s,CompressLevel=9) ;save the trie to file
Load(file.s) ;load the trie from file
Catch(*mem,len) ;catch the trie from a data section
ByteCount() ;size of trie
NumItems()
Clear()
Free()
EndInterface
Declare.q Hash_Rs(*mem,len.i)
Declare.q Hash_Sax(*mem,len.i)
Declare.q Hash_Sdbm(*mem,len.i)
Declare.q Hash_Js(*mem,len.i)
Declare.q Hash_Fnv32_1(*mem,len.i)
Declare.q Hash_Fnv32_1a(*mem,len.i)
Declare.q Hash_Adler32(*mem,len.i)
Declare New_BitVector(size=64,*data=0)
Declare New_BitArray(size=64,*data=0)
Declare New_BitTrie(size=64)
Declare New_BloomFilter(Items,NumberOfKeys=4,MaxErrorRate.f=0.999)
EndDeclareModule
Module BitModule
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
ImportC "zlib.lib"
compress2(*dest,*destlen,*source,sourcelen,level)
uncompress(*dest,*destlen,*source,sourcelen)
EndImport
CompilerElse
ImportC "-lz"
compress2(*dest,*destlen,*source,sourcelen,level)
uncompress(*dest,*destlen,*source,sourcelen)
EndImport
CompilerEndIf
Enumeration 1
#obj_bitarray
#obj_bitvector
#obj_bloom
#obj_bittire
EndEnumeration
Structure BitBufInfo
Size.q
Bytesused.q
Position.q
Misc.l
type.l
EndStructure
Structure BitBuffer
*vt
inf.bitbufinfo
*buf
EndStructure
Structure node
inext.l[2]
value.i
EndStructure
Structure BitTrie Extends bitBuffer
avail.i
count.i
EndStructure
Procedure New_BitTrie(size=64)
Protected *this.BitTrie
*this = AllocateMemory(SizeOf(bittrie))
*this\vt = ?vt_BitTrie
*this\inf\size = Size*SizeOf(node)
*this\inf\Bytesused = *this\inf\size
*this\inf\Position=SizeOf(node)
*this\inf\type = #obj_bittire
*this\buf = AllocateMemory(*this\inf\Size)
*this\avail = *this\inf\size-SizeOf(node)
ProcedureReturn *this
EndProcedure
Procedure BitTrie_Add(*this.bittrie,key.i,val.i=1)
Protected *node.node,idx,a,lp,offset
CompilerIf SizeOf(Integer) = 8
!bsr qword rax , qword [p.v_key]
!mov [p.v_lp] , rax
CompilerElse
!bsr dword eax , dword [p.v_key]
!mov [p.v_lp] , eax
CompilerEndIf
*node = *this\buf
If key <> 0
For a = lp To 0 Step -1
idx = (key >> a) & 1
If *node\inext[idx]
offset = *node\inext[idx]
*node = *this\buf + offset
ElseIf *this\avail > 0
offset = *this\inf\Position
*node\inext[idx] = offset
*node = *this\buf + offset
*this\avail - SizeOf(node)
*this\inf\Position+SizeOf(node)
*this\inf\Bytesused = *this\inf\Position
Else
*this\avail = 64*SizeOf(node)
*this\inf\size + *this\avail
*this\buf = ReAllocateMemory(*this\buf,*this\inf\size)
*node = *this\buf + offset
offset = *this\inf\Position
*node\inext[idx] = offset ;
*node = *this\buf + offset
*this\avail - SizeOf(node)
*this\inf\Position+SizeOf(node)
*this\inf\Bytesused = *this\inf\Position
EndIf
Next
EndIf
If *node
*node\value = val
*this\count + 1
EndIf
EndProcedure
Procedure BitTrie_Get(*this.bittrie,key.i)
Protected *node.node,value,a,idx,lp
CompilerIf SizeOf(Integer) = 8
!bsr qword rax , qword [p.v_key]
!mov [p.v_lp] , rax
CompilerElse
!bsr dword eax , dword [p.v_key]
!mov [p.v_lp] , eax
CompilerEndIf
*node = *this\buf
If key <> 0
For a = lp To 0 Step -1
idx = (key>>a) & 1
If *node
If *node\inext[idx]
*node = *this\buf + *node\inext[idx]
Else
ProcedureReturn 0
EndIf
Else
ProcedureReturn 0
EndIf
Next
EndIf
If *node
ProcedureReturn *node\value
EndIf
EndProcedure
Procedure BitTrie_Walk(*this.bitTrie,*cb.bitTrieCB,*userdata=0,*userdata1=0)
Protected *node.node,pos
If *cb
While pos < *this\inf\Bytesused
*node = *this\buf +pos
If *node\value
*cb(*node\value,*userdata,*userdata1)
EndIf
pos + SizeOf(node)
Wend
EndIf
EndProcedure
Procedure BitTrie_NumItems(*this.bitTrie)
ProcedureReturn *this\count
EndProcedure
Procedure.q Hash_Rs(*mem,len) ;Rs
Protected hash.l, *pta.Ascii,a.l,b.l
a = 378551
b = 63689
*pta =*mem
For c = 1 To len
hash * a
hash + *pta\a
a * b
*pta+1
Next
ProcedureReturn hash & $FFFFFFFF
EndProcedure
Procedure.q Hash_Sax(*mem,len) ;sax
Protected hash.l, *pta.Ascii
*pta =*mem
For a = 1 To len
hash ! (((hash <<5) + (hash >> 2)) + *pta\a)
*pta+1
Next
ProcedureReturn hash & $FFFFFFFF
EndProcedure
Procedure.q Hash_Sdbm(*mem,len) ;sdbm
Protected hash.l, *pta.Ascii
*pta =*mem
For a = 1 To len
hash = *pta\a + ((hash<<6) + (hash<<16) - hash)
*pta+1
Next
ProcedureReturn hash & $FFFFFFFF
EndProcedure
Procedure.q Hash_Js(*mem,len) ;js
Protected hash.l, *pta.Ascii
hash = 1315423911;
*pta =*mem
For a = 1 To len
hash ! ((hash<<5)+*pta\a) +(hash>>2)
*pta+1
Next
ProcedureReturn hash & $FFFFFFFF
EndProcedure
Procedure.q Hash_Fnv32_1(*mem,len) ;Fnv32-1
Protected p.l,hash.l, *pta.Ascii
p = 16777619
hash = 2166136261
*pta =*mem
For a = 1 To len
hash * p
hash ! *pta\a
*pta+1
Next
ProcedureReturn hash & $FFFFFFFF
EndProcedure
Procedure.q Hash_Fnv32_1a(*mem,len) ;fnv32-1a
Protected p.l,hash.l, *pta.Ascii
p = 16777619
hash = 2166136261
*pta =*mem
For a = 1 To len
hash ! *pta\a
hash * p
*pta+1
Next
ProcedureReturn hash & $FFFFFFFF
EndProcedure
Procedure.q Hash_Adler32(*mem,len) ;adler32
Protected pa.l,pb.l,hash.l, *pta.Ascii
*pta =*mem
For a = 1 To len
pa + *pta\a
pa % 65521
pb + a
pb % 65521
*pta+1
Next
hash = ((pb << 16) | pa)
ProcedureReturn hash & $FFFFFFFF
EndProcedure
Prototype.q hash(*mem,len)
Structure bloom Extends bitbuffer
*hashFn.hash[7]
EndStructure
Procedure New_BloomFilter(Items,NumberOfKeys=4,MaxErrorRate.f=0.999)
Protected *this.bloom
*this = AllocateMemory(SizeOf(bloom))
If NumberOfKeys > 6
NumberOfKeys = 6
EndIf
If *this
*this\vt = ?vt_bloom
*this\inf\Position = (-(NumberOfKeys * (items))) / (Log(1 - Pow((MaxErrorRate),1/NumberOfKeys )))
*this\inf\Size = *this\inf\Position >> 3
*this\inf\BytesUsed = *this\inf\size
*this\inf\misc =NumberOfKeys
*this\inf\type = #obj_bloom
*this\buf = AllocateMemory(*this\inf\size)
*this\hashFn[0] = @Hash_Rs()
*this\hashFn[1] = @Hash_Sax()
*this\hashFn[2] = @Hash_Sdbm()
*this\hashFn[3] = @Hash_Js()
*this\hashFn[4] = @Hash_Fnv32_1()
*this\hashFn[5] = @Hash_Fnv32_1a()
*this\hashFn[6] = @Hash_Adler32()
ProcedureReturn *this
EndIf
EndProcedure
Procedure Bloom_Set(*this.Bloom,*key,len)
Protected hash.q,a.i,*ta.Ascii
For a = 0 To *this\inf\Misc-1
hash = *this\hashFn[a](*key,len)
hash % *this\inf\Position
*ta = *this\buf+(hash>>3)
*ta\a | (1 << (hash & $07))
Next
EndProcedure
Procedure Bloom_Get(*this.Bloom,*Key,len)
Protected hash.q,tret,retrn,a,*ta.Ascii
For a = 0 To *this\inf\Misc-1
hash = *this\hashFn[a](*key,len)
hash % *this\inf\Position
*ta = *this\buf+(hash>>3)
tret = (*ta\a & (1 << (hash & $07)))
If tret = 0
ProcedureReturn 0
Else
retrn + 1
EndIf
Next
If retrn = *this\inf\Misc ;number of keys
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure New_BitArray(sizebytes=64,*data=0)
Protected *bv.bitbuffer
*bv = AllocateMemory(SizeOf(bitbuffer))
If *bv
*bv\vt = ?vt_bitArray
*bv\buf = AllocateMemory(sizebytes)
If *bv\buf
*bv\inf\Size = sizebytes
*bv\inf\BytesUsed = sizebytes
*bv\inf\Position = 0
*bv\inf\type = #obj_bitarray
If *data
CopyMemory(*data,*bv\buf,sizebytes)
*bv\inf\Position = sizebytes * 8
EndIf
ProcedureReturn *bv
EndIf
EndIf
EndProcedure
Procedure BitArray_Set(*this.bitbuffer,index)
Protected *ta.Ascii, *bv.bitbuffer,tsize
Protected bit.a
If ((index) >> 3) >= *this\inf\size
*this\inf\size = index + 64
*this\inf\BytesUsed = *this\inf\size
*this\buf = ReAllocateMemory(*this\buf,*this\inf\Size)
EndIf
If *this\buf
*ta = *this\buf + ((index)>>3)
*ta\a | (1 << (7-(index & $07)))
EndIf
EndProcedure
Procedure BitArray_ReSet(*this.bitbuffer,index)
Protected *ta.Ascii
If ((index) >> 3) >= *this\inf\size
*this\inf\size = index + 64
*this\inf\BytesUsed = *this\inf\size
*this\buf = ReAllocateMemory(*this\buf,*this\inf\size)
EndIf
If *this\buf
*ta = *this\buf + ((index)>>3)
If *ta\a & (1 << (7-(index & $07)))
*ta\a ! (1 << (7-(index & $07)))
EndIf
EndIf
EndProcedure
Procedure BitArray_Toggle(*this.bitbuffer,index)
Protected *ta.Ascii
If ((index) >> 3) >= *this\inf\size
*this\inf\size = index + 64
*this\inf\BytesUsed = *this\inf\size
*this\buf = ReAllocateMemory(*this\buf,*this\inf\size)
EndIf
If *this\buf
*ta = *this\buf + ((index)>>3)
*ta\a ! (1 << (7-(index & $07)))
EndIf
EndProcedure
Procedure BitArray_Get(*this.bitbuffer,index)
Protected *ta.Ascii,idx
If ((index) >> 3) <= *this\inf\size
*ta = *this\buf+(index>>3)
If (*ta\a & (1 << (7-(index & $07))))
ProcedureReturn 1
EndIf
EndIf
EndProcedure
Procedure New_BitVector(sizebytes=64,*data=0)
Protected *bv.bitBuffer
*bv = AllocateMemory(SizeOf(bitbuffer))
If *bv
*bv\vt = ?vt_bitvector
*bv\buf = AllocateMemory(sizebytes)
If *bv\buf
*bv\inf\size = sizebytes
*bv\inf\BytesUsed = 0
*bv\inf\Position = 0
*bv\inf\type = #obj_bitvector
If *data
CopyMemory(*data,*bv\buf,sizebytes)
*bv\inf\Position = sizebytes * 8
*bv\inf\Bytesused = sizebytes
EndIf
ProcedureReturn *bv
EndIf
EndIf
EndProcedure
Procedure BitVector_Set(*this.bitbuffer,val,bitcount)
Protected *ti.quad,tsize
tsize = (*this\inf\Position+bitcount) >> 3
If tsize >= *this\inf\size
*this\inf\size = tsize +64
*this\buf = ReAllocateMemory(*this\buf,*this\inf\size)
EndIf
If *this\buf
*ti = *this\buf + ((*this\inf\Position)>>3)
*ti\q | (val << ( *this\inf\Position & $07))
*this\inf\Position + bitcount
*this\inf\BytesUsed = Round(*this\inf\Position / 8,#PB_Round_Up) ;*this\inf\Position >> 3
EndIf
EndProcedure
Procedure BitVector_Get(*this.bitbuffer,index,bitcount)
Protected mask.q,*ti.quad,shift
mask = $FFFFFFFF
mask >> (32-bitcount)
If *this\buf
*ti = *this\buf + ((index)>>3)
shift = (index & $07)
ProcedureReturn (*ti\q & (mask << shift)) >> shift
EndIf
EndProcedure
Procedure BitBuffer_GetBuffer(*this.bitbuffer)
If *this
ProcedureReturn *this\buf
EndIf
EndProcedure
Procedure BitBuffer_SetBuffer(*this.bitbuffer,*mem,len)
If *this
*this\buf = *mem
*this\inf\Bytesused = len
*this\inf\Size = len
EndIf
EndProcedure
Procedure BitBuffer_BiNOP(*this.bitbuffer,*that.bitbuffer,OP)
Protected *pa.Ascii,*pb.Ascii,a
If *this\inf\Size <= *that\inf\Size
*this\buf = ReAllocateMemory(*this\buf,*that\inf\Size)
*this\inf\Size = *that\inf\Size
*this\inf\Position = *that\inf\Position
*this\inf\Bytesused = *that\inf\Bytesused
*this\inf\Misc = *that\inf\Misc
EndIf
*pa = *this\buf
*pb = *that\buf
For a = 0 To *that\inf\Size-1
Select OP
Case #OP_OR
*pa\a | *pb\a
Case #OP_AND
*pa\a & *pb\a
Case #OP_XOR
*pa\a ! *pb\a
EndSelect
*pa+1
*pb+1
Next
EndProcedure
Procedure BitBuffer_BiNOPNew(*this.bitbuffer,*that.bitbuffer,OP)
Protected *pa.Ascii,*pb.Ascii,*pc.Ascii,a
Protected *result.BitBuffer = New_BitArray(*this\inf\Size)
*pa = *this\buf
*pb = *that\buf
*pc = *result\buf
For a = 0 To *that\inf\Size;-1
Select OP
Case #OP_OR
*pc\a = *pa\a | *pb\a
Case #OP_AND
*pc\a = *pa\a & *pb\a
Case #OP_XOR
*pc\a = *pa\a ! *pb\a
EndSelect
*pa+1
*pb+1
*pc+1
Next
ProcedureReturn *result
EndProcedure
Procedure BitBuffer_Not(*this.bitbuffer)
Protected *pa.Ascii,a
*pa = *this\buf
For a = 0 To *this\inf\Size
*pa\a = ~*pa\a
*pa+1
Next
EndProcedure
Procedure BitBuffer_ShiftLeft(*this.bitbuffer)
Protected *data,length.l
*data = *this\buf
length = *this\inf\Size
!xor eax, eax
!mov ecx, [p.v_length]
!dec ecx
!jc slb_exit
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
!mov rdx, [p.p_data]
!slb_loop:
!mov ah, [rdx + rcx]
!shl eax, 1
!mov [rdx + rcx], ah
CompilerElse
!mov edx, [p.p_data]
!slb_loop:
!mov ah, [edx + ecx]
!shl eax, 1
!mov [edx + ecx], ah
CompilerEndIf
!shr eax, 9
!sub ecx, 1
!jnc slb_loop
!slb_exit:
!shr eax, 7
ProcedureReturn
EndProcedure
Procedure BitBuffer_ShiftRight(*this.bitbuffer)
Protected *data,length.l
*data = *this\buf
length = *this\inf\Position
!xor eax, eax
!mov ecx, [p.v_length]
!and ecx, ecx
!jz srb_exit
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
!mov rdx, [p.p_data]
!srb_loop:
!mov ah, [rdx]
!shr eax, 1
!mov [rdx], ah
!inc rdx
CompilerElse
!mov edx, [p.p_data]
!srb_loop:
!mov ah, [edx]
!shr eax, 1
!mov [edx], ah
!inc edx
CompilerEndIf
!shl eax, 9
!dec ecx
!jnz srb_loop
!srb_exit:
!shr eax, 16
!and eax, 1
ProcedureReturn
EndProcedure
CompilerIf SizeOf(Integer) = 4
Procedure _popcountmem(*mem.long,len.l)
Protected result,a,b
!mov eax, [p.v_len]
!and eax, 3
!mov edx, [p.v_len]
!sub edx,eax
!mov [p.v_a],edx
!mov [p.v_b],eax
!xor ecx,ecx
!lwhile:
!cmp ecx, [p.v_a]
!jge lend
!mov eax, [p.p_mem]
!mov eax, [eax + ecx]
!mov edx, eax
!shr edx, 1
!and edx, 0x55555555
!sub eax,edx
!mov edx, eax
!and eax, 0x33333333
!shr edx, 2
!and edx, 0x33333333
!add eax,edx
!mov edx, eax
!shr edx, 4
!add eax,edx
!and eax, 0x0f0f0f0f
!imul eax, 0x01010101
!shr eax, 24
!add [p.v_result],eax
!add ecx,4
!jmp lwhile
!lend:
!mov eax, [p.p_mem]
!mov eax, [eax + ecx]
!mov edx, [p.v_b]
!jmp dword [JT_remain + edx * 4]
!JT_remain dd le,l1,l2,l3,l4
!l1:
!and eax, 0xff
!jmp le
!l2:
!and eax, 0xffff
!jmp le
!l3:
!and eax, 0xffffff
!jmp le
!l4:
!le:
!mov edx, eax
!shr edx, 1
!and edx, 0x55555555
!sub eax,edx
!mov edx, eax
!and eax, 0x33333333
!shr edx, 2
!and edx, 0x33333333
!add eax,edx
!mov edx, eax
!shr edx, 4
!add eax,edx
!and eax, 0x0f0f0f0f
!imul eax, 0x01010101
!shr eax, 24
!add [p.v_result],eax
ProcedureReturn result
EndProcedure
Procedure _popcountmemSSE(*mem,len)
Protected result,a,b
!mov eax, [p.v_len]
!and eax, 3
!mov edx, [p.v_len]
!sub edx,eax
!mov [p.v_a],edx
!mov [p.v_b],eax
!xor ecx,ecx
!lwhile1:
!cmp ecx, [p.v_a]
!jge lend1
!mov eax, [p.p_mem]
!mov eax, [eax + ecx]
!popcnt eax,eax
!add [p.v_result],eax
!add ecx,4
!jmp lwhile1
!lend1:
!mov eax, [p.p_mem]
!mov eax, [eax + ecx]
!mov edx, [p.v_b]
!jmp dword [JT_remain1 + edx * 4]
!JT_remain1 dd lle,ll1,ll2,ll3,ll4
!ll1:
!and eax, 0xff
!jmp lle
!ll2:
!and eax, 0xffff
!jmp lle
!ll3:
!and eax, 0xffffff
!jmp lle
!ll4:
!lle:
!mov edx,eax
!popcnt eax,edx
!add [p.v_result],eax
ProcedureReturn result
EndProcedure
CompilerElse
Procedure _popcountmem(*mem,len)
Protected result,a,b
!mov rax, [p.v_len]
!And rax, 3
!mov rdx, [p.v_len]
!sub rdx,rax
!mov [p.v_a],rdx
!mov [p.v_b],rax
!xor rcx,rcx
!lwhile:
!cmp rcx, [p.v_a]
!jge lend
!mov rax, [p.p_mem]
!mov eax, [rax + rcx]
!mov edx, eax
!shr edx, 1
!and edx, 0x55555555
!sub eax,edx
!mov edx, eax
!and eax, 0x33333333
!shr edx, 2
!and edx, 0x33333333
!add eax,edx
!mov edx, eax
!shr edx, 4
!add eax,edx
!and eax, 0x0f0f0f0f
!imul eax, 0x01010101
!shr eax, 24
!add [p.v_result],eax
!add rcx,4
!jmp lwhile
!lend:
!mov rax, [p.p_mem]
!mov eax, [rax + rcx]
!lea rdx, [JT_remain]
!mov rcx, [p.v_b]
!jmp qword [rdx + rcx * 8]
!JT_remain dq le,l1,l2,l3,l4
!l1:
!and eax, 0xff
!jmp le
!l2:
!and eax, 0xffff
!jmp le
!l3:
!and eax, 0xffffff
!jmp le
!l4:
!le:
!mov edx, eax
!shr edx, 1
!and edx, 0x55555555
!sub eax,edx
!mov edx, eax
!and eax, 0x33333333
!shr edx, 2
!and edx, 0x33333333
!add eax,edx
!mov edx, eax
!shr edx, 4
!add eax,edx
!and eax, 0x0f0f0f0f
!imul eax, 0x01010101
!shr eax, 24
!add [p.v_result],eax
ProcedureReturn result
EndProcedure
Procedure _popcountmemSSE(*mem,len)
Protected result,a,b
!mov rax, [p.v_len]
!and rax, 7
!mov rdx, [p.v_len]
!sub rdx,rax
!mov [p.v_a],rdx
!mov [p.v_b],rax
!xor rcx,rcx
!lwhile1:
!cmp rcx, [p.v_a]
!jge lend1
!mov rax, [p.p_mem]
!mov rax, [rax + rcx]
!popcnt rax,rax
!add [p.v_result],rax
!add rcx,8
!jmp lwhile1
!lend1:
!mov rax, [p.p_mem]
!mov rax, [rax + rcx]
!lea rdx, [JT_remain1]
!mov rcx, [p.v_b]
!jmp qword [rdx + rcx * 8]
!JT_remain1 dq lle,ll1,ll2,ll3,ll4,ll5,ll6,ll7,ll8
!ll1:
!and rax, 0xff
!jmp lle
!ll2:
!and rax, 0xffff
!jmp lle
!ll3:
!and rax, 0xffffff
!jmp lle
!ll4:
!mov rdx,0xffffffff
!and rax, rdx
!jmp lle
!ll5:
!mov rdx, 0xffffffffff
!and rax, rdx
!jmp lle
!ll6:
!mov rdx,0xffffffffffff
!and rax, rdx
!jmp lle
!ll7:
!mov rdx,0xffffffffffffff
!and rax, rdx
!jmp lle
!ll8:
!lle:
!mov rdx,rax
!popcnt rax,rdx
!add [p.v_result],rax
ProcedureReturn result
EndProcedure
CompilerEndIf
Prototype PopCountMem(*mem,len)
Global PopCountMem.PopCountMem
Procedure InitpopCount()
Protected result
!mov eax, 1
!cpuid
!shr ecx, 23
!and ecx, 1
!mov [p.v_result],ecx
If result
popcountmem = @_popcountmemSSE()
Else
popcountmem = @_popcountmem()
EndIf
EndProcedure
Procedure BitBuffer_GetBitCount(*this.bitbuffer) ;popcount
If *this
If Not popcountmem
InitpopCount()
EndIf
ProcedureReturn PopCountMem(*this\buf,*this\inf\Size)
EndIf
EndProcedure
Procedure BitBuffer_GetBitSize(*this.bitbuffer)
If *this
ProcedureReturn *this\inf\BytesUsed * 8
EndIf
EndProcedure
Procedure BitBuffer_GetByteSize(*this.bitbuffer)
If *this
ProcedureReturn *this\inf\BytesUsed
EndIf
EndProcedure
Procedure BitBuffer_SaveToFile(*this.bitbuffer,file.s,CompressLevel=9)
Protected fn,len,*src,*dst,destlen,srclen
fn = OpenFile(#PB_Any,file)
If fn
srclen = *this\inf\BytesUsed+SizeOf(BitBufInfo)
*src = AllocateMemory(srclen)
destlen = srclen * 1.5
*dst = AllocateMemory(destlen)
If *src And *dst ;bit stupid here need to rework structures so don't have to copy before compress
CopyMemory(@*this\inf,*src,SizeOf(BitBufInfo))
CopyMemory(*this\buf,*src+SizeOf(BitBufInfo),*this\inf\BytesUsed)
If compress2(*dst,@destlen,*src,srclen ,CompressLevel) = 0
len = WriteLong(fn,srclen)
len + WriteData(fn,*dst,destlen)
CloseFile(fn)
FreeMemory(*src)
FreeMemory(*dst)
ProcedureReturn len
EndIf
EndIf
EndIf
EndProcedure
Procedure BitBuffer_LoadFile(*this.bitbuffer,file.s)
Protected fn,destlen,srclen,*src,*dst
fn = OpenFile(#PB_Any,file)
If fn
destlen = ReadLong(fn)
*dst = AllocateMemory(destlen)
srclen = Lof(fn)-4
*src = AllocateMemory(srclen)
ReadData(fn,*src,srclen)
If uncompress(*dst,@destlen,*src,srclen) = 0
CopyMemory(*dst,@*this\inf,SizeOf(BitBufInfo))
FreeMemory(*this\buf)
*this\buf = AllocateMemory(*this\inf\size)
CopyMemory(*dst+SizeOf(BitBufInfo),*this\buf,destlen-SizeOf(BitBufInfo))
FreeMemory(*dst)
FreeMemory(*src)
CloseFile(fn)
ProcedureReturn 1
EndIf
EndIf
EndProcedure
Procedure BitBuffer_Catch(*this.bitbuffer,*mem,len)
Protected destlen,srclen,*src,*dst
If *mem
destlen = PeekL(*mem)
*mem+4
*dst = AllocateMemory(destlen)
srclen = len-4
If uncompress(*dst,@destlen,*mem,srclen) = 0
CopyMemory(*dst,@*this\inf,SizeOf(BitBufInfo))
FreeMemory(*this\buf)
*this\buf = AllocateMemory(*this\inf\size)
CopyMemory(*dst+SizeOf(BitBufInfo),*this\buf,destlen-SizeOf(BitBufInfo))
FreeMemory(*dst)
ProcedureReturn 1
EndIf
EndIf
EndProcedure
Procedure BitBuffer_Clear(*this.bitbuffer)
If *this
FillMemory(*this\buf,*this\inf\Bytesused)
*this\inf\Position=0
EndIf
EndProcedure
Procedure BitBuffer_Free(*this.bitbuffer)
If *this
FreeMemory(*this\buf)
FreeMemory(*this)
EndIf
EndProcedure
DataSection
vt_Bitvector:
Data.i @BitVector_Set()
Data.i @BitVector_Get()
Data.i @BitBuffer_GetBuffer()
Data.i @BitBuffer_SetBuffer()
Data.i @BitBuffer_BinOP()
Data.i @BitBuffer_Not()
Data.i @bitBuffer_ShiftLeft()
Data.i @bitbuffer_ShiftRight()
Data.i @BitBuffer_SaveToFile()
Data.i @BitBuffer_LoadFile()
Data.i @BitBuffer_Catch()
Data.i @BitBuffer_GetBitSize()
Data.i @BitBuffer_GetByteSize()
Data.i @BitBuffer_GetBitCount()
Data.i @BitBuffer_Clear()
Data.i @BitBuffer_Free()
EndDataSection
DataSection
vt_BitArray:
Data.i @BitArray_Set()
Data.i @BitArray_ReSet()
Data.i @BitArray_Toggle()
Data.i @BitArray_Get()
Data.i @BitBuffer_GetBuffer()
Data.i @BitBuffer_BinOP()
Data.i @BitBuffer_BiNOPNew()
Data.i @BitBuffer_Not()
Data.i @bitBuffer_ShiftLeft()
Data.i @bitbuffer_ShiftRight()
Data.i @BitBuffer_SaveToFile()
Data.i @BitBuffer_LoadFile()
Data.i @BitBuffer_Catch()
Data.i @BitBuffer_GetBitSize()
Data.i @BitBuffer_GetByteSize()
Data.i @BitBuffer_GetBitCount()
Data.i @BitBuffer_Clear()
Data.i @BitBuffer_Free()
EndDataSection
DataSection
vt_bloom:
Data.i @Bloom_Set()
Data.i @Bloom_Get()
Data.i @BitBuffer_GetBuffer()
Data.i @BitBuffer_BinOP()
Data.i @BitBuffer_Not()
Data.i @BitBuffer_SaveToFile()
Data.i @BitBuffer_LoadFile()
Data.i @BitBuffer_Catch()
Data.i @BitBuffer_GetBitSize()
Data.i @BitBuffer_GetByteSize()
Data.i @BitBuffer_GetBitCount()
Data.i @BitBuffer_Clear()
Data.i @BitBuffer_Free()
EndDataSection
DataSection
vt_BitTrie:
Data.i @BitTrie_Add()
Data.i @BitTrie_Get()
Data.i @BitBuffer_GetBuffer()
Data.i @BitTrie_Walk()
Data.i @BitBuffer_SaveToFile()
Data.i @BitBuffer_LoadFile()
Data.i @BitBuffer_Catch()
Data.i @BitBuffer_GetByteSize()
Data.i @BitTrie_NumItems()
Data.i @BitBuffer_Clear()
Data.i @BitBuffer_Free()
EndDataSection
EndModule
CompilerIf #PB_Compiler_IsMainFile
UseModule BitModule
Procedure.i CreateB(*input,*ba.IBitArray=0)
Protected *inp.Unicode = *input
Protected n.u
Repeat
n = (*inp\u-48) * 10
*inp+2
n + *inp\u-48
*ba\set(n)
*inp+2
If *inp\u <> 0
*inp+2
EndIf
Until *inp\u = 0
EndProcedure
Procedure Count(*input1,*input2)
Static.IBitArray ba1,ba2
If Not ba1
ba1 = New_BitArray()
ba2 = New_BitArray()
EndIf
ba1\Clear()
ba2\Clear()
CreateB(*input1,ba1)
Createb(*input2,ba2)
ba1\BiNOP(ba2,#OP_AND)
ProcedureReturn ba1\BitCount()
EndProcedure
;test code
UseModule BitModule
;bit array class grows as needed
Define.i a,cx,et,st,sz
Define.s s1,s2,out
s1 = "92 00 99 80 65 68 04 01"
s2 = "37 65 04 92 15 98 00 43 02"
cx = count(@s1,@s2)
sz = 200000
st = ElapsedMilliseconds()
For a = 0 To sz
count(@s1,@s2)
Next
et = ElapsedMilliseconds()
out.s = " count " + Str(cx) + " time " + Str(et-st) + " ms"
SetClipboardText(out)
MessageRequester("End",out, #PB_MessageRequester_Ok)
CompilerEndIf