A small procedure asm

Bare metal programming in PureBasic, for experienced users
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3870
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Re: A small procedure asm

Post by wilbert »

idle wrote:yes I noticed that and haven't found a way to get around it using the static structure
I had thought it'd work using a static counter to set a node value but it hasn't.
All I can do is iterate back through the first string and reset the trie that way but then it takes ~10 seconds
I like the idea of a trie.
It allows to simply increase the value of a end node in case of duplicates so it will count the exact amount it occurs.
There are also no calls to external procedures required and it's very suitable to convert to assembler.
Windows (x64)
Raspberry Pi OS (Arm64)
User avatar
idle
Always Here
Always Here
Posts: 5018
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: A small procedure asm

Post by idle »

wilbert wrote:
idle wrote:yes I noticed that and haven't found a way to get around it using the static structure
I had thought it'd work using a static counter to set a node value but it hasn't.
All I can do is iterate back through the first string and reset the trie that way but then it takes ~10 seconds
I like the idea of a trie.
It allows to simply increase the value of a end node in case of duplicates so it will count the exact amount it occurs.
There are also no calls to external procedures required and it's very suitable to convert to assembler.
That was the idea but it didn't quite work out that way in my implementation.
Windows 11, Manjaro, Raspberry Pi OS
Image
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3870
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Re: A small procedure asm

Post by wilbert »

idle wrote:
wilbert wrote:
idle wrote:yes I noticed that and haven't found a way to get around it using the static structure
I had thought it'd work using a static counter to set a node value but it hasn't.
All I can do is iterate back through the first string and reset the trie that way but then it takes ~10 seconds
I like the idea of a trie.
It allows to simply increase the value of a end node in case of duplicates so it will count the exact amount it occurs.
There are also no calls to external procedures required and it's very suitable to convert to assembler.
That was the idea but it didn't quite work out that way in my implementation.
Unfortunately the PureBasic only version also still isn't working properly.
Try this

Code: Select all

string1.s ="01 02 03 04 05 06 07 08 09 10 11 12 13 14 15"
string2.s ="01 03 13"

result = grep(@string1,@string2)
MessageRequester("Result",Str(Result))

string1.s ="01 02 04 05 06 07 08 09 10 11 12 13 14 15"
string2.s ="01 03 13"

result = grep(@string1,@string2)
MessageRequester("Result",Str(Result))
The second time it should display 2 instead of 3 :(
Windows (x64)
Raspberry Pi OS (Arm64)
infratec
Always Here
Always Here
Posts: 6810
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: A small procedure asm

Post by infratec »

A bit of topic:
fvillanova wrote:I thought the "StringField" command within the "FindString" command would be compiled in an optimized and fast code, but I saw no!
This sentence is the reason why all the 'bad' comments are not bad, but necesarry.
You say that you 'saw no' what tells us that you don't know 100% what you are doing.

You don't think enough about.

What does StringField() :?:
It walks from the beginning through the string until it finds the X occurence of the divider.

And this happens for each step.

The replacement with PeekS() avoids that. It goes only forward inside of the string and has not to start from beginning.

You can not optimize StringField() it does for what it is designed and that as fast as possible.
But the programmer has to think about what he is doing.

Don't understand this wrong:
So it is not a 'bad' compiler, it is a 'bad' programmer.


I always tell the people that this is the reason why new programs always needs PCs of the overnext generation
to run at an good speed.
The programmers only click there solution together and don't think about what they are doing.
They are lucky that there solution works.

Bernd
User avatar
idle
Always Here
Always Here
Posts: 5018
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: A small procedure asm

Post by idle »

wilbert wrote: Unfortunately the PureBasic only version also still isn't working properly.
Try this

Code: Select all

string1.s ="01 02 03 04 05 06 07 08 09 10 11 12 13 14 15"
string2.s ="01 03 13"

result = grep(@string1,@string2)
MessageRequester("Result",Str(Result))

string1.s ="01 02 04 05 06 07 08 09 10 11 12 13 14 15"
string2.s ="01 03 13"

result = grep(@string1,@string2)
MessageRequester("Result",Str(Result))
The second time it should display 2 instead of 3 :(
I guess I've still got some flawed logic in the implementation. :(
Windows 11, Manjaro, Raspberry Pi OS
Image
User avatar
idle
Always Here
Always Here
Posts: 5018
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: A small procedure asm

Post by idle »

The problem was the node pool counter resetting, so it works as intended now
but it still needed a bounds check and a means to clear the trie of previous data
should it reach it's capacity.

Code: Select all

Structure char 
  c.c[0] 
EndStructure   

Structure Trinode
  node.i[255]
  value.i
EndStructure 

#TRIENODES = 64

Structure trie 
  t.Trinode[0]
EndStructure   

Global *root.Trie = AllocateMemory(SizeOf(TriNode)*#TRIENODES) 

Procedure grep(*s1.char,*s2.char)
  Protected a,ind,rep 
  Protected *current.Trinode 
  Static ct,grep_itr=1,size 
  
  lReset:
    
  While *s1\c[a] <> 0 
    *current = *root\t[0] 
     While *s1\c[a] > 32
      ind = *s1\c[a]
      If Not *current\node[ind] 
        ct+1
        If ct >= #TRIENODES * size
          size+1
          FreeMemory(*root)
          *root = AllocateMemory(size*#TRIENODES*SizeOf(Trinode)) 
          ct=0 
          a=0
          Goto lReset
        EndIf   
        *current\node[ind] = *root\t[ct]
       EndIf
      *current = *current\node[ind]
      a+1 
    Wend 
    *current\value = grep_itr
    a+1
  Wend   
  
  a=0
  While *s2\c[a] <> 0 
    *current = *root\t[0]  
    While *s2\c[a] > 32 
      ind = *s2\c[a]
      If Not *current\node[ind] 
        a+1
        Goto lNotFound
      Else 
        *current = *current\node[ind]
      EndIf
      a+1  
    Wend 
    If *current\value = grep_itr
      rep+1 
    EndIf  
    lNotFound:
    a+1
  Wend
  
  grep_itr + 1 
  
  ProcedureReturn rep 
  
EndProcedure   


string1.s ="01 02 03 04 05 06 07 08 09 10 11 12 13 14 15"
string2.s ="01 03 13"

result = grep(@string1,@string2)
MessageRequester("Result",Str(Result))

string1.s ="01 02 04 05 06 07 08 09 10 11 12 13 14 15"
string2.s ="01 03 13"

result = grep(@string1,@string2)
MessageRequester("Result",Str(Result))


string1.s="ac3 b9d45 b ks23 al97 ac5 al99 vs42159ssbpx"
string2.s ="b xl33 ac3 bxp12 ac5 ks27t2l9"

result = grep(@string1,@string2)
MessageRequester("Result",Str(Result))

Input1.s = "02 09 15 21 37 59 72 81"
Input2.s = "ac3 07 11 15 22 37 40"

t1 = ElapsedMilliseconds()
For i = 1 To 12000000
  Result = Grep(@Input1, @Input2)
Next
t2 = ElapsedMilliseconds()

MessageRequester("Result",Str(t2-t1) + " ms " + Str(Result))
Windows 11, Manjaro, Raspberry Pi OS
Image
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3870
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Re: A small procedure asm

Post by wilbert »

idle wrote:The problem was the node pool counter resetting, so it works as intended now
Yes, it works fine now. The only thing is that the benchmark is not reflecting a real world situation.
In it's current form the trie reuses existing pathways between different calls which is great since it means that the trie needs to be reset less often.
In this case however it means that with the 12000000 times loop, it will always use the same pathways and never has to reset itself.

Try this ...

Code: Select all

Input1.s = "0000000"
For j = 0 To 5
  Input1 + " 0000000"
Next
Input2.s = "ac3 07 11 15 22 37 40"

RandomSeed(0)
t1 = ElapsedMilliseconds()
For i = 1 To 100000
  For j = 0 To 6
    CompilerIf #PB_Compiler_Unicode
      PokeS(@Input1 + j << 4, Hex(Random($fffffff)), -1, #PB_String_NoZero)
    CompilerElse
      PokeS(@Input1 + j << 3, Hex(Random($fffffff)), -1, #PB_String_NoZero)
    CompilerEndIf
  Next
Next
t2 = ElapsedMilliseconds()
t0 = t2 - t1

RandomSeed(0)
t1 = ElapsedMilliseconds()
For i = 1 To 100000
  For j = 0 To 6
    CompilerIf #PB_Compiler_Unicode
      PokeS(@Input1 + j << 4, Hex(Random($fffffff)), -1, #PB_String_NoZero)
    CompilerElse
      PokeS(@Input1 + j << 3, Hex(Random($fffffff)), -1, #PB_String_NoZero)
    CompilerEndIf
  Next
  Result = Grep(@Input1, @Input2)
Next
t2 = ElapsedMilliseconds()

MessageRequester("Result",Str(t2-t1-t0) + " ms " + Str(Result) + #LF$ + "Trie size : "+MemorySize(*root))
It first times how long the random string generation takes so it can subtract that from the time the loop with Grep in it takes.
The string is longer in this case so timing isn't the most important issue. But after 100.000 calls, the trie already has grown to over 40 megabytes in size.
Windows (x64)
Raspberry Pi OS (Arm64)
User avatar
idle
Always Here
Always Here
Posts: 5018
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: A small procedure asm

Post by idle »

Doesn't look to good from that perspective, what do you suggest?
Windows 11, Manjaro, Raspberry Pi OS
Image
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3870
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Re: A small procedure asm

Post by wilbert »

idle wrote:Doesn't look to good from that perspective, what do you suggest?
I don't know what the best solution would be. Maybe the approach of your previous post.
http://www.purebasic.fr/english/viewtop ... 57#p464057
In this case you were parsing the first string a second time to clean up everything. In that form it didn't work but what might be a solution is to add a counter to each node and increment it each time the node is visited when the first string is parsed. That way you can decrement while cleaning up. This way it should be possible to clean up everything without leaving traces I guess :?
Windows (x64)
Raspberry Pi OS (Arm64)
User avatar
idle
Always Here
Always Here
Posts: 5018
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: A small procedure asm

Post by idle »

Yes that sounds like a reasonable idea. I'll have a go at it later today.
If I can find a nice quick way to clean it up I can then limit the growth to an acceptable level.
Windows 11, Manjaro, Raspberry Pi OS
Image
User avatar
idle
Always Here
Always Here
Posts: 5018
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: A small procedure asm

Post by idle »

Here's about as far as I can go with it at the moment, but then I'm thinking of extending it so it can return an array of matches
or an array of unique items, partial matches or use callbacks and process txt files but then it will change quite a bit.
Seems to be bug free now.

[edit] thanks wilbert for asm

Code: Select all

CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
  Macro rax : eax : EndMacro
  Macro rbx : ebx : EndMacro
  Macro rcx : ecx : EndMacro
  Macro rdx : edx : EndMacro
CompilerEndIf

Structure char 
  c.c[0] 
EndStructure   

Structure Trienode 
  node.l[256]
EndStructure 

#TRIENODES=32 

Structure trie 
  t.Trienode[0]
EndStructure   

Structure NodeAddress
  n.l[0]
EndStructure 

Global *root.Trie = AllocateMemory(#TRIENODES * SizeOf(Trienode)) 
Global *shadow.NodeAddress = AllocateMemory(#TRIENODES * SizeOf(long))

Procedure grep(*s1.char,*s2.char)
  EnableASM
  
  Protected.i result,a,ind,ct
  Static *current.Trienode
  Static TrieSize=#TRIENODES
   
  Repeat  
    *current = *root
    While *s1\c[a] > 32
      ind = *s1\c[a]
      If Not *current\node[ind] 
        If ct = Triesize-1
          Triesize + #TRIENODES
          *shadow = ReAllocateMemory(*shadow,Triesize * SizeOf(long))
          If Not *shadow 
            End   
          EndIf
          *shadow\n[ct] = @*current\node[ind] - *root 
          *root = ReAllocateMemory(*root,Triesize * SizeOf(Trienode)) 
          If Not *root 
            End 
          EndIf   
        Else   
          *shadow\n[ct] = @*current\node[ind] - *root   
        EndIf 
        ct+1
        ; *root\t[ct]\node[0] = 0
        mov rdx, *root
        mov rcx, ct
        shl rcx, 10     
        mov dword [rdx + rcx], 0
        ; *current\node[ind] = *root\t[ct] - *root
        mov rdx, *current
        mov rax, ind
        mov [rdx + rax * 4], ecx
        
      EndIf
      *current = *root + *current\node[ind] 
      a+1 
    Wend
    
    ; increase count
    mov rdx, *current
    inc dword [rdx]
    
    If *s1\c[a] = 0 
      Break 
    EndIf   
    a+1
  ForEver    
  
  a=0
  Repeat 
     *current = *root
      While *s2\c[a] > 32 
      If *current\node[*s2\c[a]]  
        *current = *root + *current\node[*s2\c[a]] 
        a+1  
      Else 
        mov rdx,*s2
        mov rcx, a
        !grep_skip_loop:
        inc rcx
        CompilerIf #PB_Compiler_Unicode
          !movzx eax, word [rdx + rcx * 2]
        CompilerElse
          !movzx eax, byte [rdx + rcx]
        CompilerEndIf
        !cmp eax, 32
        !ja grep_skip_loop
        mov a, rcx
        !jmp grep_not_found
      EndIf  
    Wend 
    
    ; add count to result if not 0
    mov rdx, *current
    mov eax, [rdx]
    test eax, eax
    !jz grep_not_found
    add result, rax
    
    !grep_not_found:
    If *s2\c[a] = 0 
      Break 
    EndIf   
    a+1
  ForEver
  
  ; use shadow to clear things up
  mov rdx, *root
  mov rax, *shadow
  mov rcx, ct
  push rbx
  !grep_clear_loop:
  mov ebx, [rax + rcx * 4 - 4]
  dec rcx
  mov dword [rdx + rbx], 0
  !jnz grep_clear_loop
  pop rbx
  
  DisableASM
  ProcedureReturn result
  
EndProcedure   


string1.s ="01 01 03 04 05 06 07 08 09 10 11 12 13 14 15"   ;4 
string2.s ="01 03 13"

result = Grep(@string1,@string2)
MessageRequester("Result",Str(Result))

string1.s ="01 02 04 05 06 07 08 09 10 11 12 13 14 15"      ;2 
string2.s ="01 03 10"

result = Grep(@string1,@string2)
MessageRequester("Result",Str(Result))


Input1.s=""
Input2.s = "ac3 07 11 15 22 37 40"

RandomSeed(1)
t1 = ElapsedMilliseconds()
For i = 1 To 100000
  For j = 0 To 5
    Input1 + Left(Hex(Random($fffffff,$1000000)), 7) + " "   
  Next
  Input1 + Left(Hex(Random($fffffff,$1000000)), 7) 
  Input1=""
Next
t2 = ElapsedMilliseconds()
t0 = t2 - t1
Input1=""

RandomSeed(1)
t1 = ElapsedMilliseconds()
For i = 1 To 100000
  For j = 0 To 5
    Input1 + Left(Hex(Random($fffffff,$1000000)), 7) + " "   
  Next
  Input1 + Left(Hex(Random($fffffff,$1000000)), 7) 
  Result = Grep(@Input1, @Input2)
  Input1=""
Next
t2 = ElapsedMilliseconds()

t = t2-t1-t0 

MessageRequester("Result",Str(t2-t1) + " ms " + Str(Result) + #LF$ + "Trie size : " + Str(MemorySize(*root)))

string1.s ="01 02 03 04 05 06 07 08 09 10 11 12 13 14 15"   ;3 
string2.s ="01 03 13"

result = Grep(@string1,@string2)
MessageRequester("Result",Str(Result))

string1.s ="01 02 04 05 06 07 08 09 10 11 12 13 14 15"      ;2 
string2.s ="01 03 10"

result = Grep(@string1,@string2)
MessageRequester("Result",Str(Result))

string1.s="ac3 b9d45 b ks23 al97 ac5 al99 vs42159ssbpx"     ;3    
string2.s ="b xl33 ac3 bxp12 ac5 ks27t2l9"

result = Grep(@string1,@string2)
MessageRequester("Result",Str(Result))

string1.s = "02 09 15 21 37 59 72 81"                        ;2 
string2.s = "07 11 15 22 37 40"
Result = Grep(@string1, @String2)
MessageRequester("Result",Str(Result))

t1 = ElapsedMilliseconds()
For i = 1 To 12000000      
  Result = Grep(@string1, @string2)
Next
t2 = ElapsedMilliseconds()

MessageRequester("Result",Str(t2-t1) + " ms " + Str(Result) + #LF$ + "Trie size : " + Str(MemorySize(*root)))
Windows 11, Manjaro, Raspberry Pi OS
Image
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3870
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Re: A small procedure asm

Post by wilbert »

This one is inspired on the trie Idle posted.
It should be faster compared to the code I previously posted.
There's no limit to the amount of elements inside a string and no limit to the length of an element.
When #ASCII_RANGE_ONLY is set to #False , it can handle unicode strings as well.

Code: Select all

DisableDebugger

#TRIENODES = 8192
#LAST_SEPARATION_CHAR = 32
#ASCII_RANGE_ONLY = #True

Structure GrepTrieNode 
  n.l[16]
  value.l
EndStructure 

Structure GrepTrie 
  t.GrepTrieNode[0]
EndStructure

#GREP_TRIENODE_SIZE = SizeOf(GrepTrieNode)

Global *GrepTrie.GrepTrie = AllocateMemory(#TRIENODES * #GREP_TRIENODE_SIZE) 

CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
  Macro rax : eax : EndMacro
  Macro rbx : ebx : EndMacro
  Macro rcx : ecx : EndMacro
  Macro rdx : edx : EndMacro
  Macro rsi : esi : EndMacro
  Macro rdi : edi : EndMacro  
CompilerEndIf

Macro M_Grep_GetNextChar()
  CompilerIf #PB_Compiler_Unicode
    movzx eax, word [rdx]
    add rdx, 2  
  CompilerElse
    movzx eax, byte [rdx]
    add rdx, 1
  CompilerEndIf
EndMacro

Macro M_Grep_String1(rolbits = 4)
  !rol ax, rolbits
  !mov ebx, eax
  !and ebx, 111100b
  !add ebx, esi
  mov esi, [rcx + rbx]
  !test esi, esi
  !jnz grep_string1_walk#MacroExpandedCount
  mov [rcx + rbx], edi
  !mov esi, edi
  add edi, #GREP_TRIENODE_SIZE
  !grep_string1_walk#MacroExpandedCount:
EndMacro

Macro M_Grep_String2(rolbits = 4)
  !rol ax, rolbits
  !mov ebx, eax
  !and ebx, 111100b
  !add ebx, esi
  mov esi, [rcx + rbx]
  !test esi, esi
  !jz grep_not_found
EndMacro

Procedure.i Grep(*String1.Character, *String2.Character)
  EnableASM
  
  Protected.i *t, result, reg_bx, reg_si, reg_di
  Protected.l n_cnt, n_cur, n_max = MemorySize(*GrepTrie)

  ; ** backup registers ***
  mov reg_bx, rbx
  mov reg_si, rsi
  mov reg_di, rdi
  
  ; ** process string1 **
  mov rcx, *GrepTrie                ; rcx = *GrepTrie
  mov rdx, *String1                 ; rdx = *String
  !xor esi, esi                     ; esi = n_cur
  mov edi, #GREP_TRIENODE_SIZE      ; edi = n_cnt
  !grep_string1_loop:
  M_Grep_GetNextChar()  
  cmp eax, #LAST_SEPARATION_CHAR
  !jna grep_string1_separ           ; if <= #LAST_SEPARATION_CHAR, goto grep_string1_separ
  lea ebx, [edi + 272]              ; 272 = 4 * #GREP_TRIENODE_SIZE
  cmp ebx, n_max
  !ja grep_resize_trie
  !grep_resize_continue:
  CompilerIf #PB_Compiler_Unicode And Not #ASCII_RANGE_ONLY
    M_Grep_String1(6)
    M_Grep_String1()
    M_Grep_String1()
  CompilerElse
    M_Grep_String1(14)
  CompilerEndIf
  M_Grep_String1()
  !jmp grep_string1_loop
  !grep_string1_separ:              ; increase node value
  inc dword [rcx + rsi + 64]        ; 64 = offset of value field
  !xor esi, esi  
  !grep1_skip_inc:
  !test eax, eax                    ; check for zero character
  !jnz grep_string1_loop
  mov [rcx + 64], eax               ; clear node 0 value 
  mov n_cnt, edi
  !jmp grep_string2
  
  ; resize trie
  !grep_resize_trie:
  mov *String1, rdx
  mov n_cur, esi
  mov n_cnt, edi
  mov result, rax
  *t = ReAllocateMemory(*GrepTrie, n_max + #TRIENODES * #GREP_TRIENODE_SIZE) 
  If *t
    *GrepTrie = *t
    n_max + #TRIENODES * #GREP_TRIENODE_SIZE
  Else
    result = -1
    Goto Grep_Clear
  EndIf
  mov rcx, *GrepTrie
  mov rdx, *String1
  mov esi, n_cur
  mov edi, n_cnt
  mov rax, result
  !jmp grep_resize_continue
  
  ; ** process string2 **
  !grep_string2:
  mov rdx, *String2                 ; rdx = *String2
  !xor esi, esi                     ; esi = n_cur
  !xor edi, edi                     ; edi = result
  !grep_string2_loop:
  M_Grep_GetNextChar()  
  cmp eax, #LAST_SEPARATION_CHAR
  !jna grep_string2_separ           ; if <= #LAST_SEPARATION_CHAR, goto grep_string2_separ
  CompilerIf #PB_Compiler_Unicode And Not #ASCII_RANGE_ONLY
    M_Grep_String2(6)
    M_Grep_String2()
    M_Grep_String2()
  CompilerElse
    M_Grep_String2(14)
  CompilerEndIf
  M_Grep_String2()
  !jmp grep_string2_loop
  !grep_not_found:                  ; if not found, skip characters
  M_Grep_GetNextChar()  
  cmp eax, #LAST_SEPARATION_CHAR
  !ja grep_not_found
  !xor esi, esi
  !test eax, eax                    ; check for zero character
  !jnz grep_string2_loop
  !jmp grep_string2_result  
  !grep_string2_separ:              ; add node value to result
  add edi, [rcx + rsi + 64]
  !xor esi, esi
  !test eax, eax                    ; check for zero character
  !jnz grep_string2_loop
  !grep_string2_result:
  mov result, rdi
  
  Grep_Clear:
  FillMemory(*GrepTrie, n_cnt)
  
  ; ** restore registers ***
  mov rbx, reg_bx
  mov rsi, reg_si
  mov rdi, reg_di
  
  ProcedureReturn result
  DisableASM
EndProcedure
Test code

Code: Select all

String1.s = "ac3 b9d45 b ks23 al97 ac5 al99 vs42159ssbpx"
String2.s = "b xl33 ac3 bxp12 ac5 ks27t2l9"

t1 = ElapsedMilliseconds()
For i = 1 To 12000000
  Result = Grep(@String1, @String2)
Next
t2 = ElapsedMilliseconds()

MessageRequester("Result (" + Str(t2-t1) + " ms)", Str(Result))
Windows (x64)
Raspberry Pi OS (Arm64)
fvillanova
User
User
Posts: 70
Joined: Wed May 02, 2012 2:17 am
Location: Brazil

Re: A small procedure asm

Post by fvillanova »

wilbert wrote:This one is inspired on the trie Idle posted.
It should be faster compared to the code I previously posted.
There's no limit to the amount of elements inside a string and no limit to the length of an element.
When #ASCII_RANGE_ONLY is set to #False , it can handle unicode strings as well.
You are the man! I will replace the last routine by this and see how it goes.
I've seen that was faster.
Thank you very much.
fvillanova
User
User
Posts: 70
Joined: Wed May 02, 2012 2:17 am
Location: Brazil

Re: A small procedure asm

Post by fvillanova »

wilbert wrote:This one is inspired on the trie Idle posted.
It should be faster compared to the code I previously posted.
There's no limit to the amount of elements inside a string and no limit to the length of an element.
When #ASCII_RANGE_ONLY is set to #False , it can handle unicode strings as well.
Hi Wilbert,
Within the calculation routines that I use in my programs are statistical distribution calculations where I need to make millions simulation with factors lexicographical, I do not know if you have seen this kind of calculation.
I am sending a sample below for you to understand:

Code: Select all

DisableDebugger
Global.i i,Result, time
Global.s aux
Global Dim da.s(99)

Procedure.d Factorial(N.i)
Protected E.d
E=1:For S=2 To N:E*S:Next
ProcedureReturn E
EndProcedure 

Procedure.d Combinations(n.i,k.i)
Protected calc.d  
  calc=Factorial(n)/((Factorial(n-k))*Factorial(k));
 ProcedureReturn calc
EndProcedure

Procedure.i Lexicographic_Order(cval.s,nval.i,kval.i)   
  Protected.i lval, p1val, ival, jval
  Protected.d rval
  Protected Dim c.i(kval), Dim numv.i(kval): c(0)=0
  For ival=0 To kval-1: numv(ival+1)=Val(PeekS(@cval + ival * 3, 2,#PB_Ascii)): Next
  p1val=kval-1  
  For ival=1 To p1val: c(ival)=0
    If ival<>1: c(ival)=c(ival-1): EndIf  
    Repeat
    c(ival)+1: rval=Combinations(nval-c(ival),kval-ival)  
    lval=lval+rval 
    Until c(ival)>=numv(ival)
    lval=lval-rval   
  Next
    lval=lval+numv(kval)-numv(p1val)
  ProcedureReturn lval
EndProcedure  

Procedure.s Elements_Return(nval.i,pval.i,lval.i)     
  Protected rval.d, p1val.d, kval.d, ival.i, Dim c.i(pval), cval.s, auxval.s 
  p1val=pval-1: c(1)=0
   For ival=1 To p1val: If ival<>1: c(ival)=c(ival-1): EndIf
    Repeat
      c(ival)+1: rval=Combinations(nval-c(ival),pval-ival)
      kval=kval+rval
    Until kval>=lval
      kval=kval-rval: cval=cval+auxval+da(c(ival)): auxval=" "
  Next
  c(pval)=c(pval-1)+lval-kval: cval=cval+auxval+da(c(pval)) 
  ProcedureReturn cval
EndProcedure  

For i=0 To 99:If i<10:da(i)="0"+Str(i):Else:da(i)=Str(i):EndIf: Next
time = ElapsedMilliseconds()
For i=1 To 2000000
  
  aux=Elements_Return(15,8,6387)    ; constructs the Elements of lexicographic order = 6387 
  Result=Lexicographic_Order("05 08 09 10 12 13 14 15",15,8) ; calculate lexicographic order from "05 08 09 10 12 13 14 15"
  
Next  
time = ElapsedMilliseconds()-time  

MessageRequester("Lexicographic Case:","Processed in "+Str(time)+" milliseconds"+Chr(13)+aux+Chr(13)+Str(Result),#PB_MessageRequester_Ok): End
There is a possibility to make a procedure "Lexicographic_Order" and "Elements_Return" in asm?
In order to accelerate the process.
In the above processing is being done in 7503 milliseconds here in my notebook.
But within my program it takes 7 minutes to process a complete statistical database with that work.
thanks
Fernando
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3870
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Re: A small procedure asm

Post by wilbert »

fvillanova wrote:Within the calculation routines that I use in my programs are statistical distribution calculations where I need to make millions simulation with factors lexicographical, I do not know if you have seen this kind of calculation.
No, haven't seen before :)
Haven't got a clue what is going on.
Is it some sort of sorting related thing ?

In the end everything can be translated to asm but the question is if it's worth it.
In this case the best thing you can do is try to speed up the Factorial and Combinations procedures to start with.
Is there a limit to the values passed to the Factorial and Combinations procedures ?
If there is and it isn't very big, you could use a lookup table for this. That would already result in a big speed improvement.
Windows (x64)
Raspberry Pi OS (Arm64)
Post Reply