RepeatChar() and RepeatString()

Share your advanced PureBasic knowledge/code with the community.
Little John
Addict
Addict
Posts: 4846
Joined: Thu Jun 07, 2007 3:25 pm
Location: Berlin, Germany

RepeatChar() and RepeatString()

Post by Little John »

Hi!

Sometimes I need to create a long string by repeating a particular shorter string n times.
That's why I wrote a function RepeatString(n, s$) for my private standard library.
When s$ only consists of 1 character, the new string can be created very quickly by (ab)using LSet(), so I wrote a special function RepeatChar(n, s$) for this.

The following code implemets speed tests. RepeatString1() is the fastest RepeatString version tested here.
Can anyone provide a cross-platform version that is even faster? :wink:

PS: I deliberately didn't write a version of RepeatString that uses ReplaceString() with #PB_String_InPlace, because Fred has removed that option in PureBasic 6.40.
 

Code: Select all

; PB 6.30 (x64)

CompilerIf #PB_Compiler_Debugger
   CompilerError "For speed testing, switch the debugger off"
CompilerEndIf

EnableExplicit


Macro RepeatChar (_count_, _char_=" ")
   ; This is *very* fast, but '_char_' can only contain
   ; 1 character (any following characters are ignored).
   
   LSet("", _count_, _char_)
EndMacro


Procedure.s RepeatString1 (count.i, text$)
   ; RepeatChar() is considerably faster, but this
   ; procedure can repeat more than 1 character.
   Protected _, numChars.i, stepp.i, *p, ret$
   
   If count < 0
      ProcedureReturn ""  ; error
   EndIf
   
   numChars = Len(text$)
   stepp = numChars * SizeOf(Character)
   ret$ = Space(count * numChars)
   
   *p = @ret$
   For _ = 1 To count
      PokeS(*p, text$)
      *p + stepp
   Next
   
   ProcedureReturn ret$
EndProcedure


Procedure.s RepeatString2 (count.i, text$)
   Protected numChars.i, ret$
   
   If count < 0
      ProcedureReturn ""  ; error
   EndIf
   
   numChars = Len(text$)
   ret$ = Space(count * numChars)
   ProcedureReturn ReplaceString(ret$, Space(numChars), text$)
EndProcedure


Procedure.s RepeatString3 (count.i, text$)
   Protected ret$
   
   If count < 0
      ProcedureReturn ""  ; error
   EndIf
   
   ret$ = Space(count)
   ProcedureReturn ReplaceString(ret$, " ", text$)
EndProcedure


Define r$, c$, s$
Define.i _, loops, n
Define.i t0, t1, t2, t3

loops = 20000

; -----------------------------------------------------------------------------

n = 40000
c$ = "x"

t0 = ElapsedMilliseconds()
For _ = 1 To loops
   r$ = RepeatChar(n, c$)
Next
t0 = ElapsedMilliseconds() - t0

t1 = ElapsedMilliseconds()
For _ = 1 To loops
   r$ = RepeatString1(n, c$)
Next
t1 = ElapsedMilliseconds() - t1

MessageRequester("Test #1: repeat 1 character",
                 "t0 = " + StrD(t0/1000, 1) + " sec." + #LF$ +    ; -> 0.2 sec.
                 "t1 = " + StrD(t1/1000, 1) + " sec.")            ; -> 3.0 sec.

; -----------------------------------------------------------------------------

n = 10000
s$ = "abcde"

t1 = ElapsedMilliseconds()
For _ = 1 To loops
   r$ = RepeatString1(n, s$)
Next
t1 = ElapsedMilliseconds() - t1

t2 = ElapsedMilliseconds()
For _ = 1 To loops
   r$ = RepeatString3(n, s$)
Next
t2 = ElapsedMilliseconds() - t2

t3 = ElapsedMilliseconds()
For _ = 1 To loops
   r$ = RepeatString2(n, s$)
Next
t3 = ElapsedMilliseconds() - t3

MessageRequester("Test #2: repeat " + Len(s$) + " characters",
                 "t1 = " + StrD(t1/1000, 1) + " sec." + #LF$ +    ; -> 2.0 sec.
                 "t2 = " + StrD(t2/1000, 1) + " sec." + #LF$ +    ; -> 2.4 sec.
                 "t3 = " + StrD(t3/1000, 1) + " sec.")            ; -> 3.9 sec.
User avatar
ChrisR
Addict
Addict
Posts: 1581
Joined: Sun Jan 08, 2017 10:27 pm
Location: France

Re: RepeatChar() and RepeatString()

Post by ChrisR »

Good, RepeatString1 can also be done this way, with less protected var and so with a tiny, very tiny gain

Code: Select all

 Procedure.s RepeatString1 (count.i, text$=" ")
   ; RepeatChar() is considerably faster, but this
   ; procedure can repeat more than 1 character.
   If count < 0
     ProcedureReturn ""  ; error
   EndIf
   
   Protected _, *p, ret$
   ret$ = Space(count * Len(text$))
   *p = @ret$
   For _ = 1 To count
     *p + PokeS(*p, text$)
   Next
   
   ProcedureReturn ret$
 EndProcedure
Little John
Addict
Addict
Posts: 4846
Joined: Thu Jun 07, 2007 3:25 pm
Location: Berlin, Germany

Re: RepeatChar() and RepeatString()

Post by Little John »

That's more elegant, thank you! :thumbsup:
AZJIO
Addict
Addict
Posts: 2259
Joined: Sun May 14, 2017 1:48 am

Re: RepeatChar() and RepeatString()

Post by AZJIO »

RepeatCharN
RepeatStrN

Code: Select all

EnableExplicit

Debug LSet("A",20,"A")

Procedure.s RepeatCharN(a.c, n)
    Protected *mem, Text$
    If a = 0 Or n = 0
        ProcedureReturn ""
    EndIf
    *mem = AllocateMemory((n + 1) * 2)
    If *mem
        FillMemory(*mem , n * 2, a, #PB_Unicode)
        Text$ = PeekS(*mem)
        FreeMemory(*mem)
    EndIf
    ProcedureReturn Text$
EndProcedure

Procedure.s RepeatCharN2(a.c, n)
    Protected *mem, i, Text$, *c.Character

    If a = 0 Or n = 0
        ProcedureReturn ""
    EndIf

    *mem = AllocateMemory((n + 1) * 2)
    If *mem
        *c.Character = *mem
        For i = 1 To n
            *c\c = a
            *c + SizeOf(Character)
        Next
        Text$ = PeekS(*mem)
        FreeMemory(*mem)
    EndIf

    ProcedureReturn Text$
EndProcedure

Debug RepeatCharN( 'ы', 5)
Debug RepeatCharN(65, 8)
Debug RepeatCharN(Asc("ъ"), 3)
Debug RepeatCharN( '0', 7) + "1"

Code: Select all

EnableExplicit

Procedure.s RepeatStrN(str$, n)
    Protected *mem, *pos, i, Text$, Length
    Length = StringByteLength(str$, #PB_Unicode)
    If Length = 0 Or n = 0
        ProcedureReturn ""
    EndIf
    *mem = AllocateMemory(n * Length + 2, #PB_Memory_NoClear)
    If *mem
        *pos = *mem
        For i = 1 To n
            PokeS(*pos, str$, Length, #PB_String_NoZero | #PB_Unicode)
            *pos + Length
        Next
        PokeC(*pos , 0)
        Text$ = PeekS(*mem, -1, #PB_Unicode)
        FreeMemory(*mem)
    EndIf
    ProcedureReturn Text$
EndProcedure

Debug RepeatStrN( "_1_2", 5)
Post Reply