Split String Algorithm for FreeBasic

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
fxm
Moderator
Posts: 12455
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Split String Algorithm for FreeBasic

Post by fxm »

Avata wrote: ↑Jan 03, 2025 1:47 Could you please help us get this function working for WString?

A test version of 'split()', but for Wstring:

Code: Select all

Sub split(Byref w1 As Wstring, Byref w2 As Wstring, splits(Any) As Wstring Ptr, byval skipEmptyElement As Integer = 0)
    Dim As Wstring Ptr p1 = @w1
    Dim As Integer l1 = Len(w1)
    Dim As Integer l2 = Len(w2)
    Dim As integer i = Ubound(splits) + 1
    Dim As Integer n, n0 = 1

    Redim Preserve splits(Lbound(splits) To i + l1 / l2)
    Do
        n = Instr(n0, w1, w2)
        If n > 0 Then
            If (skipEmptyElement = 0) Orelse (n - n0) > 0 Then
                Dim As Wstring Ptr p = p1 + n0 - 1
                Dim As Integer l = n - n0
                Dim As Wstring * 1 w
                splits(i) = Callocate((l + 1) * Sizeof(Wstring))
                Swap w[0], (*p)[l] 
                *splits(i) = *(p)
                Swap w[0], (*p)[l] 
                i += 1
            End If
            n0 = n + l2
        Else
            If (skipEmptyElement = 0) Orelse (l1 - n0 + 1) > 0 Then
                Dim As Wstring Ptr p = p1 + n0 - 1
                Dim As Integer l = l1 - n0 + 1
                splits(i) = Callocate((l + 1) * Sizeof(Wstring))
                *splits(i) = *(p)
            Else
                i -= 1
            End If
            Redim Preserve splits(Lbound(splits) To i)
            Exit Do
        End If
    Loop
End Sub

Dim As Wstring * 47 w1 = "reinvent the wheel in optimized pure FreeBASIC"
Dim As Wstring Ptr splits(Any)
split(w1, " ", splits())
Print "'" & w1 & "'"
Print
For i As Integer = 0 To Ubound(splits)
    Print i & " '" & *splits(i) & "'"
    Deallocate(splits(i))
Next i
Erase splits

Sleep

Code: Select all

'reinvent the wheel in optimized pure FreeBASIC'

0 'reinvent'
1 'the'
2 'wheel'
3 'in'
4 'optimized'
5 'pure'
6 'FreeBASIC'
Top
Avata
Posts: 117
Joined: Jan 17, 2021 7:27

Re: Split String Algorithm for FreeBasic

Post by Avata »

fxm wrote: ↑Jan 03, 2025 22:16
Avata wrote: ↑Jan 03, 2025 1:47 Could you please help us get this function working for WString?

A test version of 'split()', but for Wstring:

Code: Select all

Sub split(Byref w1 As Wstring, Byref w2 As Wstring, splits(Any) As Wstring Ptr, byval skipEmptyElement As Integer = 0)
    Dim As Wstring Ptr p1 = @w1
    Dim As Integer l1 = Len(w1)
    Dim As Integer l2 = Len(w2)
    Dim As integer i = Ubound(splits) + 1
    Dim As Integer n, n0 = 1

    Redim Preserve splits(Lbound(splits) To i + l1 / l2)
    Do
        n = Instr(n0, w1, w2)
        If n > 0 Then
            If (skipEmptyElement = 0) Orelse (n - n0) > 0 Then
                Dim As Wstring Ptr p = p1 + n0 - 1
                Dim As Integer l = n - n0
                Dim As Wstring * 1 w
                splits(i) = Callocate((l + 1) * Sizeof(Wstring))
                Swap w[0], (*p)[l] 
                *splits(i) = *(p)
                Swap w[0], (*p)[l] 
                i += 1
            End If
            n0 = n + l2
        Else
            If (skipEmptyElement = 0) Orelse (l1 - n0 + 1) > 0 Then
                Dim As Wstring Ptr p = p1 + n0 - 1
                Dim As Integer l = l1 - n0 + 1
                splits(i) = Callocate((l + 1) * Sizeof(Wstring))
                *splits(i) = *(p)
            Else
                i -= 1
            End If
            Redim Preserve splits(Lbound(splits) To i)
            Exit Do
        End If
    Loop
End Sub

Dim As Wstring * 47 w1 = "reinvent the wheel in optimized pure FreeBASIC"
Dim As Wstring Ptr splits(Any)
split(w1, " ", splits())
Print "'" & w1 & "'"
Print
For i As Integer = 0 To Ubound(splits)
    Print i & " '" & *splits(i) & "'"
    Deallocate(splits(i))
Next i
Erase splits

Sleep

Code: Select all

'reinvent the wheel in optimized pure FreeBASIC'

0 'reinvent'
1 'the'
2 'wheel'
3 'in'
4 'optimized'
5 'pure'
6 'FreeBASIC'
Thanks, FXM.
Top
fxm
Moderator
Posts: 12455
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Split String Algorithm for FreeBasic

Post by fxm »

Latest versions of split()

Two overloaded split() procedures, for compatibility with both string and wstring:
(tests added to avoid crash on empty string and 'skipEmptyElement' enabled, and on empty delimiter)

Code: Select all

Sub split Overload(Byref s1 As String, Byref s2 As String, splits(Any) As String, byval skipEmptyElement As Integer = 0)
    Dim As Any Ptr p1 = Cptr(Any Ptr Ptr, @S1)[0]
    Dim As Integer l1 = Cptr(Integer Ptr, @S1)[1]
    Dim As Integer l2 = Cptr(Integer Ptr, @s2)[1]
    If l2 = 0 Then l2 = 1
    Dim As integer i = Ubound(splits) + 1
    Dim As Integer n, n0 = 1

    Redim Preserve splits(Lbound(splits) To i + l1 / l2)
    Do
        n = Instr(n0, s1, s2)
        If n > 0 Then
            If (skipEmptyElement = 0) Orelse (n - n0) > 0 Then
                Cptr(Any Ptr Ptr, @S1)[0] = p1 + n0 - 1
                Cptr(Integer Ptr, @S1)[1] = n - n0
                splits(i) = s1
                Cptr(Any Ptr Ptr, @S1)[0] = p1
                Cptr(Integer Ptr, @S1)[1] = l1
                i += 1
            End If
            n0 = n + l2
        Else
            If (skipEmptyElement = 0) Orelse (l1 - n0 + 1) > 0 Then
                Cptr(Any Ptr Ptr, @S1)[0] = p1 + n0 - 1
                Cptr(Integer Ptr, @S1)[1] = l1 - n0 + 1
                splits(i) = s1
                Cptr(Any Ptr Ptr, @S1)[0] = p1
                Cptr(Integer Ptr, @S1)[1] = l1
            Else
                i -= 1
            End If
            If i >= Lbound(splits) Then
                Redim Preserve splits(Lbound(splits) To i)
            Else
                Erase splits
            End If
            Exit Do
        End If
    Loop
End Sub

Sub split Overload(Byref w1 As Wstring, Byref w2 As Wstring, splitsPtr(Any) As Wstring Ptr, byval skipEmptyElement As Integer = 0)
    Dim As Wstring Ptr p1 = @w1
    Dim As Integer l1 = Len(w1)
    Dim As Integer l2 = Len(w2)
    If l2 = 0 Then l2 = 1
    Dim As integer i = Ubound(splitsPtr) + 1
    Dim As Integer n, n0 = 1

    Redim Preserve splitsPtr(Lbound(splitsPtr) To i + l1 / l2)
    Do
        n = Instr(n0, w1, w2)
        If n > 0 Then
            If (skipEmptyElement = 0) Orelse (n - n0) > 0 Then
                Dim As Wstring Ptr p = p1 + n0 - 1
                Dim As Integer l = n - n0
                Dim As Wstring * 1 w
                splitsPtr(i) = Callocate((l + 1) * Sizeof(Wstring))
                Swap w[0], (*p)[l] 
                *splitsPtr(i) = *p
                Swap w[0], (*p)[l] 
                i += 1
            End If
            n0 = n + l2
        Else
            If (skipEmptyElement = 0) Orelse (l1 - n0 + 1) > 0 Then
                Dim As Wstring Ptr p = p1 + n0 - 1
                Dim As Integer l = l1 - n0 + 1
                splitsPtr(i) = Callocate((l + 1) * Sizeof(Wstring))
                *splitsPtr(i) = *p
            Else
                i -= 1
            End If
            If i >= Lbound(splitsPtr) Then
                Redim Preserve splitsPtr(Lbound(splitsPtr) To i)
            Else
                Erase splitsPtr
            End If
            Exit Do
        End If
    Loop
End Sub

Dim As String s0 = "reinvent|the|wheel|" & Chr(0) & "||in|optimized|pure|FreeBASIC|||:lol:||||"
Dim As String s1 = s0
Dim As String s2 = "|"
Dim As String splits(Any)
Print "string   : '" & s1 & "'"
Print "delimiter: '" & s2 & "'"
Print
split(s1, s2, splits())
For i As Integer = 0 To Ubound(splits)
    Print "s(" & i & ") '" & splits(i) & "'"
Next i
Print
Erase splits
split(s1, s2, splits(), 1)
For i As Integer = 0 To Ubound(splits)
    Print "s(" & i & ") '" & splits(i) & "'"
Next i
Erase splits
Print
If s1 <> s0 Then Print "Original string corrupted!"

Sleep
Print
Print

Dim As Wstring * 60 w0 = "reinvent|the|wheel||in|optimized|pure|FreeBASIC|||:lol:||||"
Dim As Wstring * 60 w1 = w0
Dim As Wstring * 2 w2 = "|"
Dim As Wstring Ptr splitsPtr(Any)
Print "wstring  : '" & w1 & "'"
Print "delimiter: '" & w2 & "'"
Print
split(w1, w2, splitsPtr())
For i As Integer = 0 To Ubound(splitsPtr)
    Print "w(" & i & ") '" & *splitsPtr(i) & "'"
    Deallocate(splitsPtr(i))
Next i
Print
Erase splitsPtr
split(w1, w2, splitsPtr(), 1)
For i As Integer = 0 To Ubound(splitsPtr)
    Print "w(" & i & ") '" & *splitsPtr(i) & "'"
    Deallocate(splitsPtr(i))
Next i
Erase splitsPtr
Print
If w1 <> w0 Then Print "Original wstring corrupted!"

Sleep

Code: Select all

string   : 'reinvent|the|wheel| ||in|optimized|pure|FreeBASIC|||:lol:||||'
delimiter: '|'

s(0) 'reinvent'
s(1) 'the'
s(2) 'wheel'
s(3) ' '
s(4) ''
s(5) 'in'
s(6) 'optimized'
s(7) 'pure'
s(8) 'FreeBASIC'
s(9) ''
s(10) ''
s(11) ':lol:'
s(12) ''
s(13) ''
s(14) ''
s(15) ''

s(0) 'reinvent'
s(1) 'the'
s(2) 'wheel'
s(3) ' '
s(4) 'in'
s(5) 'optimized'
s(6) 'pure'
s(7) 'FreeBASIC'
s(8) ':lol:'



wstring  : 'reinvent|the|wheel||in|optimized|pure|FreeBASIC|||:lol:||||'
delimiter: '|'

w(0) 'reinvent'
w(1) 'the'
w(2) 'wheel'
w(3) ''
w(4) 'in'
w(5) 'optimized'
w(6) 'pure'
w(7) 'FreeBASIC'
w(8) ''
w(9) ''
w(10) ':lol:'
w(11) ''
w(12) ''
w(13) ''
w(14) ''

w(0) 'reinvent'
w(1) 'the'
w(2) 'wheel'
w(3) 'in'
w(4) 'optimized'
w(5) 'pure'
w(6) 'FreeBASIC'
w(7) ':lol:'
Top
Avata
Posts: 117
Joined: Jan 17, 2021 7:27

Re: Split String Algorithm for FreeBasic

Post by Avata »

fxm wrote: ↑Jan 04, 2025 15:31 Latest versions of split()

Two overloaded split() procedures, for compatibility with both string and wstring:
(tests added to avoid crash on empty string and 'skipEmptyElement' enabled, and on empty delimiter)
Thank you very much. The speed has improved tenfold. Could you help us create a Join function like this?
Top
fan2006
Posts: 32
Joined: Jun 07, 2020 3:05

Re: Split String Algorithm for FreeBasic

Post by fan2006 »

"join" for zstring:

Code: Select all

#include once "crt/string.bi"
Private Function join(ByVal array As Const ZString Const Ptr Ptr, ByVal delimiter As Const ZString Ptr) As ZString Ptr
   if (array = NULL) then
      Return NULL
   end if
   Dim count As Integer=0
   Dim total_length As UInteger = 0
   Dim p As ZString Ptr Ptr = Cast(Any Ptr, array) 
   While p[0] <> NULL  
      total_length = total_length + strlen(p[0])
    count += 1
   p = @p[0]+1
 Wend

   total_length += (count-1) * strlen(delimiter)
   Dim result As ZString Ptr = allocate(total_length + 1)
   If result = NULL Then
      Return NULL
   end if
   result[0] = asc(!"\0")
   For i As Integer = 0 To count-1
      strcat(result, array[i])
      If i < count-1 Then strcat(result, delimiter)
Next
   Return result
end function
how to use :

Code: Select all

 Dim array(0 To ...) As  ZString Ptr = {@"Hello", @"World", @"C", @"编程",@"Language"}
   dim delimiter as zstring ptr = @", "
   Dim result As ZString Ptr = join(CPtr(Any Ptr,@array(0)),delimiter)
   If result <> NULL Then
      Print *result
      deallocate(result)
   End If
sleep
Top
fxm
Moderator
Posts: 12455
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Split String Algorithm for FreeBasic

Post by fxm »

Two overloaded join() procedures in pure FreeBASIC, for compatibility with both string and wstring:

Code: Select all

Function join Overload(joins(Any) As String, Byref s As String, Byval skipEmptyElement As Integer = 0) As String
    Dim As Integer size
    Dim As Integer lj = Lbound(joins)
    Dim As Integer uj = Ubound(joins)
    Dim As Integer ls = Len(s)
    
    For i As Integer = lj to uj - 1
        If Len(joins(i)) <> 0 Or skipEmptyElement = 0 Then size += Len(joins(i)) + ls
    Next i
    If Len(joins(uj)) <> 0 Or skipEmptyElement = 0 Then size += Len(joins(uj))

    Dim As String so = String(size, Chr(0))
    Dim As Integer n
    For i As Integer = lj to uj - 1
        If Len(joins(i)) <> 0 Or skipEmptyElement = 0 Then
            fb_memcopy(so[n], joins(i)[0], Len(joins(i)))
            n+= Len(joins(i))
            fb_memcopy(so[n], s[0], ls)
            n+= ls
        End If
    Next i
    If Len(joins(uj)) <> 0 Or skipEmptyElement = 0 Then
        fb_memcopy(so[n], joins(uj)[0], Len(joins(uj)))
    Else
        so[size - 1] = 0
        Cptr(Integer Ptr, @so)[1] = size - 1
    End If
    Return so
End Function

Function join Overload(joinsPtr(Any) As Wstring Ptr, Byref w As Wstring, Byval skipEmptyElement As Integer = 0) As Wstring Ptr
    Dim As Integer size
    Dim As Integer lj = Lbound(joinsPtr)
    Dim As Integer uj = Ubound(joinsPtr)
    Dim As Integer ls = Len(w)
    
    For i As Integer = lj to uj - 1
        If Len(*joinsPtr(i)) <> 0 Or skipEmptyElement = 0 Then size += Len(*joinsPtr(i)) + ls
    Next i
    If Len(*joinsPtr(uj)) <> 0 Or skipEmptyElement = 0 Then size += Len(*joinsPtr(uj))

    Dim As Wstring Ptr woPtr = Callocate((size + 1) * Sizeof(Wstring))
    Dim As Integer n
    For i As Integer = lj to uj - 1
        If Len(*joinsPtr(i)) <> 0 Or skipEmptyElement = 0 Then
            fb_memcopy((*woPtr)[n], (*joinsPtr(i))[0], Len(*joinsPtr(i)) * Sizeof(Wstring))
            n+= Len(*joinsPtr(i))
            fb_memcopy((*woPtr)[n], w[0], ls * Sizeof(Wstring))
            n+= ls
        End If
    Next i
    If Len(*joinsPtr(uj)) <> 0 Or skipEmptyElement = 0 Then
        fb_memcopy((*woPtr)[n], (*joinsPtr(uj))[0], Len(*joinsPtr(uj)) * Sizeof(Wstring))
    Else
        (*woPtr)[size - 1] = 0
    End If
    Return woPtr
End Function

Dim As String joins(...) = {"reinvent", _
                            "the", _
                            "wheel", _
                            Chr(0), _
                            "", _
                            "in", _
                            "optimized", _
                            "pure", _
                            "FreeBASIC", _
                            "", _
                            "", _
                            ":lol:", _
                            "", _
                            "", _
                            "", _
                            "" _
                           }
Dim As String s = "|"

For I As Integer = Lbound(joins) To Ubound(joins)
    Print "s(" & i & ") '" & joins(I) & "'"
Next I
Print "delimiter '" & s & "'"
Print
Print "s: '" & join(joins(), s) & "'"
Print
Print "s: '" & join(joins(), s, 1) & "'"

Sleep
Print
Print

Dim As Wstring Ptr joinsPtr(...) = {@Wstr("reinvent"), _
                                    @Wstr("the"), _
                                    @Wstr("wheel"), _
                                    @Wstr(""), _
                                    @Wstr(""), _
                                    @Wstr("in"), _
                                    @Wstr("optimized"), _
                                    @Wstr("pure"), _
                                    @Wstr("FreeBASIC"), _
                                    @Wstr(""), _
                                    @Wstr(""), _
                                    @Wstr(":lol:"), _
                                    @Wstr(""), _
                                    @Wstr(""), _
                                    @Wstr(""), _
                                    @Wstr("") _
                                   }
Dim As Wstring * 2 w = "|"
For I As Integer = Lbound(joinsPtr) To Ubound(joinsPtr)
    Print "w(" & i & ") '" & *joinsPtr(I) & "'"
Next I
Print "delimiter '" &  w & "'"
Print
Dim As Wstring Ptr pw
pw = join(joinsPtr(), w)
Print "w: '" & *pw & "'"
Deallocate(pw)
Print
pw = join(joinsPtr(), w, 1)
Print "w: '" & *pw & "'"
Deallocate(pw)

Sleep

Code: Select all

s(0) 'reinvent'
s(1) 'the'
s(2) 'wheel'
s(3) ' '
s(4) ''
s(5) 'in'
s(6) 'optimized'
s(7) 'pure'
s(8) 'FreeBASIC'
s(9) ''
s(10) ''
s(11) ':lol:'
s(12) ''
s(13) ''
s(14) ''
s(15) ''
delimiter '|'

s: 'reinvent|the|wheel| ||in|optimized|pure|FreeBASIC|||:lol:||||'

s: 'reinvent|the|wheel| |in|optimized|pure|FreeBASIC|:lol:'


w(0) 'reinvent'
w(1) 'the'
w(2) 'wheel'
w(3) ''
w(4) ''
w(5) 'in'
w(6) 'optimized'
w(7) 'pure'
w(8) 'FreeBASIC'
w(9) ''
w(10) ''
w(11) ':lol:'
w(12) ''
w(13) ''
w(14) ''
w(15) ''
delimiter '|'

w: 'reinvent|the|wheel|||in|optimized|pure|FreeBASIC|||:lol:||||'

w: 'reinvent|the|wheel|in|optimized|pure|FreeBASIC|:lol:'
Last edited by fxm on Jan 08, 2025 17:32, edited 1 time in total.
Reason: Code typo fixed for join() for wstring.
Top
Avata
Posts: 117
Joined: Jan 17, 2021 7:27

Re: Split String Algorithm for FreeBasic

Post by Avata »

fxm wrote: ↑Jan 05, 2025 19:25 Two overloaded join() procedures in pure FreeBASIC, for compatibility with both string and wstring:
Thank you very much. FXM. The IDE VisualFBEditor https://github.com/XusinboyBekchanov/VisualFBEditor already apply the function. Collect and recommend the code for Thread.bi and DynamicArrayList.bi.
https://github.com/XusinboyBekchanov/My ... 16b67af718

Additionally, how should we handle ZString?
Top
fxm
Moderator
Posts: 12455
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Split String Algorithm for FreeBasic

Post by fxm »

Avata wrote: ↑Jan 06, 2025 2:31 Additionally, how should we handle ZString?

The code body of the two procedures for Wstring can be very easily transposed to Zstring

Code: Select all

Sub split(Byref z1 As Zstring, Byref z2 As Zstring, splitsPtr(Any) As Zstring Ptr, byval skipEmptyElement As Integer = 0)
    Dim As Zstring Ptr p1 = @z1
    Dim As Integer l1 = Len(z1)
    Dim As Integer l2 = Len(z2)
    If l2 = 0 Then l2 = 1
    Dim As integer i = Ubound(splitsPtr) + 1
    Dim As Integer n, n0 = 1

    Redim Preserve splitsPtr(Lbound(splitsPtr) To i + l1 / l2)
    Do
        n = Instr(n0, z1, z2)
        If n > 0 Then
            If (skipEmptyElement = 0) Orelse (n - n0) > 0 Then
                Dim As Zstring Ptr p = p1 + n0 - 1
                Dim As Integer l = n - n0
                Dim As Zstring * 1 z
                splitsPtr(i) = Callocate((l + 1) * Sizeof(Zstring))
                Swap z[0], (*p)[l] 
                *splitsPtr(i) = *p
                Swap z[0], (*p)[l] 
                i += 1
            End If
            n0 = n + l2
        Else
            If (skipEmptyElement = 0) Orelse (l1 - n0 + 1) > 0 Then
                Dim As Zstring Ptr p = p1 + n0 - 1
                Dim As Integer l = l1 - n0 + 1
                splitsPtr(i) = Callocate((l + 1) * Sizeof(Zstring))
                *splitsPtr(i) = *p
            Else
                i -= 1
            End If
            If i >= Lbound(splitsPtr) Then
                Redim Preserve splitsPtr(Lbound(splitsPtr) To i)
            Else
                Erase splitsPtr
            End If
            Exit Do
        End If
    Loop
End Sub

Dim As Zstring * 60 z0 = "reinvent|the|wheel||in|optimized|pure|FreeBASIC|||:lol:||||"
Dim As Zstring * 60 z1 = z0
Dim As zstring * 2 z2 = "|"
Dim As Zstring Ptr splitsPtr(Any)
Print "zstring  : '" & z1 & "'"
Print "delimiter: '" & z2 & "'"
Print
split(z1, z2, splitsPtr())
For i As Integer = 0 To Ubound(splitsPtr)
    Print "z(" & i & ") '" & *splitsPtr(i) & "'"
    Deallocate(splitsPtr(i))
Next i
Print
Erase splitsPtr
split(z1, z2, splitsPtr(), 1)
For i As Integer = 0 To Ubound(splitsPtr)
    Print "z(" & i & ") '" & *splitsPtr(i) & "'"
    Deallocate(splitsPtr(i))
Next i
Erase splitsPtr
Print
If z1 <> z0 Then Print "Original zstring corrupted!"

Sleep

  • Code: Select all

    zstring  : 'reinvent|the|wheel||in|optimized|pure|FreeBASIC|||:lol:||||'
delimiter: '|'

z(0) 'reinvent'
z(1) 'the'
z(2) 'wheel'
z(3) ''
z(4) 'in'
z(5) 'optimized'
z(6) 'pure'
z(7) 'FreeBASIC'
z(8) ''
z(9) ''
z(10) ':lol:'
z(11) ''
z(12) ''
z(13) ''
z(14) ''

z(0) 'reinvent'
z(1) 'the'
z(2) 'wheel'
z(3) 'in'
z(4) 'optimized'
z(5) 'pure'
z(6) 'FreeBASIC'
z(7) ':lol:'

Code: Select all

Function join(joinsPtr(Any) As Zstring Ptr, Byref z As Zstring, Byval skipEmptyElement As Integer = 0) As Zstring Ptr
    Dim As Integer size
    Dim As Integer lj = Lbound(joinsPtr)
    Dim As Integer uj = Ubound(joinsPtr)
    Dim As Integer ls = Len(z)
    
    For i As Integer = lj to uj - 1
        If Len(*joinsPtr(i)) <> 0 Or skipEmptyElement = 0 Then size += Len(*joinsPtr(i)) + ls
    Next i
    If Len(*joinsPtr(uj)) <> 0 Or skipEmptyElement = 0 Then size += Len(*joinsPtr(uj))

    Dim As Zstring Ptr zoPtr = Callocate((size + 1) * Sizeof(Zstring))
    Dim As Integer n
    For i As Integer = lj to uj - 1
        If Len(*joinsPtr(i)) <> 0 Or skipEmptyElement = 0 Then
            fb_memcopy((*zoPtr)[n], (*joinsPtr(i))[0], Len(*joinsPtr(i)) * Sizeof(Zstring))
            n+= Len(*joinsPtr(i))
            fb_memcopy((*zoPtr)[n], z[0], ls * Sizeof(Zstring))
            n+= ls
        End If
    Next i
    If Len(*joinsPtr(uj)) <> 0 Or skipEmptyElement = 0 Then
        fb_memcopy((*zoPtr)[n], (*joinsPtr(uj))[0], Len(*joinsPtr(uj)) * Sizeof(zstring))
    Else
        (*zoPtr)[size - 1] = 0
    End If
    Return zoPtr
End Function

Dim As Zstring Ptr joinsPtr(...) = {@"reinvent", _
                                    @"the", _
                                    @"wheel", _
                                    @"", _
                                    @"", _
                                    @"in", _
                                    @"optimized", _
                                    @"pure", _
                                    @"FreeBASIC", _
                                    @"", _
                                    @"", _
                                    @":lol:", _
                                    @"", _
                                    @"", _
                                    @"", _
                                    @"" _
                                   }
Dim As Zstring * 2 z = "|"

For I As Integer = Lbound(joinsPtr) To Ubound(joinsPtr)
    Print "z(" & i & ") '" & *joinsPtr(I) & "'"
Next I
Print "delimiter '" &  z & "'"
Print
Dim As Zstring Ptr pz
pz = join(joinsPtr(), z)
Print "z: '" & *pz & "'"
Deallocate(pz)
Print
pz = join(joinsPtr(), z, 1)
Print "z: '" & *pz & "'"
Deallocate(pz)

Sleep

  • Code: Select all

    z(0) 'reinvent'
z(1) 'the'
z(2) 'wheel'
z(3) ''
z(4) ''
z(5) 'in'
z(6) 'optimized'
z(7) 'pure'
z(8) 'FreeBASIC'
z(9) ''
z(10) ''
z(11) ':lol:'
z(12) ''
z(13) ''
z(14) ''
z(15) ''
delimiter '|'

z: 'reinvent|the|wheel|||in|optimized|pure|FreeBASIC|||:lol:||||'

z: 'reinvent|the|wheel|in|optimized|pure|FreeBASIC|:lol:'
Last edited by fxm on Jan 08, 2025 17:34, edited 1 time in total.
Reason: Code typo fixed for join() for zstring.
Top
fxm
Moderator
Posts: 12455
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Split String Algorithm for FreeBasic

Post by fxm »

My six procedures, split() and join() for string and zstring and wstring, grouped in one file with code to test them

Code: Select all

' fxm - 09 Jan 2025

Sub split Overload(Byref s1 As String, Byref s2 As String, splits(Any) As String, byval skipEmptyElement As Integer = 0)
    Dim As Any Ptr p1 = Cptr(Any Ptr Ptr, @S1)[0]
    Dim As Integer l1 = Cptr(Integer Ptr, @S1)[1]
    Dim As Integer l2 = Cptr(Integer Ptr, @s2)[1]
    If l2 = 0 Then l2 = 1
    Dim As integer i = Ubound(splits) + 1
    Dim As Integer n, n0 = 1

    Redim Preserve splits(Lbound(splits) To i + l1 / l2)
    Do
        n = Instr(n0, s1, s2)
        If n > 0 Then
            If (skipEmptyElement = 0) Orelse (n - n0) > 0 Then
                Cptr(Any Ptr Ptr, @S1)[0] = p1 + n0 - 1
                Cptr(Integer Ptr, @S1)[1] = n - n0
                splits(i) = s1
                Cptr(Any Ptr Ptr, @S1)[0] = p1
                Cptr(Integer Ptr, @S1)[1] = l1
                i += 1
            End If
            n0 = n + l2
        Else
            If (skipEmptyElement = 0) Orelse (l1 - n0 + 1) > 0 Then
                Cptr(Any Ptr Ptr, @S1)[0] = p1 + n0 - 1
                Cptr(Integer Ptr, @S1)[1] = l1 - n0 + 1
                splits(i) = s1
                Cptr(Any Ptr Ptr, @S1)[0] = p1
                Cptr(Integer Ptr, @S1)[1] = l1
            Else
                i -= 1
            End If
            If i >= Lbound(splits) Then
                Redim Preserve splits(Lbound(splits) To i)
            Else
                Erase splits
            End If
            Exit Do
        End If
    Loop
End Sub

Sub split Overload(Byref z1 As Zstring, Byref z2 As Zstring, splitsPtr(Any) As Zstring Ptr, byval skipEmptyElement As Integer = 0)
    Dim As Zstring Ptr p1 = @z1
    Dim As Integer l1 = Len(z1)
    Dim As Integer l2 = Len(z2)
    If l2 = 0 Then l2 = 1
    Dim As integer i = Ubound(splitsPtr) + 1
    Dim As Integer n, n0 = 1

    Redim Preserve splitsPtr(Lbound(splitsPtr) To i + l1 / l2)
    Do
        n = Instr(n0, z1, z2)
        If n > 0 Then
            If (skipEmptyElement = 0) Orelse (n - n0) > 0 Then
                Dim As Zstring Ptr p = p1 + n0 - 1
                Dim As Integer l = n - n0
                Dim As Zstring * 1 z
                splitsPtr(i) = Callocate((l + 1) * Sizeof(Zstring))
                Swap z[0], (*p)[l] 
                *splitsPtr(i) = *p
                Swap z[0], (*p)[l] 
                i += 1
            End If
            n0 = n + l2
        Else
            If (skipEmptyElement = 0) Orelse (l1 - n0 + 1) > 0 Then
                Dim As Zstring Ptr p = p1 + n0 - 1
                Dim As Integer l = l1 - n0 + 1
                splitsPtr(i) = Callocate((l + 1) * Sizeof(Zstring))
                *splitsPtr(i) = *p
            Else
                i -= 1
            End If
            If i >= Lbound(splitsPtr) Then
                Redim Preserve splitsPtr(Lbound(splitsPtr) To i)
            Else
                Erase splitsPtr
            End If
            Exit Do
        End If
    Loop
End Sub

Sub split Overload(Byref w1 As Wstring, Byref w2 As Wstring, splitsPtr(Any) As Wstring Ptr, byval skipEmptyElement As Integer = 0)
    Dim As Wstring Ptr p1 = @w1
    Dim As Integer l1 = Len(w1)
    Dim As Integer l2 = Len(w2)
    If l2 = 0 Then l2 = 1
    Dim As integer i = Ubound(splitsPtr) + 1
    Dim As Integer n, n0 = 1

    Redim Preserve splitsPtr(Lbound(splitsPtr) To i + l1 / l2)
    Do
        n = Instr(n0, w1, w2)
        If n > 0 Then
            If (skipEmptyElement = 0) Orelse (n - n0) > 0 Then
                Dim As Wstring Ptr p = p1 + n0 - 1
                Dim As Integer l = n - n0
                Dim As Wstring * 1 w
                splitsPtr(i) = Callocate((l + 1) * Sizeof(Wstring))
                Swap w[0], (*p)[l] 
                *splitsPtr(i) = *p
                Swap w[0], (*p)[l] 
                i += 1
            End If
            n0 = n + l2
        Else
            If (skipEmptyElement = 0) Orelse (l1 - n0 + 1) > 0 Then
                Dim As Wstring Ptr p = p1 + n0 - 1
                Dim As Integer l = l1 - n0 + 1
                splitsPtr(i) = Callocate((l + 1) * Sizeof(Wstring))
                *splitsPtr(i) = *p
            Else
                i -= 1
            End If
            If i >= Lbound(splitsPtr) Then
                Redim Preserve splitsPtr(Lbound(splitsPtr) To i)
            Else
                Erase splitsPtr
            End If
            Exit Do
        End If
    Loop
End Sub

Function join Overload(joins(Any) As String, Byref s As String, Byval skipEmptyElement As Integer = 0) As String
    Dim As Integer lj = Lbound(joins)
    Dim As Integer uj = Ubound(joins)
    If uj < lj Then Return ""
    Dim As Integer ls = Len(s)
    Dim As Integer size
    
    For i As Integer = lj to uj - 1
        If Len(joins(i)) <> 0 Or skipEmptyElement = 0 Then size += Len(joins(i)) + ls
    Next i
    If Len(joins(uj)) <> 0 Or skipEmptyElement = 0 Then size += Len(joins(uj))

    Dim As String so = String(size, Chr(0))
    Dim As Integer n
    For i As Integer = lj to uj - 1
        If Len(joins(i)) <> 0 Or skipEmptyElement = 0 Then
            fb_memcopy(so[n], joins(i)[0], Len(joins(i)))
            n+= Len(joins(i))
            fb_memcopy(so[n], s[0], ls)
            n+= ls
        End If
    Next i
    If Len(joins(uj)) <> 0 Or skipEmptyElement = 0 Then
        fb_memcopy(so[n], joins(uj)[0], Len(joins(uj)))
    Else
        Cptr(Integer Ptr, @so)[1] = size - ls
    End If
    Return so
End Function

Function join Overload(joinsPtr(Any) As Zstring Ptr, Byref z As Zstring, Byval skipEmptyElement As Integer = 0) As Zstring Ptr
    Dim As Integer lj = Lbound(joinsPtr)
    Dim As Integer uj = Ubound(joinsPtr)
    If uj < lj Then Return Callocate(Sizeof(Zstring))
    Dim As Integer lenjoins(lj To uj)
    Dim As Integer ls = Len(z)
    Dim As Integer size
    
    For i As Integer = lj to uj - 1
        lenjoins(i) = Len(*joinsPtr(i))
        If lenjoins(i) <> 0 Or skipEmptyElement = 0 Then size += lenjoins(i) + ls
    Next i
    lenjoins(uj) = Len(*joinsPtr(uj))
    If lenjoins(uj) <> 0 Or skipEmptyElement = 0 Then size += lenjoins(uj)

    Dim As Zstring Ptr zoPtr = Callocate((size + 1) * Sizeof(Zstring))
    Dim As Integer n
    For i As Integer = lj to uj - 1
        If lenjoins(i) <> 0 Or skipEmptyElement = 0 Then
            fb_memcopy((*zoPtr)[n], (*joinsPtr(i))[0], lenjoins(i) * Sizeof(Zstring))
            n+= lenjoins(i)
            fb_memcopy((*zoPtr)[n], z[0], ls * Sizeof(Zstring))
            n+= ls
        End If
    Next i
    If lenjoins(uj) <> 0 Or skipEmptyElement = 0 Then
        fb_memcopy((*zoPtr)[n], (*joinsPtr(uj))[0], lenjoins(uj) * Sizeof(zstring))
    Else
        (*zoPtr)[size - ls] = 0
    End If
    Return zoPtr
End Function

Function join Overload(joinsPtr(Any) As Wstring Ptr, Byref w As Wstring, Byval skipEmptyElement As Integer = 0) As Wstring Ptr
    Dim As Integer lj = Lbound(joinsPtr)
    Dim As Integer uj = Ubound(joinsPtr)
    If uj < lj Then Return Callocate(Sizeof(Wstring))
    Dim As Integer lenjoins(lj To uj)
    Dim As Integer ls = Len(w)
    Dim As Integer size
    
    For i As Integer = lj to uj - 1
        lenjoins(i) = Len(*joinsPtr(i))
        If lenjoins(i) <> 0 Or skipEmptyElement = 0 Then size += lenjoins(i) + ls
    Next i
    lenjoins(uj) = Len(*joinsPtr(uj))
    If lenjoins(uj) <> 0 Or skipEmptyElement = 0 Then size += lenjoins(uj)

    Dim As Wstring Ptr woPtr = Callocate((size + 1) * Sizeof(Wstring))
    Dim As Integer n
    For i As Integer = lj to uj - 1
        If lenjoins(i) <> 0 Or skipEmptyElement = 0 Then
            fb_memcopy((*woPtr)[n], (*joinsPtr(i))[0], lenjoins(i) * Sizeof(Wstring))
            n+= lenjoins(i)
            fb_memcopy((*woPtr)[n], w[0], ls * Sizeof(Wstring))
            n+= ls
        End If
    Next i
    If lenjoins(uj) <> 0 Or skipEmptyElement = 0 Then
        fb_memcopy((*woPtr)[n], (*joinsPtr(uj))[0], lenjoins(uj) * Sizeof(Wstring))
    Else
        (*woPtr)[size - ls] = 0
    End If
    Return woPtr
End Function


Dim As String s0 = "reinvent|the|wheel|" & Chr(0) & "||in|optimized|pure|FreeBASIC|||:lol:||||"
Dim As String s1 = s0
Dim As String s2 = "|"
Dim As String splitsS(Any)
Print "string   : '" & s1 & "'"
Print "delimiter: '" & s2 & "'"
Print
split(s1, s2, splitsS())
For i As Integer = 0 To Ubound(splitsS)
    Print "s(" & i & ") '" & splitsS(i) & "'"
Next i
Print
Erase splitsS
split(s1, s2, splitsS(), 1)
For i As Integer = 0 To Ubound(splitsS)
    Print "s(" & i & ") '" & splitsS(i) & "'"
Next i
Erase splitsS
If s1 <> s0 Then Print "Original string corrupted!"
Sleep
Print
Print "---------------------------------------------------------------------------"
Print

Dim As Zstring * 60 z0 = "reinvent|the|wheel||in|optimized|pure|FreeBASIC|||:lol:||||"
Dim As Zstring * 60 z1 = z0
Dim As zstring * 2 z2 = "|"
Dim As Zstring Ptr splitsPtrZ(Any)
Print "zstring  : '" & z1 & "'"
Print "delimiter: '" & z2 & "'"
Print
split(z1, z2, splitsPtrZ())
For i As Integer = 0 To Ubound(splitsPtrZ)
    Print "z(" & i & ") '" & *splitsPtrZ(i) & "'"
    Deallocate(splitsPtrZ(i))
Next i
Print
Erase splitsPtrZ
split(z1, z2, splitsPtrZ(), 1)
For i As Integer = 0 To Ubound(splitsPtrZ)
    Print "z(" & i & ") '" & *splitsPtrZ(i) & "'"
    Deallocate(splitsPtrZ(i))
Next i
Erase splitsPtrZ
If z1 <> z0 Then Print "Original zstring corrupted!"
Sleep
Print
Print "---------------------------------------------------------------------------"
Print

Dim As Wstring * 60 w0 = "reinvent|the|wheel||in|optimized|pure|FreeBASIC|||:lol:||||"
Dim As Wstring * 60 w1 = w0
Dim As Wstring * 2 w2 = "|"
Dim As Wstring Ptr splitsPtrW(Any)
Print "wstring  : '" & w1 & "'"
Print "delimiter: '" & w2 & "'"
Print
split(w1, w2, splitsPtrW())
For i As Integer = 0 To Ubound(splitsPtrW)
    Print "w(" & i & ") '" & *splitsPtrW(i) & "'"
    Deallocate(splitsPtrW(i))
Next i
Print
Erase splitsPtrW
split(w1, w2, splitsPtrW(), 1)
For i As Integer = 0 To Ubound(splitsPtrW)
    Print "w(" & i & ") '" & *splitsPtrW(i) & "'"
    Deallocate(splitsPtrW(i))
Next i
Erase splitsPtrW
If w1 <> w0 Then Print "Original wstring corrupted!"
Sleep
Print
Print "---------------------------------------------------------------------------"
Print

Dim As String joinsS(...) = {"reinvent", _
                            "the", _
                            "wheel", _
                            Chr(0), _
                            "", _
                            "in", _
                            "optimized", _
                            "pure", _
                            "FreeBASIC", _
                            "", _
                            "", _
                            ":lol:", _
                            "", _
                            "", _
                            "", _
                            "" _
                           }
Dim As String s = "|"

For I As Integer = Lbound(joinsS) To Ubound(joinsS)
    Print "s(" & i & ") '" & joinsS(I) & "'"
Next I
Print "delimiter '" & s & "'"
Print
Print "s: '" & join(joinsS(), s) & "'"
Print
Print "s: '" & join(joinsS(), s, 1) & "'"
Sleep
Print
Print "---------------------------------------------------------------------------"
Print

Dim As Zstring Ptr joinsPtrZ(...) = {@"reinvent", _
                                    @"the", _
                                    @"wheel", _
                                    @"", _
                                    @"", _
                                    @"in", _
                                    @"optimized", _
                                    @"pure", _
                                    @"FreeBASIC", _
                                    @"", _
                                    @"", _
                                    @":lol:", _
                                    @"", _
                                    @"", _
                                    @"", _
                                    @"" _
                                   }
Dim As Zstring * 2 z = "|"

For I As Integer = Lbound(joinsPtrZ) To Ubound(joinsPtrZ)
    Print "z(" & i & ") '" & *joinsPtrZ(I) & "'"
Next I
Print "delimiter '" &  z & "'"
Print
Dim As Zstring Ptr pz
pz = join(joinsPtrZ(), z)
Print "z: '" & *pz & "'"
Deallocate(pz)
Print
pz = join(joinsPtrZ(), z, 1)
Print "z: '" & *pz & "'"
Deallocate(pz)
Sleep
Print
Print "---------------------------------------------------------------------------"
Print

Dim As Wstring Ptr joinsPtrW(...) = {@Wstr("reinvent"), _
                                    @Wstr("the"), _
                                    @Wstr("wheel"), _
                                    @Wstr(""), _
                                    @Wstr(""), _
                                    @Wstr("in"), _
                                    @Wstr("optimized"), _
                                    @Wstr("pure"), _
                                    @Wstr("FreeBASIC"), _
                                    @Wstr(""), _
                                    @Wstr(""), _
                                    @Wstr(":lol:"), _
                                    @Wstr(""), _
                                    @Wstr(""), _
                                    @Wstr(""), _
                                    @Wstr("") _
                                   }
Dim As Wstring * 2 w = "|"

For I As Integer = Lbound(joinsPtrW) To Ubound(joinsPtrW)
    Print "w(" & i & ") '" & *joinsPtrW(I) & "'"
Next I
Print "delimiter '" &  w & "'"
Print
Dim As Wstring Ptr pw
pw = join(joinsPtrW(), w)
Print "w: '" & *pw & "'"
Deallocate(pw)
Print
pw = join(joinsPtrW(), w, 1)
Print "w: '" & *pw & "'"
Deallocate(pw)
Sleep
Print

  • Code: Select all

    string   : 'reinvent|the|wheel| ||in|optimized|pure|FreeBASIC|||:lol:||||'
delimiter: '|'

s(0) 'reinvent'
s(1) 'the'
s(2) 'wheel'
s(3) ' '
s(4) ''
s(5) 'in'
s(6) 'optimized'
s(7) 'pure'
s(8) 'FreeBASIC'
s(9) ''
s(10) ''
s(11) ':lol:'
s(12) ''
s(13) ''
s(14) ''
s(15) ''

s(0) 'reinvent'
s(1) 'the'
s(2) 'wheel'
s(3) ' '
s(4) 'in'
s(5) 'optimized'
s(6) 'pure'
s(7) 'FreeBASIC'
s(8) ':lol:'

---------------------------------------------------------------------------

zstring  : 'reinvent|the|wheel||in|optimized|pure|FreeBASIC|||:lol:||||'
delimiter: '|'

z(0) 'reinvent'
z(1) 'the'
z(2) 'wheel'
z(3) ''
z(4) 'in'
z(5) 'optimized'
z(6) 'pure'
z(7) 'FreeBASIC'
z(8) ''
z(9) ''
z(10) ':lol:'
z(11) ''
z(12) ''
z(13) ''
z(14) ''

z(0) 'reinvent'
z(1) 'the'
z(2) 'wheel'
z(3) 'in'
z(4) 'optimized'
z(5) 'pure'
z(6) 'FreeBASIC'
z(7) ':lol:'

---------------------------------------------------------------------------

wstring  : 'reinvent|the|wheel||in|optimized|pure|FreeBASIC|||:lol:||||'
delimiter: '|'

w(0) 'reinvent'
w(1) 'the'
w(2) 'wheel'
w(3) ''
w(4) 'in'
w(5) 'optimized'
w(6) 'pure'
w(7) 'FreeBASIC'
w(8) ''
w(9) ''
w(10) ':lol:'
w(11) ''
w(12) ''
w(13) ''
w(14) ''

w(0) 'reinvent'
w(1) 'the'
w(2) 'wheel'
w(3) 'in'
w(4) 'optimized'
w(5) 'pure'
w(6) 'FreeBASIC'
w(7) ':lol:'

---------------------------------------------------------------------------

s(0) 'reinvent'
s(1) 'the'
s(2) 'wheel'
s(3) ' '
s(4) ''
s(5) 'in'
s(6) 'optimized'
s(7) 'pure'
s(8) 'FreeBASIC'
s(9) ''
s(10) ''
s(11) ':lol:'
s(12) ''
s(13) ''
s(14) ''
s(15) ''
delimiter '|'

s: 'reinvent|the|wheel| ||in|optimized|pure|FreeBASIC|||:lol:||||'

s: 'reinvent|the|wheel| |in|optimized|pure|FreeBASIC|:lol:'

---------------------------------------------------------------------------

z(0) 'reinvent'
z(1) 'the'
z(2) 'wheel'
z(3) ''
z(4) ''
z(5) 'in'
z(6) 'optimized'
z(7) 'pure'
z(8) 'FreeBASIC'
z(9) ''
z(10) ''
z(11) ':lol:'
z(12) ''
z(13) ''
z(14) ''
z(15) ''
delimiter '|'

z: 'reinvent|the|wheel|||in|optimized|pure|FreeBASIC|||:lol:||||'

z: 'reinvent|the|wheel|in|optimized|pure|FreeBASIC|:lol:'

---------------------------------------------------------------------------

w(0) 'reinvent'
w(1) 'the'
w(2) 'wheel'
w(3) ''
w(4) ''
w(5) 'in'
w(6) 'optimized'
w(7) 'pure'
w(8) 'FreeBASIC'
w(9) ''
w(10) ''
w(11) ':lol:'
w(12) ''
w(13) ''
w(14) ''
w(15) ''
delimiter '|'

w: 'reinvent|the|wheel|||in|optimized|pure|FreeBASIC|||:lol:||||'

w: 'reinvent|the|wheel|in|optimized|pure|FreeBASIC|:lol:'

[edit] January 08, 2025
Fixed typo for 'join()' for zstring and wstring causing bug when last element of string array is not null:
Len(joinsPtr(uj)) Len(*joinsPtr(uj))
Optimization for 'join()' for zstring and wstring.

[edit] January 09, 2025
Fixed other small bugs.
Last edited by fxm on Jan 09, 2025 16:00, edited 5 times in total.
Reason: Fixed typo for 'join()' for zstring and wstring causing bug when last element of string array is not null. Optimization for 'join()' for zstring and wstring. Fixed other small bugs.
Top
Post Reply

Return to “Sources, Examples, Tips and Tricks”