PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Comparisons in mathematical simulations

https://www.purebasic.fr/english/viewtopic.php?t=81511

Page 2 of 5

Re: Comparisons in mathematical simulations

Posted: Sun Apr 30, 2023 10:45 pm
by idle
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!
Glad I could help.

Re: Comparisons in mathematical simulations

Posted: Wed May 10, 2023 12:06 am
by fvillanova
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

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

Posted: Wed May 10, 2023 12:37 am
by idle
The issue is that PB is reusing the string memory. if you pass the input sting in by value the problem will go away

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)
or alternative passing by reference with an additional cmp

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)

Re: Comparisons in mathematical simulations

Posted: Wed May 10, 2023 2:27 am
by fvillanova
idle wrote: Wed May 10, 2023 12:37 am
or alternative passing by reference with an additional cmp

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)
The example I created to explain the problem is very simple and by placing an alphanumeric string "bla bla bla" the error appears anyway
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

Posted: Wed May 10, 2023 3:33 am
by idle
fvillanova wrote: Wed May 10, 2023 2:27 am
idle wrote: Wed May 10, 2023 12:37 am
or alternative passing by reference with an additional cmp

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)
The example I created to explain the problem is very simple and by placing an alphanumeric string "bla bla bla" the error appears anyway
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
Your welcome and it was educational to me to discover pb reuses the string memory sometimes.

Re: Comparisons in mathematical simulations

Posted: Wed May 10, 2023 7:36 am
by wilbert
A slightly different approach ...

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
x64 ASM version

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

Re: Comparisons in mathematical simulations

Posted: Mon May 15, 2023 11:19 pm
by fvillanova
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:

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$
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.
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

Posted: Tue May 16, 2023 1:27 am
by idle
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

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

Posted: Tue May 16, 2023 1:36 am
by Demivec
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?
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.

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

Posted: Tue May 16, 2023 1:53 am
by Demivec
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.

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

Posted: Tue May 16, 2023 2:00 am
by idle
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

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

Posted: Tue May 16, 2023 2:09 am
by Demivec
idle wrote: Tue May 16, 2023 2:00 am 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
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

Posted: Tue May 16, 2023 2:26 am
by idle
Demivec wrote: Tue May 16, 2023 2:09 am
idle wrote: Tue May 16, 2023 2:00 am 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
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.
Yes he's asking the right question but is pointing to the wrong place to solve it.
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

Re: Comparisons in mathematical simulations

Posted: Tue May 16, 2023 4:58 am
by fvillanova
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:

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$
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:

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 appreciate any contribution to speeding up the CreateS() procedure.
I haven't been able to test other contributions that use the BitModule!
thanks

Re: Comparisons in mathematical simulations

Posted: Tue May 16, 2023 5:53 am
by idle
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

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)
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

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
All times are UTC+01:00
Page 2 of 5

Powered by phpBB® Forum Software © phpBB Limited