Idea or challenge ?!

[Lost Zergling]

It'll be like an enhancement idea or a challenge !
Can we imagine an instr instruction supporting input array as search string ?
Something like Instr(string, stringarray()) (could return the élément number)
The challenge would be to be significantly faster than a loop on each array élément which is using as instr calls as array ubound.
It's hard because instr is cached, so the loop is already pretty fast.

[paul doe]

InStr uses a fast algo called 'Boyer-Moore'. What you want (seeing if a given string is part of a set) can be easily solved by using a hash table (or a trie if you need partial results).

If what you want is the index, then:

• Sort the array of strings (lexicographical or whatever other order you choose)
• Use a binary search to match the index for the string you want

[Lost Zergling]

The idea would be to see if a value of a set is instr a given string.
(Not to optimise set seek standalone itself)
Theoritycally, a factorization of the string parse should be possible (same string on each itération)
The bigger the string the more the efficiency would be.
I imagine something like this :
Ind=instr(mainstring, stringarray ())
If ind<>0 then
If Instr(mainstring, stringarray (ind)) <>0 then...
Instead of :
For I=0 to ubound (stringarray)
If Instr(mainstring, stringarray (I) )<>0...

The use case is not a pure keyvalue speed but fast instr on a subset.
Ie full text search, signature scan..

[paul doe]

Well, shouldn't be that hard: reimplement Boyer-Moore to accept an array of strings, then as soon as a string is NOT matched, reset Boyer-Moore and just check the next string. Return the first match (or none if there wasn't any).

But I'm willing to bet that the speed difference with just iteraring the array and call inStr on each element will be negligible...

[dodicat]

I made a Tally sub a while back.
i.e. get the positions of all substrings in a string.

Code: Select all

#cmdline "-gen gcc -Wc -O2"
Function tally (somestring As String,partstring As String,arr() As Long) As Ulong
    Redim arr(1 To 1000)
    Dim As Long i,j,ln,lnp,count
    ln=Len(somestring)
    lnp=Len(partstring)
    count=0
    i=-1
    Do
        i+=1
        If somestring[i] <> partstring[0] Then Goto skip
        If somestring[i] = partstring[0] Then
            For j=0 To lnp-1
                If somestring[j+i]<>partstring[j] Then Goto skip
            Next j
        End If
        count+=1
        If count>Ubound(arr) Then Redim Preserve arr(Lbound(arr) To count+count)
        arr(count)=i+1
        i=i+lnp-1
        skip:
    Loop Until i>=ln-1
    Redim Preserve arr(1 To count)
    Return count
End Function

dim as string s=string(100000000,0)
'65 to 90 for capitals 
 #define Irange(f,l) Int(Rnd*((l+1)-(f)))+(f)
for n as long=0 to len(s)-1
    s[n]=Irange(65,90)
next
s="ABCDEF"+s
s+="ABCDEF"
redim as long g()
dim as double t=timer
tally(s,"ABCDEF",g())
print "position","check ABCDEF plus 4 others if applicable"
for n as long=lbound(g) to ubound(g)
    print g(n),mid(s,g(n),10)
next
print
print "length of string ";len(s),", time taken "; timer-t

sleep 

[Jattenalle]

I made a Tally sub a while back.
i.e. get the positions of all substrings in a string.

Code: Select all

#cmdline "-gen gcc -Wc -O2"
Function tally (somestring As String,partstring As String,arr() As Long) As Ulong
    Redim arr(1 To 1000)
    Dim As Long i,j,ln,lnp,count
    ln=Len(somestring)
    lnp=Len(partstring)
    count=0
    i=-1
    Do
        i+=1
        If somestring[i] <> partstring[0] Then Goto skip
        If somestring[i] = partstring[0] Then
            For j=0 To lnp-1
                If somestring[j+i]<>partstring[j] Then Goto skip
            Next j
        End If
        count+=1
        If count>Ubound(arr) Then Redim Preserve arr(Lbound(arr) To count+count)
        arr(count)=i+1
        i=i+lnp-1
        skip:
    Loop Until i>=ln-1
    Redim Preserve arr(1 To count)
    Return count
End Function

dim as string s=string(100000000,0)
'65 to 90 for capitals 
 #define Irange(f,l) Int(Rnd*((l+1)-(f)))+(f)
for n as long=0 to len(s)-1
    s[n]=Irange(65,90)
next
s="ABCDEF"+s
s+="ABCDEF"
redim as long g()
dim as double t=timer
tally(s,"ABCDEF",g())
print "position","check ABCDEF plus 4 others if applicable"
for n as long=lbound(g) to ubound(g)
    print g(n),mid(s,g(n),10)
next
print
print "length of string ";len(s),", time taken "; timer-t

sleep 

No need to overcomplicate things, instr is plenty fast:

Code: Select all

#cmdline "-gen gcc -Wc -O2"
function tallyinstr (somestring as const string, partstring as const string, arr() as long) as integer
	'// Doesn't waste memory, doesn't initially redim 'arr', respects lbound
	dim as integer		count		=	0
	dim as integer		offset		=	1
	dim as integer		hit			=	instr(offset, somestring, partstring)
	do while hit
		if ubound(arr) < lbound(arr) + count then
			redim preserve arr(lbound(arr) + count)
		end if
		arr(lbound(arr) + count)	=	hit
		count			+=	1
		offset			=	hit + len(partstring)
		hit				=	instr(offset, somestring, partstring)
	loop
	return count
end function


'// Unaltered dodicat code
dim as string s=string(100000000,0)
'65 to 90 for capitals 
 #define Irange(f,l) Int(Rnd*((l+1)-(f)))+(f)
for n as long=0 to len(s)-1
    s[n]=Irange(65,90)
next
s="ABCDEF"+s
s+="ABCDEF"
redim as long g()
dim as double t=timer
tallyinstr(s,"ABCDEF",g())
print "position","check ABCDEF plus 4 others if applicable"
for n as long=lbound(g) to ubound(g)
    print g(n),mid(s,g(n),10)
next
print
print "length of string ";len(s),", time taken "; timer-t

sleep 

Results
Dodicat's implementation: time taken 0.0838382001966238
Just FB instr: time taken 0.076859500259161

[SARG]

There could be an issue with value of index. What value indicates not found ?

I did that (I guess enough faster as Paul Doe said) :

Code: Select all

function instr_array(arr() as string,strg as string)as Integer
	for idx as Integer=lbound(arr) to ubound(arr)
		if instr(arr(idx),strg) then
			return idx
		End If
	Next
	''returning a value that could not be in the range
	''could also be ubound + 1
	#ifdef __FB_64BIT__ 
		return &h8FFFFFFFFFFFFFFF
	#else
		return &h8FFFFFFF
	#endif
End Function

dim as string larr(200)={"","","","zztdest"}

print instr_array(larr(),"zztest")

larr(200)="test"
print instr_array(larr(),"test")

Working on a version if multidim.

[dodicat]

Thanks Jattenalle.
Say just look for A, then taking a gunk of memory and redim preserve when necessary is faster than redim preserve each time.
But I agree, instr is plenty fast for most things.

[Lost Zergling]

Thank you everybody.

[Jattenalle]

Thanks Jattenalle.
Say just look for A, then taking a gunk of memory and redim preserve when necessary is faster than redim preserve each time.
But I agree, instr is plenty fast for most things.

Since mine preserves the array you can set the size before passing it. So replacing the

Code: Select all

redim as long g()

with

Code: Select all

redim as long g(999)

would work fine for my method, only growing the array if the 1000 indexes are filled.
Other than that, the number of hits will generally be so low that growing the array larger than needed won't really provide any tangible performance benefit.
e.g. If you're expecting tens of thousands of matches, you should really look for a different approach

[SARG]

Multi dim (only 2 but easily extended to 8.

Index () returns the indexes for all dims and can be used to start at any wanted indexes (by default zero).

Code: Select all

function instr_array(index() as integer,arr() as string,strg as string)as integer
	dim ldim as integer = UBound( arr , 0 )
	if ldim=0 then 	
		return 0
	else
		if ldim=1 then 'dim=1
			if index(1)<lbound(arr) then
				return 0
			End If
			for idx as Integer=index(1) to ubound(arr)
				if instr(arr(idx),strg) then
					index(0)=-1
					index(1)=idx
					return -1
				End If
			Next
		else 'dim=2
			if index(1)<lbound(arr,1) orelse index(2)<lbound(arr,2) then
				return 0
			End If
			for idx1 as Integer=index(1) to ubound(arr,1)
				for idx2 as Integer=index(2) to ubound(arr,2)
					if instr(arr(idx1,idx2),strg) then
						index(0)=-1
						index(1)=idx1
						index(2)=idx2
						return -1
					End If
				Next
			next
		end if
	End If
	return 0
End function

dim as integer index(8)

dim as string larr(200)={"","","","zztdest"}
if instr_array(index(),larr(),"zztest") then
	print "found=";index(1)
else
	print "not found"
end if

larr(200)="test"
if instr_array(index(),larr(),"test") then
	print "found=";index(1)
else
	print "not found"
end if

dim as string larr2(200,20)
larr2(100,15)="zsx"
larr2(150,19)="zsx"
index(1)=0
index(2)=0
if instr_array(index(),larr2(),"zsx") then
	print "found=";index(1),index(2)
else
	print "not found"
end if

index(2)+=1
if instr_array(index(),larr2(),"zsx") then
	print "found=";index(1),index(2)
else
	print "not found"
end if

[Lost Zergling]

I'm sharing this one, (using lzle,.. )
Of course might not be optimal ! or very very slow
expected usage : left join FT search (lots of values)

Code: Select all

#Include once "D:\Basic\LZLE_.bi"  
' WITH CONST MAX_ASIDE=200

Function InstrMulti(Str_Input As String, ListeQC As List, uBStopFirstFound As uByte=0) As String
    Dim As uInteger uInt_InputLen = Len(Str_Input), i, u
    If uInt_InputLen>200 Then : uInt_InputLen=200 : End If
    Dim as zString Ptr z_Input=StrPtr(Str_Input)
    Dim As String Str_Result
    ListeQC.Root
    For i=1 to uInt_InputLen
        For u=1 to i
            ListeQC.Recover(u)
            If ListeQC.HasTag(Chr((*z_Input)[0])) Then            
                If ListeQC.Check Then  '? "Trouve=" & ListeQC.HashTag
                    Str_Result+=ListeQC.HashTag + ";"
                    u=i : If uBStopFirstFound=1 Then : Return Str_Result : End If
                Else
                    ListeQC.Down
                    ListeQC.Aside(u)               
                    While ListeQC.Up : Wend
                End If
            Else          
                While ListeQC.Up : Wend
                ListeQC.Aside(u) 
            End If
        Next u        
        z_Input+=1 ' ? Chr((*z_Input)[0])
    Next i    
    Return Str_Result
End Function

Dim ListeQC As List
Dim As string Str_Input = "poissonchatvirgulepointavionchienboiteordinateurimprimantesouris" 'Len Max=200
Dim As uInteger uInt_InputLen = Len(Str_Input), i, u
Dim as zString Ptr z_Input=StrPtr(Str_Input)
Dim As uByte uBStopFirstFound=0

ListeQC.HashTag("virgule")
ListeQC.HashTag("poissonchat")
ListeQC.HashTag("chienboite")
ListeQC.HashTag("Bar")
ListeQC.HashTag("ordi")
ListeQC.HashTag("imprimante")
ListeQC.HashTag("oisson")

' uBStopFirstFound=1
? "Result=" & InstrMulti(Str_Input, ListeQC, uBStopFirstFound)
? "ok" 
sleep
system

[Lost Zergling]

Reason : bug fixes & optimizations - Issue : can generate False positive (in sus a real detection), maybe a list trouble.
Requires new property :

Code: Select all

Declare Property AsideReset(by As Byte) As Byte
..
Property List.AsideReset(by As Byte) As Byte : Lcontext(by).pNode=0 : Return 1 : End Property

Code: Select all

#Include once "D:\Basic\LZLE_.bi"  
' WITH CONST MAX_ASIDE=201
Function InstrMulti(Str_Input As String, ListeQC As List, uBStopFirstFound As uByte=0) As String
    Dim As String Str_Result="", str_tmp
    Dim as zString Ptr z_Input=StrPtr(Str_Input)
    Dim As uInteger uInt_InputLen = Len(Str_Input), i, u     
    Dim As uByte ubRevocated(200)
    If uInt_InputLen>200 Then : uInt_InputLen=200 : End If
    For i=1 to uInt_InputLen : ListeQC.AsideReset(i) : Next i ' better than : For i=1 to uInt_InputLen : ListeQC.Aside(i) : Next i
    For i=1 to uInt_InputLen
        For u=1 to i
            If ubRevocated(u)=0 Then
                ListeQC.Recover(u)
                If ListeQC.HasTag(Chr((*z_Input)[0])) Then
                    If ListeQC.Check Then ' ? "Trouve=" & ListeQC.HashTag
                        str_tmp=ListeQC.HashTag + ";" 
                        If Instr(Str_Result, ";" + str_tmp)=0 Then : Str_Result+=str_tmp : End If
                        If ListeQC.Down Then : ListeQC.Aside(u) : Else : ubRevocated(u)=1 : End If 'u=i :
                        If uBStopFirstFound=1 Then : Return Str_Result : End If
                    Else
                        If ListeQC.Down Then : ListeQC.Aside(u) : Else : ubRevocated(u)=1 : End If  'u=i :
                        While ListeQC.Up : Wend
                    End If
                Else
                    While ListeQC.Up : Wend
                    ListeQC.Aside(u) 
                End If
            End If                            
        Next u   
        z_Input+=1 ' ? Chr((*z_Input)[0])
    Next i
    Return Str_Result
End Function

Dim ListeQC As List
Dim As string Str_Input = "poissonchatvirgulepointavionchienboiteordinateur7654imprimantesouris" 'Len Max=200
Dim As uByte uBStopFirstFound=0
Dim As Integer i

? "Loading values to FT search"
For i=500 to 1000000
    ListeQC.HashTag(str(i))
Next i
ListeQC.HashTag("virgule")
ListeQC.HashTag("poissonchat")
ListeQC.HashTag("chienboite")
ListeQC.HashTag("Bar")
ListeQC.HashTag("ordi")
ListeQC.HashTag("poiss")
ListeQC.HashTag("isso")
ListeQC.HashTag("imprimante")
ListeQC.HashTag("oisson")
ListeQC.HashTag("oissonch")
While ListeQC.Up : Wend : ListeQC.FastAside(1)
 ? "Loaded"
' uBStopFirstFound=1
dim as double t=timer

? "Result=" & InstrMulti(Str_Input, ListeQC, uBStopFirstFound)
? "Result=" & InstrMulti(Str_Input, ListeQC, uBStopFirstFound)
? timer-t
sleep : system

[Lost Zergling]

Ultimately, the result is below my expectations, but still interesting:
- The longer the string to be tested, the more the simple Instr loop gains the advantage.
- The larger the number of values ​​to be tested, the more the InstrMulti function gains the advantage.
InstrMulti is well suited for testing a large number of values ​​on short strings with limited size (<200 characters, +100,000 values ​​to be tested); in the case of iterating over a file, the gain is significant enough to justify InstrMulti.
Moreover, if we simply want to identify the strings that meet the condition, without finding all the keywords (uBStopFirstFound=1), a much more significant gain is likely.

On the other hand:
- The loop in the tree is far from optimal (but without using pointers)
- Stability is not guaranteed, and furthermore, there are duplicates, and false positives (related to the discrepancy between the tree traversal and the pointer status) must be eliminated by a consistency check loop at the end.

Code: Select all

#Include once "D:\Basic\LZLE_.bi"  
' WITH CONST MAX_ASIDE=201
Function InstrMulti(Str_Input As String, ListeQC As List, uBStopFirstFound As uByte=0) As String
    Dim As String Str_Result="" , str_tmp_1 , str_tmp_2
    Dim as zString Ptr z_Input=StrPtr(Str_Input)
    Dim As uInteger uInt_InputLen = Len(Str_Input), i, u
    Dim As uByte ubRevocated(200), uBsuccess
    If uInt_InputLen>200 Then : uInt_InputLen=200 : End If
    For i=1 to uInt_InputLen : ListeQC.AsideReset(i) : Next i ' better than : For i=1 to uInt_InputLen : ListeQC.Aside(i) : Next i
    For i=1 to uInt_InputLen
        ubRevocated(i)=0 : 
        For u=1 to i
            If ubRevocated(u)=0 Then
                If uBsuccess=1 Then : uBsuccess=0 : While ListeQC.Up : Wend
                Else 
                    ListeQC.Recover(u)
                    If ListeQC.HasTag(Chr((*z_Input)[0])) Then                        
                        If ListeQC.Check Then
                            If uBStopFirstFound=1 Then : Return ListeQC.HashTag : End If
                            If Instr(Str_Result, ";" + ListeQC.HashTag + ";" )=0 Then 
                              '  ? "Trouve=" & ListeQC.HashTag ' : sleep
                                Str_Result+=ListeQC.HashTag + ";"  
                                If ListeQC.Down Then : 
                                    ListeQC.Aside(u) : 
                                    While ListeQC.Up : Wend 
                                Else : ubRevocated(u)=1 : uBsuccess=1 : End If '
                            Else : While ListeQC.Up : Wend : 
                            End If
                        Else
                            If ListeQC.Down Then : ListeQC.Aside(u): Else :  ubRevocated(u)=1 : u=i : End If 
                            While ListeQC.Up : Wend : 
                        End If
                    Else                    
                        While ListeQC.Up : Wend
                        ListeQC.Aside(u) : 
                    End If
                End If
            End If
        Next u   
        z_Input+=1
    Next i
    u=1 : i=1
    While i<>0
        i = Instr( u, Str_Result, ";") : str_tmp_1 = Right(Left(Str_Result, i-1 ), i-u)
        u=i+1 : If Instr(Str_Input, str_tmp_1)<>0 Then : str_tmp_2+= str_tmp_1+";" : End If
    Wend    
    Return str_tmp_2
End Function 

Dim ListeQC As List
Dim As string Str_Input = "78poissonchat98virgulepointavionordinateurchienboite7654titiimprimantesourisKarabraxosDoctorRogerRabbitKarabraxosDoctorRogerRabbit" 'Len Max=200
Dim As string Str_Res_1, Str_Res_2
Dim As uByte uBStopFirstFound=0
Dim as double T1, T2
Dim As Integer i

ListeQC.HashTag("virgule")
ListeQC.HashTag("poissonchat")
ListeQC.HashTag("chienboite")
ListeQC.HashTag("Bar")
ListeQC.HashTag("ordi")
ListeQC.HashTag("poiss")
ListeQC.HashTag("isso")
ListeQC.HashTag("imprimante")
ListeQC.HashTag("oisson")
ListeQC.HashTag("oissonch")
ListeQC.HashTag("titi")

? "Loading values to FT search"
For i=500 to 500000
    ListeQC.HashTag(str(i)  )
Next i

While ListeQC.Up : Wend : ListeQC.FastAside(1)
 ? "Loaded"
' uBStopFirstFound=1
dim as double t=timer
Str_Res_1 = "Result=" & InstrMulti(Str_Input, ListeQC, uBStopFirstFound)

T1= timer-t : 
t=timer
For i=500 to 500000
    If Instr(Str_Input, str(i)) <>0 Then : Str_Res_2+=str(i)+";"  : End If
Next i
T2= timer-t

ListeQC.Root
While ListeQC.KeyStep
    If Cint(ListeQC.Tag)=0 Then
        If Instr(Str_Input, ListeQC.HashTag) <>0 Then : Str_Res_2+=ListeQC.HashTag+ ";"  : 
        End If
    End If    
Wend

? Str_Res_1
? "Result=" & Str_Res_2
? T1
? T2
? "InstrMulti Warp Factor=" & Cint(T2/T1)

sleep : system

[Lost Zergling]

Okay, so I finally have a more stable and cleaner version, I think:
- No more false positives to remove
- The Warp Factor goes from 20 to 200, thank you Geordi
- Sensitivity to the length of the input string is now favorable to InstrMulti, but the size is still limited (it would be necessary to create a reuse queue on the Aside pointers, with an index mapping table) (but ugh)
On the other hand, I'm noticing some strange behavior:
In the example, the value "7" is a duplicate, and the most obvious reason is the absence of a ";" at the beginning of the string. No problem, I replace Dim As String Str_Result="" with Dim As String Str_Result=";".
Well, well, I don't understand... really. I'm missing something. Or what ?
Overload at the Boyer-Moore antimatter collector?
[bug]Added : Missing values in some tests ![/bug]
Sounds like Len(Str_Input) should not be >140.. investigating ..

Code: Select all

#Include once "D:\Basic\LZLE_.bi"  
' WITH CONST MAX_ASIDE=201
Function InstrMulti(Str_Input As String, ListeQC As List, uBStopFirstFound As uByte=0) As String
    Dim As String Str_Result="" , str_tmp_1 , str_tmp_2
    Dim as zString Ptr z_Input=StrPtr(Str_Input)
    Dim As uInteger uInt_InputLen = Len(Str_Input), i, u
    Dim As uByte ubRevocated(200), uBsuccess
    If uInt_InputLen>200 Then : uInt_InputLen=200 : End If
    For i=1 to uInt_InputLen : ListeQC.AsideReset(i) : Next i ' better than : For i=1 to uInt_InputLen : ListeQC.Aside(i) : Next i
    For i=1 to uInt_InputLen
        ubRevocated(i)=0 : 
        For u=1 to i
            If ubRevocated(u)=0 Then
                If uBsuccess=1 Then : uBsuccess=0 : While ListeQC.Up : Wend
                Else 
                    ListeQC.Recover(u)
                    If ListeQC.HasTag(Chr((*z_Input)[0])) Then                        
                        If ListeQC.Check Then
                            If uBStopFirstFound=1 Then : Return ListeQC.HashTag : End If
                            If Instr(Str_Result, ";" + ListeQC.HashTag + ";" )=0 Then ' : ? "Trouve=" & ListeQC.HashTag ' : sleep
                                Str_Result+=ListeQC.HashTag + ";"  
                                If ListeQC.Down Then : ListeQC.Aside(u) : While ListeQC.Up : Wend 
                                Else : ubRevocated(u)=1 : uBsuccess=1 : End If
                            Else : While ListeQC.Up : Wend : u=i
                            End If
                        Else
                            If ListeQC.Down Then : ListeQC.Aside(u) : Else :  ubRevocated(u)=1 : u=i : End If 
                            While ListeQC.Up : Wend
                        End If
                    Else : ubRevocated(u)=1 : While ListeQC.Up : Wend : ListeQC.Aside(u)
                    End If
                End If
            End If
        Next u   
        z_Input+=1
    Next i 
    Return Str_Result
End Function 

Dim ListeQC As List
Dim As string Str_Input = "78poissonchat98virgulepointavionordinateurchienboite7654titiimprimantesourisAzertyuiopqsdfghjklmwxcvbn" 'Len Max=200
Dim As string Str_Res_1, Str_Res_2
Dim As uByte uBStopFirstFound=0
Dim as double T1, T2
Dim As Integer i

ListeQC.HashTag("virgule")
ListeQC.HashTag("poissonchat")
ListeQC.HashTag("chienboite")
ListeQC.HashTag("Bar")
ListeQC.HashTag("ordi")
ListeQC.HashTag("poiss")
ListeQC.HashTag("isso")
ListeQC.HashTag("imprimante")
ListeQC.HashTag("oisson")
ListeQC.HashTag("oissonch")
ListeQC.HashTag("titi")

? "Loading values to FT search"
For i=5 to 100000
    ListeQC.HashTag(str(i)  )
Next i

While ListeQC.Up : Wend : ListeQC.FastAside(1)
 ? "Loaded"
' uBStopFirstFound=1
dim as double t=timer
Str_Res_1 = "Result=" & InstrMulti(Str_Input, ListeQC, uBStopFirstFound)

T1= timer-t : 
t=timer
For i=5 to 100000
    If Instr(Str_Input, str(i)) <>0 Then : Str_Res_2+=str(i)+";"  : End If
Next i
T2= timer-t

ListeQC.Root
While ListeQC.KeyStep
    If Cint(ListeQC.Tag)=0 Then
        If Instr(Str_Input, ListeQC.HashTag) <>0 Then : Str_Res_2+=ListeQC.HashTag+ ";"  : 
        End If
    End If    
Wend

? Str_Res_1
? "Result=" & Str_Res_2
? T1
? T2
? "InstrMulti Warp Factor=" & Cint(T2/T1)

sleep : system

EDITED : reason : bugs. New release, long strings support. limitation : Keywords len shall be <50 char

Code: Select all

#Include once "D:\Basic\LZLE_.bi"  
' WITH CONST MAX_ASIDE=100
Function InstrMulti(Str_Input As String, ListeQC As List, uBStopFirstFound As uByte=0) As String
    Dim As String Str_Result=""  , str_tmp_1 
    Dim as zString Ptr z_Input
    Dim As uInteger uInt_InputLen, i, u, t
    Dim As uByte ubRevocated(100), uBsuccess
    While ListeQC.Up : Wend
    For t=1 to Len(Str_Input) step 50        
        str_tmp_1= Mid(Str_Input, t, 100)
        uInt_InputLen=Len(str_tmp_1)
        z_Input= StrPtr(str_tmp_1)
        For i=1 to uInt_InputLen
            ubRevocated(i)=0
            For u=1 to i
                If ubRevocated(u)=0 Then : If uBsuccess=1 Then : uBsuccess=0 : While ListeQC.Up : Wend
                    Else
                        ListeQC.Recover(u)
                        If ListeQC.HasTag(Chr((*z_Input)[0])) Then                        
                            If ListeQC.Check Then
                                If uBStopFirstFound=1 Then : Return ListeQC.HashTag : End If
                                If Instr(Str_Result, ";" + ListeQC.HashTag + ";" )=0 Then
                                    Str_Result+=ListeQC.HashTag + ";"  
                                    If ListeQC.Down Then : ListeQC.Aside(u) : While ListeQC.Up : Wend 
                                    Else : ubRevocated(u)=1 : uBsuccess=1 : End If 
                                Else : While ListeQC.Up : Wend : u=i
                                End If
                            Else
                                If ListeQC.Down Then : ListeQC.Aside(u) : Else :  ubRevocated(u)=1 : End If 
                                While ListeQC.Up : Wend
                            End If
                        Else : ubRevocated(u)=1 : While ListeQC.Up : Wend : ListeQC.Aside(u)
                        End If
                    End If
                End If
            Next u
            z_Input+=1
        Next i 
    Next t
    Return Str_Result
End Function 

Dim ListeQC As List
Dim As string Str_Input = "78poissonchatTGHVBNI98virgulepointavionordinateurchienboite7654titiimprimantesourisAzertyuiopqsdfghjklmwxcvbn" 'Len Max=200
'Dim As string Str_Input = "*NePYT98qsazerfdcxwAzertyuiopAzertylmwxcvbnAzertyuiopqsdfghjklmwxcvbnpoissonchatvirgulepointavionordinateurchienboite7654titiZimprimantesouris"
'Dim As string Str_Input = "GTCCYCTRCTTXTXTRCTTXTXTEXTRRCKYNRCTTXTXTEX7654TRRCKYNRCTTXTXTEXTRRCKYNRCTTXTXTEXTRRCKYNEXTRRCKYNI?INYDRESXeYTYOPNFGHFsourisAzertyREZAWTYTYUIOPMLPOUNBGNOFDH*NedfghjklmwxcvqsazerfdcxwAzertyuiopAzertylmwxcvbnAzertyuiopqsdfghjklmwxcvbnpoissonchat"
Dim As string Str_Res_1, Str_Res_2
Dim As uByte uBStopFirstFound=0
Dim as double T1, T2
Dim As Integer i

ListeQC.HashTag("virgule")
ListeQC.HashTag("poissonchatTGHVBNI")
ListeQC.HashTag("chienboite")
ListeQC.HashTag("Bar")
ListeQC.HashTag("ordi")
ListeQC.HashTag("poiss")
ListeQC.HashTag("isso")
ListeQC.HashTag("imprimante")
ListeQC.HashTag("oisson")
ListeQC.HashTag("oissonch")
ListeQC.HashTag("titi")

? "Loading values to FT search"
For i=5 to 100000
    ListeQC.HashTag(str(i)  )
Next i

While ListeQC.Up : Wend : ListeQC.FastAside(1)
 ? "Loaded"
' uBStopFirstFound=1
dim as double t=timer
Str_Res_1 = "Result=" & InstrMulti(Str_Input, ListeQC, uBStopFirstFound)

T1= timer-t : 
t=timer
For i=5 to 100000
    If Instr(Str_Input, str(i)) <>0 Then : Str_Res_2+=str(i)+";"  : End If
Next i
T2= timer-t

ListeQC.Root
While ListeQC.KeyStep
    If Cint(ListeQC.Tag)=0 Then
        If Instr(Str_Input, ListeQC.HashTag) <>0 Then : Str_Res_2+=ListeQC.HashTag+ ";"  : 
        End If
    End If    
Wend

? Str_Res_1
?  "Result=" & InstrMulti(Str_Input, ListeQC, uBStopFirstFound)
? "Result=" & Str_Res_2
? T1
? T2
? "InstrMulti Warp Factor=" & Cint(T2/T1)

sleep : system