Posts: 424
Threads: 41
Joined: Jul 2022
Reputation:
41
Hi
thanks to Steve I can post this here because I have a STRING$ function that fills fastly a string with a pattern but I have missed the thread about String concatenation and MID$ way String concatenation thread.
By the way in a speed test this function is faster than MID$ way!
So I share it here.
Code: (Select All)
Dim As Long Scr
Scr = _NewImage(800, 600, 32)
Screen Scr
_ControlChr Off
_Title "FillString: a new STRING$"
Cls , _RGB32(33, 172, 172)
Locate 2, 1: Print "Starting Test :"
S$ = Chr$(0) + Chr$(255) + Chr$(255) + Chr$(255) ' Substring
Fs$ = "" ' FinalString
Size = 800 * 600 * 4 '1.920.000
Print "Fillstring concatenation with 2*n formula"
t1# = Timer(0.001)
Print FillString(Size, S$, Fs$), Size, Len(Fs$)
t2# = Timer(0.001)
Print " Fillstring with MID$"
Fs$ = "" ' FinalString
t3# = Timer(0.001)
Print FillString2(Size, S$, Fs$), Size, Len(Fs$)
t4# = Timer(0.001)
Print "Fillstring concatenation with n+n formula"
Fs$ = "" ' FinalString
t5# = Timer(0.001)
Print SlowFillString(Size, S$, Fs$), Size, Len(Fs$)
t6# = Timer(0.001)
Locate 10, 1
Print Using " Tempo & #.#### #.#### #.#### "; "String = String + String "; (t2# - t1#); t1#; t2#
Print Using " Tempo & #.#### #.#### #.#### "; "MID$ way "; t4# - t3#; t3#; t4#
Print Using " Tempo & #.#### #.#### #.#### "; "String = String + Pattern "; t6# - t5#; t5#; t6#
End
Function FillString (Size As Long, Bases As String, S As String)
FillString = 0
S = Bases
Do
S = S + S
Loop Until Len(S) > Size
S = Left$(S, Size)
FillString = -1
End Function
Function FillString2 (Size As Long, Bases As String, S As String)
FillString2 = 0
Dim posi As Long
S = Space$(Size)
posi = 0
Do
Mid$(S, posi, 4) = Bases
posi = posi + 4
Loop Until posi > Size
S = Left$(S, Size)
FillString2 = -1
End Function
Function SlowFillString (Size As Long, Bases As String, S As String)
SlowFillString = 0
Dim As Double Starts, Ends
Dim Counter As Long
Starts = Timer(.001)
Ends = 10#
Counter = 0
Do
Counter = Counter + 1
S = S + Bases
Loop Until Len(S) > Size Or (Timer(.001) - Starts >= Ends)
Print , Counter; " cycles", Len(S); " lenght of string vs max size"; Size
S = Left$(S, Size)
SlowFillString = -1
End Function
Wellcome feedbacks and improvements of FillString or STRING$pattern (what name is more explicative?),
maybe any other friend of QB64pe wants share something better for performance and or algorythm.
In the other thread there is the screenshot with comparisons and a graphic explanation of why it works well.
Posts: 3,001
Threads: 356
Joined: Apr 2022
Reputation:
279
05-06-2025, 09:05 AM
(This post was last modified: 05-06-2025, 09:08 AM by SMcNeill.)
And here's an addition to your code, and proof that some of your routines need a wee bit of tweaking to work 100% properly:
Code: (Select All)
Dim Returns(10) As String
Dim As Long Scr
Scr = _NewImage(800, 600, 32)
Screen Scr
_ControlChr Off
_Title "FillString: a new STRING$"
Cls , _RGB32(33, 172, 172)
Locate 2, 1: Print "Starting Test :"
S$ = "1234" ' Substring
Size = 800 * 600 * 40 '1.920.000 (Increased by 10 times more by Steve for better results)
Print "Fillstring concatenation with 2*n formula"
t1# = Timer(0.001)
Print FillString(Size, S$, Returns(1)), Size, Len(Returns(1))
t2# = Timer(0.001)
Print " Fillstring with MID$"
Fs$ = "" ' FinalString
t3# = Timer(0.001)
Print FillString2(Size, S$, Returns(2)), Size, Len(Returns(2))
t4# = Timer(0.001)
Print "Fillstring concatenation with n+n formula"
Fs$ = "" ' FinalString
t5# = Timer(0.001)
Print SlowFillString(Size, S$, Returns(3)), Size, Len(Returns(3))
t6# = Timer(0.001)
Print "Fillstring concatenation with STRING$ formula"
t7# = Timer(0.001)
Print FString(Size, S$, Returns(4)), Size, Len(Returns(4))
t8# = Timer(0.001)
Print
Print
Print Using " Tempo & ###.#### ######.#### ######.#### "; "String = String + String "; (t2# - t1#); t1#; t2#
Print Using " Tempo & ###.#### ######.#### ######.#### "; "MID$ way "; t4# - t3#; t3#; t4#
Print Using " Tempo & ###.#### ######.#### ######.#### "; "String = String + Pattern "; t6# - t5#; t5#; t6#
Print Using " Steve & ###.#### ######.#### ######.#### "; "String$ Fill Method "; t8# - t7#; t7#; t8#
Print
Print
For i = 1 To 4
Print Left$(Returns(i), 50)
Next
For i = 1 To 4
If i = 3 Then _Continue
For j = i + 1 To 4
If j = 3 Then _Continue 'we know method 3 doesn't match as the fill lengths don't match
If Returns(i) <> Returns(j) Then
Print Using "Method # does not match results of method #"; i, j
broken = -1
End If
Next
Next
If Not broken Then Print "All Methods produce the same string."
End
Function FString (Size, bases As String, S As String)
$Checking:Off
Dim m As _MEM: m = _MemNew(Size)
_MemFill m, m.OFFSET, Size, bases
S = Space$(Size)
_MemGet m, m.OFFSET, S
_MemFree m
$Checking:On
End Function
Function FillString (Size As Long, Bases As String, S As String)
FillString = 0
S = Bases
Do
S = S + S
Loop Until Len(S) > Size
S = Left$(S, Size)
FillString = -1
End Function
Function FillString2 (Size As Long, Bases As String, S As String)
FillString2 = 0
Dim posi As Long
S = Space$(Size)
posi = 0
Do
Mid$(S, posi, 4) = Bases
posi = posi + 4
Loop Until posi > Size
S = Left$(S, Size)
FillString2 = -1
End Function
Function SlowFillString (Size As Long, Bases As String, S As String)
SlowFillString = 0
Dim As Double Starts, Ends
Dim Counter As Long
Starts = Timer(.001)
Ends = 10#
Counter = 0
Do
Counter = Counter + 1
S = S + Bases
Loop Until Len(S) > Size Or (Timer(.001) - Starts >= Ends)
Print , Counter; " cycles", Len(S); " lenght of string vs max size"; Size
S = Left$(S, Size)
SlowFillString = -1
End Function
Whoops... I forgot my return value of -1 in the FSTRING function. You might want to update that for consistency. LOL!
Posts: 3,001
Threads: 356
Joined: Apr 2022
Reputation:
279
Glitch in your code is here:
Function FillString2 (Size As Long, Bases As String, S As String)
FillString2 = 0
Dim posi As Long
S = Space$(Size)
posi = 0
Starting position should be 1, not 0. Change that and it should fix the issue with return strings not matching.
Posts: 3,001
Threads: 356
Joined: Apr 2022
Reputation:
279
And here's another version for testing. Note that this, on my PC at least, is now producing quicker times for the fill with MID$ than it is with _MEMFILL... but only by about 2 - 3 times faster!!
Code: (Select All)
Dim Returns(10) As String
Dim As Long Scr
Scr = _NewImage(800, 600, 32)
Screen Scr
_ControlChr Off
_Title "FillString: a new STRING$"
Cls , _RGB32(33, 172, 172)
Locate 2, 1: Print "Starting Test :"
S$ = "1234" ' Substring
Size = 800 * 600 * 40 '1.920.000 (Increased by 10 times more by Steve for better results)
Print "Fillstring concatenation with 2*n formula"
t1# = Timer(0.001)
Print FillString(Size, S$, Returns(1)), Size, Len(Returns(1))
t2# = Timer(0.001)
Print " Fillstring with MID$"
Fs$ = "" ' FinalString
t3# = Timer(0.001)
Print FillString2(Size, S$, Returns(2)), Size, Len(Returns(2))
t4# = Timer(0.001)
Print "Fillstring concatenation with n+n formula"
Fs$ = "" ' FinalString
t5# = Timer(0.001)
Print SlowFillString(Size, S$, Returns(3)), Size, Len(Returns(3))
t6# = Timer(0.001)
Print "Fillstring concatenation with STRING$ formula"
t7# = Timer(0.001)
Print FString(Size, S$, Returns(4)), Size, Len(Returns(4))
t8# = Timer(0.001)
Print
Print
Print Using " Tempo & ###.#### ######.#### ######.#### "; "String = String + String "; (t2# - t1#); t1#; t2#
Print Using " Steve & ###.#### ######.#### ######.#### "; "MID$ way "; t4# - t3#; t3#; t4#
Print Using " Tempo & ###.#### ######.#### ######.#### "; "String = String + Pattern "; t6# - t5#; t5#; t6#
Print Using " Steve & ###.#### ######.#### ######.#### "; "_MemFill Method "; t8# - t7#; t7#; t8#
Print
Print
For i = 1 To 4
Print Left$(Returns(i), 50)
Next
For i = 1 To 4
Print Right$(Returns(i), 50)
Next
For i = 1 To 4
If i = 3 Then _Continue
For j = i + 1 To 4
If j = 3 Then _Continue 'we know method 3 doesn't match as the fill lengths don't match
If Returns(i) <> Returns(j) Then
Print Using "Method # does not match results of method #"; i, j
broken = -1
End If
Next
Next
If Not broken Then Print "All Methods produce the same string."
End
Function FString (Size, bases As String, S As String)
$Checking:Off
Dim m As _MEM: m = _MemNew(Size)
_MemFill m, m.OFFSET, Size, bases
S = Space$(Size)
_MemGet m, m.OFFSET, S
_MemFree m
FString = -1
$Checking:On
End Function
Function FillString (Size As Long, Bases As String, S As String)
FillString = 0
S = Bases
Do
S = S + S
Loop Until Len(S) > Size
S = Left$(S, Size)
FillString = -1
End Function
Function FillString2 (Size As Long, Bases As String, S As String)
'Tempo's original routine modified by STEVE in an attempt to improve speeds.
'It worked a widdle bit. 
$Checking:Off
FillString2 = 0
Dim posi As Long
S = Space$(Size)
posi = 1
b$ = Bases
Do
count = count + 1
l = Len(b$)
Mid$(S, posi, l) = b$
posi = posi + l
If count Mod 10 = 0 Then b$ = Left$(S, posi - 1)
Loop Until posi > Size
S = Left$(S, Size)
FillString2 = -1
$Checking:On
End Function
Function SlowFillString (Size As Long, Bases As String, S As String)
SlowFillString = 0
Dim As Double Starts, Ends
Dim Counter As Long
Starts = Timer(.001)
Ends = 10#
Counter = 0
Do
Counter = Counter + 1
S = S + Bases
Loop Until Len(S) > Size Or (Timer(.001) - Starts >= Ends)
Print , Counter; " cycles", Len(S); " lenght of string vs max size"; Size
S = Left$(S, Size)
SlowFillString = -1
End Function
Give that a shot and see how it does on your machine for you.
Posts: 424
Threads: 41
Joined: Jul 2022
Reputation:
41
Hi Steve
thanks for feedbacks
1. needed correction of "posi" initialization
2. good examples of combination of two tips to get speeder code (Fillstring2 uses MID$ and $Checking OFF/ON while Fstring uses _MEM and $Checking OFF/ON)
3. remember me the existence of _MEMNEW and _MEMFILL
here the result on my machine of your code on the left and the weird result got using $ChekingOFF/ON in function FillString with String = String + String on the right...
![[Image: new-STRING-checking-OFF-effect.jpg]](https://i.ibb.co/9Hrjs9NG/new-STRING-checking-OFF-effect.jpg)
while for Fillstring2 (MID$ way) and Fstring (_MEM way) the $Checking off increases the speed, for FillString (String + String way) it works in opposite direction, the speed begins slower! LOL
4. Is it legal to use so speed in code?
Posts: 3,001
Threads: 356
Joined: Apr 2022
Reputation:
279
05-07-2025, 12:33 PM
(This post was last modified: 05-07-2025, 12:34 PM by SMcNeill.)
Code: (Select All)
Function FillString2 (Size As Long, Bases As String, S As String)
'Tempo's original routine modified by STEVE in an attempt to improve speeds.
'It worked a widdle bit.
$Checking:Off
FillString2 = 0
Dim posi As Long
S = Space$(Size)
posi = 1
b$ = Bases
Do
count = count + 1
l = Len(b$)
Mid$(S, posi, l) = b$
posi = posi + l
If count Mod 10 = 0 Then b$ = Left$(S, posi - 1)
Loop Until posi > Size
S = Left$(S, Size)
FillString2 = -1
$Checking:On
End Function
For anyone who hasn't looked closely at this topic, I'd suggest you guys take a moment to study the out of the box thinking that produced the masterpiece of speed above. Note that this little routine is even faster than _MEMFILL by about 200-300%!!
The trick here?
Mixing inefficiencies to try and minimize them as much as possible.
Adding strings to stings repeatedly is inefficient. Running loops a bazillion times is inefficient. So how do we try to speed this up and reduce the impact as much as possible on both?
We start out with a fill string of b$, which in this case is "1234".
After 10 passes, we redefine b$ to be the current string. "1234123412341234123412341234123412341234" We're now filling at 10 times the original rate. What would've taken us 100 passes to fill, we now do in 10.
And then, after 10 more passes, we redefine b$ again. It's now "1234" repeated 100 times. We're now filling at 100 times the original rate.
And then, after 10 more passes, we refine b$ again. It's now "1234" repeated 1000 times.
The amount of string addition that we're doing here is minimal, and the overall number of passes that we have to make to do the filling here has decreased exponentially.
You can play with the amount of loops where b$ redefines itself with changing this line:
If count Mod 10 = 0 Then b$ = Left$(S, posi - 1)
As is, it's running every 10th loop and redefining b$ to become the current string. Change that 10 to some other number and play around with how it affects performance. I just threw a few quick blips at it and tested values like 2, 10, 20... 10 seemed a sweet spot and faster than 2 or 20, but there may be another value that's even faster. The trick is to find the perfect point where the hit with sting addition doesn't exceed the number of repetitions needed for the string to fill.
It's an attempt to minimize the impact of both bottlenecks to performance, and I've got to say, I'm pretty dang happy with the results. Folks want to know how to maximize and improve speed all the time. It's little tricks like this, where you look to minimize known impacts (such as the slowness of repetitive string addition) and looping, to make things work as quickly as possible for you.
|