Split String Algorithm for FreeBasic

[Vinion]

Hello, this is my first post on this forum so... Happy to meet you all!

I write code in Java, PHP, C# and some C on Arduino. I used to write some Basic when I was a kid and I really liked this language.

For my projects I often use string expressions to pass data between web services, microcontrollers and desktop applications and the Split algorithm is something I oftenly use. I got involved with FreeBasic a week ago and I found out that Split command is not onboard so I had to write my own.

Hope you find it useful !

Code: Select all

/'
    Split Text Algorithm v2.0 for FreeBasic 

    Author: Nikos Siatras
    https://github.com/nsiatras
'/

' Splits the textToSplit string into multiple Strings, given the delimiter 
' that separates them and adds them to the result array
Sub Split(byval stringToSplit as String, delimeter as const String, result() as String)
	
	Dim lengthOfDelimeter as Integer = len(delimeter)
	Dim indexOfDelimeter as Integer = Instr(stringToSplit, delimeter)
	Dim counter as Integer = 0
	
	while (indexOfDelimeter > 0)
	
		Redim preserve result(counter+1)
		result(counter) = mid(stringToSplit, 1, indexOfDelimeter - 1)
		
		stringToSplit = mid(stringToSplit,indexOfDelimeter + lengthOfDelimeter)
		
		indexOfDelimeter = Instr(stringToSplit, delimeter)
		counter += 1
	wend 
	
	result(counter) =  stringToSplit	
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Test Code
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim fStringToSplit as String
Dim fSplitParts () as String

fStringToSplit = "Hello,World,!"

Split(fStringToSplit,",",fSplitParts())

for i as Integer =0 to ubound(fSplitParts)
	print "Part #" &i & " = " & fSplitParts(i)
next

I also posted this algorithm to my personal blog
https://codemammoth.blogspot.com/2022/0 ... basic.html

[SARG]

Just a tip :
As instr() accepts as first optionnal parameter where the search begins you can avoid to create each time a new string stringtoSplit.

Code: Select all

Sub Split(byval stringToSplit as String, delimeter as const String, result() as String)
	
	Dim lengthOfDelimeter as Integer = len(delimeter)
	Dim indexOfDelimeter as Integer = Instr(stringToSplit, delimeter)
	Dim counter as Integer = 0
	Dim indexstart as Integer = 1
	print stringToSplit
	while (indexOfDelimeter > 0)

		Redim preserve result(counter+1)
		result(counter) = mid(stringToSplit, indexstart, indexOfDelimeter - indexstart)

		indexstart=indexOfDelimeter + lengthOfDelimeter

		indexOfDelimeter = Instr(indexstart,stringToSplit, delimeter)

		counter += 1
	wend 
	
	result(counter) =  mid(stringToSplit, indexstart)	
End Sub

[Vinion]

I re-wrote the algorithm and made it as fast as I could

The new algorith is the following

Code: Select all

/'
    Split Text Algorithm v2.1 for FreeBasic 

    Author: Nikos Siatras
    https://github.com/nsiatras
'/

' Splits the textToSplit string into multiple Strings, given the delimiter 
' that separates them and adds them to the result array
Sub Split(byref stringToSplit as const String, byref delimeter as const String, result() as String)
	
    Dim lengthOfDelimeter as Integer = len(delimeter)
    Dim indexOfDelimeter as Integer = 1
    Dim delimeterCount as Integer = 0
    Dim offset as Integer
    Dim lastDelimeterIndex as Integer
    
    ' Find how many times the demileter exists in the stringToSplit
    Do
		indexOfDelimeter = InStr(indexOfDelimeter, stringToSplit, delimeter)
		if indexOfDelimeter >0 then
			delimeterCount += 1
			indexOfDelimeter = indexOfDelimeter + lengthOfDelimeter
		else
			Exit Do ' Exit Do Loop
		endif
    Loop
    
    ' The delimeter wasn't found in the string
    if delimeterCount = 0 then
		ReDim result(0)
		result(0) = stringToSplit
		return
    endif
    
    ' Resize the result array according to delimeter size
    ReDim result(delimeterCount)

	' Serial search inside the stringToSplit in order to find the parts 
	' separated by the delimeter and push them to the result() array
    delimeterCount = 0
    offset = 1
    indexOfDelimeter = 1 
    Do
		indexOfDelimeter = InStr(offset, stringToSplit, delimeter)
		if indexOfDelimeter > 0 then
			result(delimeterCount) = Mid(stringToSplit, offset, indexOfDelimeter - offset)
		else
			if lastDelimeterIndex < len (stringToSplit) then
				result(delimeterCount) = Mid(stringToSplit, lastDelimeterIndex + lengthOfDelimeter)
			endif
			return 'Exit the Do Loop and return!
		endif
		lastDelimeterIndex = indexOfDelimeter
		offset = indexOfDelimeter + lengthOfDelimeter
		delimeterCount += 1
    Loop
    
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Test Code
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim fStringToSplit as String
Dim fSplitParts () as String, tmp as String
Dim i as Integer

fStringToSplit = ",Welcome,to,Free,Basic,!"
Split(fStringToSplit,",",fSplitParts())
     
' Print the fSplitParts
for i = 0 to ubound(fSplitParts)
    print "Part #" & i & " " & fSplitParts(i)
next

print ""

fStringToSplit = "Now<>you<>know<>how<>to<>split<>strings<>!"
Split(fStringToSplit,"<>",fSplitParts())
     
' Print the fSplitParts
for i = 0 to ubound(fSplitParts)
    print "Part #" & i & " " & fSplitParts(i)
next

[dodicat]

Hello Vinion.
Welcome to the forum.
Your latest version is quite fast.
There was a time on this forum when six or seven members would pitch in, and the thread would become a speed test.
Possibly it would stretch out a week or two.
So a new member like yourself is welcome, when so many old members no longer participate.
There would be methods using pointers, methods using crt functions, OOP methods, and methods unheard of before.
Here in one of my methods.

Code: Select all

Function tally (somestring As String,partstring As String,arr() As Long) As Long
    redim arr(1 to len(somestring)\2+1)
    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
        arr(count)=i+1
        i=i+lnp-1
        skip:
    Loop Until i>=ln-1
    redim preserve arr(1 to count) 
    Return count
End Function


Function splitstring(somestring As String,partstring As String,a() As String) As Long
    Redim As Long x()
    Var t= tally(somestring,partstring,x()),lps=Len(partstring)
    If t=0 Or Len(somestring)=0 Or lps=0 Then Return 0
    Redim a(1 To t+1)
    a(1)=Mid(somestring,1,x(1)-1)
    For n As Long=1 To Ubound(x)-1
        a(n+1)= Mid(somestring,x(n)+lps,x(n+1)-x(n)-lps)
    Next n
    a(Ubound(a))=Mid(somestring,x(Ubound(x))+lps)
    Return t+1
End Function

Dim As String g="123 456 789 345666abcd45600"
Dim As String delim="456 789 345"
Redim As String s()

For n As Long=1 To 22
    g+=g  'inflate the string
Next

Print "Length of string ";Len(g)
Print
Dim As Double t=Timer
Var n=splitstring(g,delim,s())
If n Then
    Print Timer-t;"   seconds "
    Print
    print "index","value"

    For n As Long=Lbound(s) To 10
        Print n, s(n)
    Next
    Print ". . ."
    Print ". . ."
    For n As Long=Ubound(s) -10 To Ubound(s)
        Print n,s(n)
    Next
    Print
    Print "array dimensions ";Lbound(s);"  to  ";Ubound(s)
End If
Sleep
 

[SARG]

@Vinion
When you count the number of delimiters in the string store all the found positions that will avoid to redo instr() in the second part.....

[thrive4]

Welcome!

As dodicat suggested there are many ways to Rome..
Here is a some what older thread on the subject:
viewtopic.php?t=31691

I did a ever so slight tweak to the code of grindstone in the form of:

Code: Select all

' split or explode by delimiter return elements in array
Function explode(haystack As String = "", delimiter as string, ordinance() As String) As UInteger
    Dim As String text = haystack  'remind explode as working copy
    Dim As UInteger b = 1, e = 1   'pointer to text, begin and end
    Dim As UInteger x              'counter
    ReDim ordinance(0)             'reset array

    Do Until e = 0
      x += 1
      ReDim Preserve ordinance(x)         'create new array element
      e = InStr(e + 1, text, delimiter)   'set end pointer to next space
      ordinance(x) = Mid(text, b, e - b)  'cut text between the pointers and write it to the array
      b = e + 1                           'set begin pointer behind end pointer for the next word
    Loop

    Return x 'nr of elements returned

End Function

' sample code for calling the function explode
ReDim As String ordinance(0)
explode("The big brown fox jumped over; the lazy; dog", ";", ordinance())
print UBound(ordinance)
For x As Integer = 1 To UBound(ordinance)
    Print trim(ordinance(x))
Next

sleep
end

explode is a php variant of split
https://www.php.net/manual/en/function.explode.php

Bye the bye fxm has suggested including split to freebasic
quite recently...
viewtopic.php?p=284846#p284846

[marcov]

FPC is roughly the same as PHP explode, but called as a pseudo-method(*) on string, and does have the need to declare the array (res) explicitly, and currently has no upper maximum limit parameter (yet).

Code: Select all

var res :  TStringDynArray;
    s : string;

...
  s:='piece1 piece2 piece3 piece4 piece5 piece6';
  res:=s.split(' '); 
// now res is filled 0.. length(res)-1 (0..5 in the example) with the substrings. 

(*) string is not a class, but so called type helpers can extend static types with methods.

[dodicat]

Here is the pascal split in a 64 bit dll, along with the pascal code and freebasic test code, for anybody interested.
I have made the array a bit smaller, pascal split is a bit slower, and I didn't optimize the dll (forgot).

https://www.mediafire.com/file/7op6x9xe ... t.zip/file
EDIT:
Actually in the freebasic test code you don't need
dim shared as zstring * 10000000 ref
dim as any ptr s=@ref

you only need
dim as any ptr s
(you can get rid of the zstring * 10000000 ref)

[marcov]

You must also make sure the FB dynamic allocation and -free is inside the timed code. Otherwise it is apples and oranges.

[dodicat]

If my pascal code is sound, I know my fb code is sound, I only use string indexing and string functions (mid).
I could write the fb code in pascal ( AnsiMidStr) and string indexing.
sysutils split is quite slow.

[D.J.Peters]

@Vinion do you know strtok() from the FreeBASIC c runtime ?

C Runtime: https://www.freebasic.net/wiki/ProPgCruntime

Joshy

Code: Select all

#include "crt.bi"
var s1 = "don't reinvent the wheel we have the cool C-Runtime :lol:"
print s1

dim as string splits(any)
var p = strtok(strptr(s1),strptr(" "))
while (p)
  redim preserve splits(ubound(splits)+1)
  splits(ubound(splits)) = *p
  p = strtok(NULL,strptr(" "))
wend
print

for i as integer=0 to ubound(splits)
  print i & " " & splits(i)
next  
sleep

[fxm]

An nth version in pure FreeBASIC!
But compatible with zstring and string (supports null character).

Code: Select all

Sub split(Byref s1 As String, Byref s2 As String, splits(Any) As String)
    Dim As Integer n, n0 = 1
    Do
        Redim Preserve splits(Ubound(splits) + 1)
        n = Instr(n0, s1, s2)
        If n > 0 Then
            splits(Ubound(splits)) = Mid(s1, n0, n - n0)
            n0 = n + Len(s2)
        Else
            splits(Ubound(splits)) = Mid(s1, n0)
            Exit Do
        End If
    Loop
End Sub

Dim As String s1 = "reinvent the wheel " & Chr(0) & " in pure FreeBASIC :lol:"
Dim As String splits(Any)
Print s1
Print
split(s1, " ", splits())
For i As Integer = 0 To Ubound(splits)
    Print i & " '" & splits(i) & "'"
Next i

Sleep

[fxm]

Using the 'strtok' function can be dangerous !

If you use it, you should know that:
- The character string to split must not be constant because it is modified with each call to the 'strtok' function.
- As we have just said, at the end of the extraction, you can no longer exploit the content of the first parameter because the original string has been altered (by replacing the first character of each delimiter in the string with a null character).
- The 'strtok' function is not thread-safe. This means that it should not be used in parallel by multiple threads, because it uses a single pointer (a static local variable) to the string to be split, which is incompatible with nested calls.

[caseih]

strtok_r is a thread-safe version on posix operating systems linux Linux. Windows provides strtok_s which is the same thing. These functions take an extra argument where you pass in a buffer that strtok can use.

[fxm]

The C-Runtime 'strtok' function can be emulated in pure FreeBASIC by:

Code: Select all

Function strtok(Byval pz1 As Zstring Ptr, Byval pz2 As Zstring Ptr) As Zstring Ptr
    Static As Zstring Ptr pz
    Dim As Integer n
    If pz1 > 0 Then
        pz = pz1
    End If
    If (pz <> 0) Andalso (*pz <> "") Then
        n = Instr(1, *pz, *pz2)
        If n > 0 Then
            pz[n - 1] = 0
            n += Len(*pz2) - 1
        Else
            n = Len(*pz)
        End If
        pz += n
        Return pz - n
    Else
        Return 0
    End If
End Function