function Split

[ptitjoz]

Hello

Do you have a function that cuts a string in a array?

example :
s:="aaaa;bbbbbb;ccccc;ddddddd;eeeeee"

call funtion split...

result :
t[1] "aaaa"
t[2] "bbbbbb"
t[3] "ccccc"
t[4] "ddddddd"
t[5] "eeeeee"

Regards

[MrSwiss]

Just a few tips on correct FB syntax.

Example:

Code: Select all

Dim As String  s = "aaaa;bbbbbb;ccccc;ddddddd;eeeeee"
Dim As String  t(0 To 4)  ' String array (5 elements)

Expected result:

Code: Select all

t(0) = "aaaa"
t(1) = "bbbbbb"
t(2) = "ccccc"
t(3) = "ddddddd"
t(4) = "eeeeee"

[Roland Chastain]

Hello!

You should find what you need here. ;)

[Roland Chastain]

Other examples:

https://www.freebasic-portal.de/porticu ... -1573.html
https://www.freebasic-portal.de/code-be ... t-156.html
https://www.freebasic-portal.de/code-be ... r-157.html

[dodicat]

This was done for large strings and splitting around any character of a deliminator string.

Code: Select all

Function StringSplit(s_in As String,chars As String,result() As String) As Long
    Dim As Long ctr,ctr2,k,n,LC=len(chars)
    dim As boolean tally(Len(s_in))
    #macro check_instring()
        n=0
        while n<Lc
        If chars[n]=s_in[k] Then 
        tally(k)=true
        If (ctr2-1) Then ctr+=1
        ctr2=0
        exit while
        end if
        n+=1
       wend
    #endmacro
   
    #macro split()
    If tally(k) Then
        If (ctr2-1) Then ctr+=1:result(ctr)=Mid(s_in,k+2-ctr2,ctr2-1)
        ctr2=0
    End If
    #endmacro
    '==================  LOOP TWICE =======================
    For k  =0 To Len(s_in)-1
        ctr2+=1:check_instring()
    Next k
    If ctr Then Redim result(1 To ctr): ctr=0:ctr2=0 Else  Return 0
    For k  =0 To Len(s_in)-1
        ctr2+=1:split()
    Next k
    '===================== Last one ========================
    If ctr2>0 Then
        Redim Preserve result(1 To ctr+1)
        result(ctr+1)=Mid(s_in,k+1-ctr2,ctr2)
    End If
    Return Ubound(result)
End Function

dim as string s="aaaa;bbbbbb;ccccc;ddddddd;eeeeee"
redim as string t()
if StringSplit (s,";",t()) =0 then print "Error":sleep:end
for n as long=lbound(t) to ubound(t)
    print n,t(n)
    next
  

[D.J.Peters]

Code: Select all

#include "crt.bi"

var s = "aaaa;bbbbbb;ccccc;ddddddd;eeeeee", d = ";"
var p = strtok(s,d)
while(p) : print *p :	p = strtok(0,d) : wend
print 

s = "aaaa bbbbbb,ccccc;ddddddd_eeeeee" : d = " ,;_"
p = strtok(s,d)
while(p) : print *p : p = strtok(0,d) : wend
sleep

[ptitjoz]

Hello
Many solutions have arrived! thank you all.
As I am a little self taught I looked at this code (a little modified) because it seems efficient and easy encoding.
Some small questions: Thanks D.J.Peters
I thought it was necessary to declare the variables by DIM but apparently using var it can simplify.
p is a pointer variable? How can it be declared? without affecting it directly?
Here is the modified code. What do you think ?
Regards

Code: Select all

' test Split FreeBasic sous Linux 

#include "crt.bi"

var s = "aaaa;bbbbbb;ccccc;ddddddd;eeeeee" : 'chaine à découper 
var d = ";"
var p = strtok(s,d) : 'extraire l'adresse du premier élément
var i=0

Dim As String Tableau(1 to 10) : 'tableau de stockage 
While(p) 
	i=i+1
	Tableau(i)=*p
	Print i,Tableau(i)
	p = strtok(0,d) : ' extraire adresse élément suivant
Wend

[fxm]

Code: Select all

dim as zstring ptr p = strtok(s,d) : 'extraire l'adresse du premier élément

[fxm]

For information, without using any implicit declaration with initializer or automatic conversion when passing parameter:

Code: Select all

' test Split FreeBasic sous Linux

#include "crt.bi"

dim as string s = "aaaa;bbbbbb;ccccc;ddddddd;eeeeee" : 'chaine à découper
dim as string d = ";"
dim as zstring ptr p = strtok(strptr(s),strptr(d)) : 'extraire l'adresse du premier élément
dim as integer i=0

Dim As String Tableau(1 to 10) : 'tableau de stockage
While(p)
   i=i+1
   Tableau(i)=*p
   Print i,Tableau(i)
   p = strtok(0,strptr(d)) : ' extraire adresse élément suivant
Wend

- Implicit declaration:
see VAR documentation page.

- Automatic conversion when passing parameter:
any string type argument may be directly passed to a procedure referring to a parameter declared as 'zstring ptr'. The compiler performs itself an automatic conversion (without warning message) between any string type argument and the 'zstring ptr' type parameter.

[MrSwiss]

And the same as a Sub (OP asked for a procedure, in opening post):

Code: Select all

' StrSplit_Sub_test.bas -- 2018-04-09,MrSwiss
'
' compile: -s console
'
'
#Include "crt.bi"   ' IMPORTANT: won't work without it !!!

Declare Sub StrSplit( ByRef ssrc As String, ByRef chrs As String, res() As String )

' ===== start test/demo code =====
Dim As String   tst = "aaaaaa; bbbb_cccccc;ddddd'eeeee", _  ' source string
                schr = " ;_'", _        ' search-character's
                res(Any)                ' not initialized, dynamic array

StrSplit( tst, schr, res() )            ' Sub call (get the string's part's)
For i As UInteger = LBound(res) To UBound(res)  ' we don't know the array's sizes
    Print res(i)                        ' show result's (if any!)
Next

Sleep                                   ' wait for a user key press (prog. exit)
' ===== end test/demo code =====

' ----- implementation -----
Sub StrSplit( _                         ' uses CRT's strtok() Function
    ByRef ssrc  As String, _            ' string to be searched
    ByRef chrs  As String, _            ' character(s), to search for
    res() As String _                   ' result String array (ByRef, implicit!)
    )
    Dim     As String       s           ' local variables: s = keeps ssrc
    Dim     As ZString Ptr  p           ' result ptr (from strtok())
    Dim     As ULong        i = 0       ' counter, used as: array-index
    ReDim   As String       res(i)      ' size array, first element = 0
    ' first ERROR checking (quit, on ERROR!!!)
    If Len( ssrc ) > 0 Then s = ssrc Else Exit Sub
    If Len( chrs ) = 0 Then Exit Sub
    ' from here, the real action starts ....
    p = strtok(s, chrs)                 ' get first token (string-part)
    While (p)                           ' run until p is = 0
        res(i) = *p                     ' assign to array
        i += 1                          ' incr. counter
        ReDim Preserve res(i)           ' resize array, keep content!
        p = strtok(0, chrs)             ' get next token (string-part)
    Wend
End Sub
' ----- end implementation -----
' ----- EOF -----

What do you think ?

Don't use var, until you've learned proper data-types, and their use!
After that, read up on behavior of var (depends on assignment!).
Remove all (the unneeded/unwanted) colon's (its line-continuation in FB!).

[dodicat]

Mr Swiss
If you do
For i As UInteger = LBound(res) To UBound(res) ' we don't know the array's sizes
Print i,res(i) ' show result's (if any!)
Next
You see an extra blank at position 5
(Why uinteger as a counter?)

I think the strtok method would be very fast, but I have not tested.
Could I suggest the out array being (1 to something), and not (0 to something)
I know that in C you are stuck with (0 to something), but (1 to something) is more intuitive IMHO.
Also redim preserve is very slow.
Perhaps two loops, first to get the dimension of the out array, and the second to fill it.

Code: Select all

 
 'MrSwiss's code tweaked slightly:
Sub StrSplit( _                         ' uses CRT's strtok() Function
    ByRef ssrc  As String, _            ' string to be searched
    ByRef chrs  As String, _            ' character(s), to search for
    res() As String _                   ' result String array (ByRef, implicit!)
    )
    Dim     As String       s           ' local variables: s = keeps ssrc
    Dim     As ZString Ptr  p           ' result ptr (from strtok())
    Dim     As ULong        i = 0       ' counter, used as: array-index
    ' first ERROR checking (quit, on ERROR!!!)
    If Len( ssrc ) > 0 Then s = ssrc Else Exit Sub
    If Len( chrs ) = 0 Then Exit Sub
    ' from here, the real action starts ....
    p = strtok(s, chrs)                 ' get first token (string-part)
    While (p)                           ' run until p is = 0
        i += 1                          ' incr. counter
        p = strtok(0, chrs)             ' get next token (string-part)
    Wend
    redim res(1 to i)                   'prepare array and reset all
    i=0
    s=ssrc
     p = strtok(s, chrs)
     While (p)                           ' run until p is = 0
        res(i+1) = *p                     ' assign to array
        i += 1                          ' incr. counter
        p = strtok(0, chrs)             ' get next token (string-part)
    Wend
End Sub

I think that this (above) function should be tested thoroughly.
It is not obvious (to me), if incrementing the zstring pointer would not overwrite or leak in all cases.
I have not used strtok before.

[D.J.Peters]

(Sorry about my bad English)
Old long time programmers as I
don't do only copy and paste to learn.
We are READING documentation !
I know it's old school
but if a string function can return NULL
in FreeBASIC it must be a ZSTRING PTR.

But you all right it's the beginner section.

I will have it in mind next time.

Joshy

[MrSwiss]

You see an extra blank at position 5

Yes, currently the array contains a empty String, at the end.
However, instead of yet another Redim (speed), and also saving a Print,
(another LF, caused!), I've left it at that ...

The idea of a "sizing loop" first, then ReDim seems to be a better approach.
Starting with index 1, isn't a problem, just change initializer (i = 1).

Why uinteger as a counter?

You of all people, asking that? Really?
Don't you remember all the tests we've made, to figure out the "fastest" loop-counter's?
ULong = FBC x32
ULongInt = FBC x64
which results in: UInteger (for both compiler versions).

I'll give the code another try, incorporating above suggestions of yours ...

updated code:

Code: Select all

' StrSplit_Sub_test.bas -- 2018-04-09, MrSwiss
'
' compile: -s console
'
'
#Include "crt.bi"   ' IMPORTANT: won't work without it !!!

Declare Sub StrSplit( ByRef ssrc As String, ByRef chrs As String, res() As String )

' ===== start test/demo code =====
Dim As String   tst = "aaaaaa; bbbb_cccccc;ddddd'eeeee", _  ' source string
                schr = " ;_'", _        ' search-character's
                res(Any)                ' not initialized, dynamic array

StrSplit( tst, schr, res() )            ' Sub call (get the string's part's)
For i As UInteger = LBound(res) To UBound(res)  ' we don't know the array's sizes
    Print i; Tab(8); res(i)                     ' show result's (if any!)
Next

Sleep                                   ' wait for a user key press (prog. exit)
' ===== end test/demo code =====

' ----- implementation -----
Sub StrSplit( _                         ' uses CRT's strtok() Function
    ByRef ssrc  As String, _            ' string to be searched
    ByRef chrs  As String, _            ' character(s), to search for
    res() As String _                   ' result String array (ByRef, implicit!)
    )
    Dim     As String       s, s1       ' local variables: s = keeps ssrc
    Dim     As ZString Ptr  p           ' result ptr (from strtok())
    Dim     As ULong        i = 1       ' counter, used as: array-index
    ' first ERROR checking (quit, on ERROR!!!)
    If Len( chrs ) = 0 Then Exit Sub
    If Len( ssrc ) > 0 Then s = ssrc : s1 = ssrc Else Exit Sub
    ' obtain needed array size (dodicat's suggestion)
    p = strtok(s, chrs)                 ' destroys s (the reason for s1)
    While (p)
        i += 1
        p = strtok(0, chrs)
    Wend
    ReDim res(1 To i - 1) : i = 1 : p = 0   ' size array, reset i and p
    ' from here, the real action starts ....
    p = strtok(s1, chrs)                ' get first token (string-part)
    While (p)                           ' run until p is = 0
        res(i) = *p                     ' assign to array
        p = strtok(0, chrs)             ' get next token (string-part)
        i += 1
    Wend
End Sub
' ----- end implementation -----
' ----- EOF -----

[Lost Zergling]

In basic :

Code: Select all

Declare Function StrUbound(STR_LigneFichier As String, STR_Motif As String=";") As Integer
Function StrUbound(STR_LigneFichier As String, STR_Motif As String=";") As Integer
    Dim t As uLongInt=0 : Dim k As uLongInt=1 : Dim Posi As uLongInt=1
    While k<>0 : k=Instr(Posi,STR_LigneFichier, STR_Motif) : Posi=k+1 : t+=1 : Wend
    StrUbound = t
End Function

Declare Function GetField(STR_LigneFichier As String, Posi As uLongInt, sep As String=";", NumPos As uInteger, ByRef NumField As uInteger, ByRef i As uInteger, ByRef i_prev As uInteger) As String
Function GetField(STR_LigneFichier As String, Posi As uLongInt, sep As String=";", NumPos As uInteger, ByRef NumField As uInteger, ByRef i As uInteger, ByRef i_prev As uInteger) As String
    Do : i_prev=i : i=Instr(i_prev+1, STR_LigneFichier, sep) : NumField +=1 : Loop Until NumField=NumPos Or i=0    
    If i=0 Then : i=Len(STR_LigneFichier)+1 : End If 
    If NumField=NumPos Then : GetField = Mid(STR_LigneFichier, i_prev+1, i-i_prev-1)  ' Right( Left(STR_LigneFichier, i-1), i-i_prev-1) 
    Else GetField = "EMPTY" : End If 
End Function

Declare Sub Split(MyString As String, Str_Res() As String, sep As String=";") 
Sub Split(MyString As String, Str_Res() As String, sep As String=";") 
    Dim a As uInteger : Dim b As uInteger : Dim c As uInteger
    Dim i As uInteger : Dim ub As uInteger=StrUbound(MyString,";")-1
    ReDim As String  Str_Res(0 To ub)
    For i=0 To ub        
        Str_Res(i)=GetField(MyString, i, sep, i+1, a, b, c )   
    Next i
End Sub

Dim As String  MyString = "aaaa;bbbbbb;ccccc;ddddddd;eeeeee"
Dim Str_Res()  As String
Dim i As Integer

Split(MyString, Str_Res() )
For i=0 to Ubound(Str_Res)
    Print Str_Res(i)
Next i


print "Fin"
sleep
system

[UEZ]

Usually for such kind of tasks I would prefer regular expression but in FB this is not very comfortable to use.

Code: Select all

''
'' regular expression example
''

#Include "regex.bi"

Sub printmatches( Byval pattern As String, Byval buffer As String )
	Dim re As regex_t
	Dim pm As regmatch_t
	Dim pbuff As Zstring Ptr
	Dim res As Integer

	pbuff = Strptr( buffer )

	'' compile the pattern
	regcomp( @re, pattern, 0 )

	'' first match
	res = regexec( @re, pbuff, 1, @pm, 0 )
	Do While( res = 0 )
		Print Mid( *pbuff, 1 + pm.rm_so, pm.rm_eo - pm.rm_so )

		'' Next match
		pbuff += pm.rm_eo
		res = regexec( @re, pbuff, 1, @pm, REG_EXTENDED )
	Loop

	'' free the context
	regfree( @re )
End Sub

printmatches( "\(.*?\);", "aaaa;bbbbbb;ccccc;ddddddd;eeeeee;" )
Sleep

I would expect the result here is without ";" but I cannot tell why it is with ";". It shouldn't be hard to save the result to an array instead of printing it to the console.