## A\$="123,45,1,89,22" how do I get column 4, which is 89?

New to FreeBASIC? Post your questions here.
pagetelegram
Posts: 21
Joined: May 06, 2019 17:34
Location: Chicago
Contact:

### A\$="123,45,1,89,22" how do I get column 4, which is 89?

A\$="123,45,1,89,22" how do I get column 4, which is 89? Is there a function to specify columns built in or do I need to create this function?

Using -lang qb flag

Thanks
Posts: 2140
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: A\$="123,45,1,89,22" how do I get column 4, which is 89?

pagetelegram wrote:A\$="123,45,1,89,22" how do I get column 4, which is 89? Is there a function to specify columns built in or do I need to create this function?
Using -lang qb flag

Freebasic has no build-in split function, but several can be found here (on the forum) in the default freebasic syntax.
For example, this one from MrSwiss: viewtopic.php?f=2&t=28410&p=269935#p269942
Example use:

Code: Select all

`' this is part of my: String_Procs.bi -- (c) 2019, MrSwiss#Include "crt/string.bi"                ' needed for: SplitString()Private Function SplitString( _         ' uses CRT's strtok() Function    ByRef ssrc  As Const String, _      ' string to be searched    ByRef chrs  As Const String, _      ' character(s), to search for          res() As String _             ' result String array (ByRef, implicit!)    ) As Long                           ' negative = error | >= 0 = OK    Dim As Long     retv = 0            ' to hold return value    If Len(chrs) = 0 Then retv -= 2     ' nothing to search for, set err    If Len(ssrc) = 0 Then retv -= 1     ' no source string, set err    If retv < 0 Then Return retv        ' return ERROR code (negative value)    Erase(res)                          ' delete dyn. array's content (if any)    Dim As String       s = ssrc        ' local variables: s = keeps ssrc    Dim As ZString Ptr  psz = 0         ' result ptr (from strtok())    Dim As UInteger     i = 0           ' counter, used as: array-index    psz = strtok(s, chrs)               ' destroys s (must be reset! before reuse)    While psz                           ' just to get required array size        i += 1 : psz = strtok(0, chrs)  ' i - 1 = UBound(res)    Wend    retv = i - 1                        ' set arrays upper bound (return value)    ReDim res(0 To retv)                ' size array (using retv)    i = 0 : s = ssrc : psz = 0          ' reset i, s and psz (for next run)    psz = strtok(s, chrs)               ' get first token (string-part)    While psz                           ' run until psz is = 0        res(i) = *psz                   ' assign token to array        psz = strtok(0, chrs)           ' get next token (string-part)        i += 1                          ' increment index    Wend    Return retv                         ' upper array bound (lower = 0 = default)End Function'example usedim as string inputStr = "123, 45, 1 ,89,   22; 111, 222"dim as string splitChars = ",; " 'comma, semi-colon, spacedim as string outputStr()SplitString(inputStr, splitChars, outputStr())for i as integer = 0 to ubound(outputStr)    print "Index " & i & " = '" & outputStr(i) & "'"next`
Lost Zergling
Posts: 331
Joined: Dec 02, 2011 22:51
Location: France

### Re: A\$="123,45,1,89,22" how do I get column 4, which is 89?

Using #Lang FB

Code: Select all

`' this is part of my: String_Procs.bi -- (c) 2019, MrSwiss #Include "crt/string.bi"                ' needed for: SplitString()'# Lang "qb"Private Function SplitString( _         ' uses CRT's strtok() Function    ByRef ssrc  As Const String, _      ' string to be searched    ByRef chrs  As Const String, _      ' character(s), to search for          res() As String _             ' result String array (ByRef, implicit!)    ) As Long                           ' negative = error | >= 0 = OK    Dim As Long     retv = 0            ' to hold return value    If Len(chrs) = 0 Then retv -= 2     ' nothing to search for, set err    If Len(ssrc) = 0 Then retv -= 1     ' no source string, set err    If retv < 0 Then Return retv        ' return ERROR code (negative value)    Erase(res)                          ' delete dyn. array's content (if any)    Dim As String       s = ssrc        ' local variables: s = keeps ssrc    Dim As ZString Ptr  psz = 0         ' result ptr (from strtok())    Dim As UInteger     i = 0           ' counter, used as: array-index    psz = strtok(s, chrs)               ' destroys s (must be reset! before reuse)    While psz                           ' just to get required array size        i += 1 : psz = strtok(0, chrs)  ' i - 1 = UBound(res)    Wend    retv = i - 1                        ' set arrays upper bound (return value)    ReDim res(0 To retv)                ' size array (using retv)    i = 0 : s = ssrc : psz = 0          ' reset i, s and psz (for next run)    psz = strtok(s, chrs)               ' get first token (string-part)    While psz                           ' run until psz is = 0        res(i) = *psz                   ' assign token to array        psz = strtok(0, chrs)           ' get next token (string-part)        i += 1                          ' increment index    Wend    Return retv                         ' upper array bound (lower = 0 = default)End FunctionDeclare Function StrToArray(STR_LigneFichier As String, MyStrArray() As String, sep As String=";", MaxFields As uShort=65535) As ByteFunction StrToArray(STR_LigneFichier As String, MyStrArray() As String, sep As String=";", MaxFields As uShort=65535) As Byte    Dim As zString Ptr Pz1=StrPtr(STR_LigneFichier), Pz2=Pz1    Dim As uInteger iLen=Len(STR_LigneFichier), iCumul=0, iCumul2=0    Dim As uShort NbFields=Ubound(MyStrArray)+1, i=0        Dim As uByte ubSep=Asc(sep)    If NbFields=0 Then : Redim MyStrArray(10) : End If    While iLen>iCumul2        While iLen>iCumul2+iCumul And (*Pz1)<>ubSep : Pz1+=1 : iCumul+=1 : Wend        (*Pz1) = 0 ' ? i & " -- " & NbFields : sleep        If NbFields=i Then : Redim Preserve MyStrArray(i+10) : NbFields=i+10 : End If        MyStrArray(i)=*Pz2 : i+=1        (*Pz1) = ubSep        If MaxFields=i Then : Return 1 : End If        Pz1+=1 : iCumul+=1 : Pz2+=iCumul        iCumul2+=iCumul : iCumul=0    Wend    Return 1End Function'example useDim as String inputStr = "123, 45, 1 ,89,   22, 111, 222"Dim as String splitChars = ",; " 'comma, semi-colon, spaceDim as String outputStr() ' use only var size arrays or implement exception handling Dim as Integer iDim as Double Start? "-------------------------------"Start=TimerFor i=1 To 50000    SplitString(inputStr, splitChars, outputStr())Next iFor i as integer = 0 to ubound(outputStr)    print "Index " & i & " = '" & outputStr(i) & "'"    outputStr(i) =""Next? "Using StrTok = " & Timer-Start? "-------------------------------"Start=TimerFor i=1 To 50000    StrToArray(inputStr, outputStr(), splitChars)Next ifor i as integer = 0 to ubound(outputStr)    print "Index " & i & " = '" & outputStr(i) & "'"next? "Using FB Pointers = " & Timer-Start? "-------------------------------"sleep`

Using #Lang "QB"

Code: Select all

`# Lang "qb"'Renvoi le nombre de ";"+1Declare Function StrUbound(STR_LigneFichier As String, STR_Motif As String=";") As IntegerFunction StrUbound(STR_LigneFichier As String, STR_Motif As String=";") As Integer    Dim As Integer t,k, Posi    t=0 : k=1 :  posi=1    While k<>0 : k=Instr(Posi,STR_LigneFichier, STR_Motif) : Posi=k+1 : t+=1 : Wend    StrUbound = tEnd Function'Renvoie la valeur n° Posi de la chaine STR_LigneFichier séparé par SEPAR (;) le premier champs est indicé 0 (comme les colonnes)Declare Function GetField(STR_LigneFichier As String="", Posi As Integer, sep As String=";") As StringFunction GetField(STR_LigneFichier As String="", Posi As Integer, sep As String=";") As String    Dim As Integer i, i_prev, NumField, NumPos    i=0 : NumField=0 : NumPos = Posi+1     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= Right\$( Left\$(STR_LigneFichier, i-1), i-i_prev-1)     Else         GetField = ""                    End IfEnd FunctionDim as string inputStr : inputStr= "123, 45, 1 ,89,   22, 111, 222"Dim as string splitChars:  splitChars= "," 'comma, onlyDim as Integer i, i_Ubound, kStart=Timer? "-------------------------------"For k=1 To 5000    i_Ubound=StrUbound(inputStr,",")    Redim outputStr(i_Ubound-1) As String    For i=0 To i_Ubound-1        outputStr(i)=GetField(inputStr, i, ",")    Next iNext kFor i=0 to i_Ubound-1    print "Index " & i & " = '" & outputStr(i) & "'"Next? "Using QB dialect = " & Timer-Start? "-------------------------------"sleep`

Added : this one (#Lang "FB") is doing trim on spaces on the fly
Bugged - see new version below - re-edited

Code: Select all

`Private Function StrToArray(STR_LigneFichier As String, MyStrArray() As String, sep As String=";", MaxFields As uShort=65535) As Byte    Dim As zString Ptr Pz1=StrPtr(STR_LigneFichier), Pz2=Pz1, Pz3    Dim As uInteger iLen=Len(STR_LigneFichier), iCumul=0, iCumul2=0, k=0, l=0    Dim As uShort NbFields=Ubound(MyStrArray)+1, i=0        Dim As uByte ubSep=Asc(sep), uBtmp=0    If NbFields=0 Then : Redim MyStrArray(10) : End If    While iLen>iCumul2                While iLen>iCumul2+iCumul And (*Pz1)<>ubSep : Pz1+=1 : iCumul+=1 : Wend        Pz3=Pz1 : Pz1-=1 : If (*Pz1) = 32 Then : uBtmp=1 : End If        While  (*Pz1) = 32 :  Pz1-=1 : iCumul2+=1 : l+=1 : Wend : Pz1+=1        If uBtmp=1 Then : uBtmp=(*Pz1) : End If        (*Pz1) = 0        If NbFields=i Then : Redim Preserve MyStrArray(i+10) : NbFields=i+10 : End If        While (*Pz2) = 32 : Pz2+=1 : k+=1 : Wend        MyStrArray(i)=*Pz2 : i+=1        If uBtmp=0 Then : (*Pz1) = ubSep : Else : (*Pz1) = uBtmp : End If                Pz1=Pz3         If MaxFields=i Then : Return 1 : End If        Pz1+=1  : iCumul+=1-k : Pz2+=iCumul        iCumul2+=iCumul-l : iCumul=0 : k=0 : l=0 : uBtmp=0    Wend    Return 1End Function`

(significantly faster)
Last edited by Lost Zergling on May 17, 2020 23:19, edited 1 time in total.
MrSwiss
Posts: 3599
Joined: Jun 02, 2013 9:27
Location: Switzerland

### Re: A\$="123,45,1,89,22" how do I get column 4, which is 89?

@Lost Zergling,

if you have to make comparisons then, try to stay fair:
• compare only: apples vs. apples (stuff with the same functionality)
• make a sensible comparison (NOT: apples vs. oranges)
Yours is only taking a single 'separator', mine can take multiple 'separators' at once.
Lost Zergling
Posts: 331
Joined: Dec 02, 2011 22:51
Location: France

### Re: A\$="123,45,1,89,22" how do I get column 4, which is 89?

Hello Mr Swiss. Nice to see you. :-)
dodicat
Posts: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: A\$="123,45,1,89,22" how do I get column 4, which is 89?

If your separator is always a comma then perhaps a custom function would do.

Code: Select all

`#lang "qb"Function column(SomeString As String,num As Long) As String  Dim As Long count  count=1  Dim As Long position,p  position=Instr(SomeString,",")  If position=0 Then column= ""  If num=1 Then   column= Mid\$(Somestring,1,position-1)  else  position=0  Do    count+=1    position=Instr(position+1,SomeString,",")    If position=0 Then Exit Do    If count=num Then      p=position      position=Instr(position+1,SomeString,",")       column= Mid\$(Somestring,p+1,position-p-1):exit function    End If  Loop   end ifEnd FunctionFor n As Long = 1 To 8  Print n,column("123,45,1,89,22,-543,0,finished",n)Next nsleep `
jevans4949
Posts: 1156
Joined: May 08, 2006 21:58
Location: Crewe, England

### Re: A\$="123,45,1,89,22" how do I get column 4, which is 89?

You could use the C function sscanf (in crt/stdio library) and ingnore the first three values
Lost Zergling
Posts: 331
Joined: Dec 02, 2011 22:51
Location: France

### Re: A\$="123,45,1,89,22" how do I get column 4, which is 89?

Previous StrToArray bugged, new one :

Code: Select all

`Declare Function StrUbound(STR_LigneFichier As String, STR_Motif As String=";") As IntegerFunction StrUbound(STR_LigneFichier As String, STR_Motif As String=";") As Integer    Dim As Integer t,k, Posi    t=0 : k=1 :  posi=1    While k<>0 : k=Instr(Posi,STR_LigneFichier, STR_Motif) : Posi=k+1 : t+=1 : Wend    StrUbound = tEnd FunctionFunction column(SomeString As String,num As uShort) As String  Dim As uShort count  count=1  Dim As uShort position,p  position=Instr(SomeString,",")  If position=0 Then column= ""  If num=1 Then  column= Mid(Somestring,1,position-1)  else  position=0  Do    count+=1    position=Instr(position+1,SomeString,",")    If position=0 Then Exit Do    If count=num Then      p=position      position=Instr(position+1,SomeString,",")      column= Trim( Mid(Somestring,p+1,position-p-1) ) : exit function    End If  Loop  end ifEnd FunctionPrivate Function StrToArray(STR_LigneFichier As String, MyStrArray() As String, sep As String=";", MaxFields As uShort=65535) As Byte    Dim As zString Ptr Pz1=StrPtr(STR_LigneFichier), Pz2=Pz1, Pz3    Dim As uInteger iLen=Len(STR_LigneFichier), iCumul=0, iCumul2=0, k=0 ' , l=0    Dim As uShort NbFields=Ubound(MyStrArray)+1, iTmp=0        Dim As uByte ubSep=Asc(sep), uBtmp=0    If NbFields=0 Then : Redim MyStrArray(1) : End If    While iLen>iCumul2        While iLen>iCumul2+iCumul And (*Pz1)<>ubSep : Pz1+=1 : iCumul+=1 : Wend        Pz3=Pz1 : Pz1-=1        While  (*Pz1) = 32 :  Pz1-=1 : uBtmp=1: Wend : Pz1+=1  ' iCumul2+=1 : l+=1 :                  If uBtmp=1 Then : uBtmp=(*Pz1) : End If        (*Pz1) = 0               While (*Pz2) = 32 : Pz2+=1 : k+=1 : Wend                MyStrArray(iTmp)=*Pz2 :         If Ubound(MyStrArray)=iTmp Then : Redim Preserve MyStrArray(iTmp+1) : End If        iTmp+=1 :         If uBtmp=0 Then : (*Pz1) = ubSep         Else : (*Pz1) = uBtmp : uBtmp=0         End If                Pz1=Pz3         If MaxFields=iTmp Then : Return 0 : End If        Pz1+=1  : iCumul+=1-k : Pz2+=iCumul        iCumul2+=iCumul+k : iCumul=0 : k=0 :'  l=0 :     Wend    Return 1End FunctionDim as String inputStr : inputStr = "123, 45, 1 ,89,   22      , 111, 222      ,                         123   ,    45, 1 ,   123   ,   45                         , 1,123, 45, 1,               89            ,   22         , 111, 222    ,    KOPMLN654         ,                           PMLN65KOPMLN65KOPMLN65JOK         "Dim as string splitChars:  splitChars= "," 'comma, onlyDim as String outputStr() Dim as Double StartDim as Integer i, i_Ubound, kDim As Double FBptr, ColumsStart=Timer? "-------------------------------" ' i_Ubound=StrUbound(inputStr,",") ' Redim outputStr(i_Ubound-1) As StringFor i=1 To 50000        StrToArray(inputStr, outputStr(), splitChars)    Next ifor i=0 to ubound(outputStr)    print "Index " & i & " = '" & outputStr(i)  & "'" ' & " len=" & Len(outputStr(i))nextFBptr=Timer-Start? "Using FB Pointers = " & FBptr? "-------------------------------"Start=Timer? "-------------------------------"i_Ubound=StrUbound(inputStr,",")Redim outputStr(i_Ubound-1) As StringFor k=1 To 5000    For i=0 To i_Ubound-1        outputStr(i)= column(inputStr, i+1)     Next iNext kFor i=0 to ubound(outputStr)    print "Index " & i & " = '" & outputStr(i) & "'"NextColums=Timer-Start? "Using QB dialect (column) = " & Colums? "-------------------------------"If Colums<FBptr Then : ? "Dodi wins" : Else : ? "Contest" : End Ifsleepsystem`

The more % spaces to remove compared to not empty placeholders, the more Dodicat's code faster than Ptr one.
The more fields and not empty, the faster Ptr vs Dodicat's code.
Lost Zergling
Posts: 331
Joined: Dec 02, 2011 22:51
Location: France

### Re: A\$="123,45,1,89,22" how do I get column 4, which is 89?

Finally, here is my latest version of StrToArray (#Lang FB), I added support for Chr (0). It is interesting to compete with the integrated functions of the language and I can trust Dodicat to use them at best.

Code: Select all

`Function StrToArray(STR_LigneFichier As String, MyStrArray() As String, sep As String=";", MaxFields As uShort=65535) As Byte    Dim As zString Ptr Pz1=StrPtr(STR_LigneFichier), Pz2=Pz1, Pz3    Dim As uInteger iLen=Len(STR_LigneFichier), iCumul=0, iCumul2=0, k=0 , itot    Dim As uShort NbFields=Ubound(MyStrArray)+1, iTmp=0        Dim As uByte ubSep=Asc(sep), uBtmp=0    If NbFields=0 Then : Redim MyStrArray(1) : End If    While iLen>iCumul2        itot=iCumul2+iCumul        While iLen>itot And (*Pz1)<>ubSep : Pz1+=1 : If (*Pz1) = 0 Then : (*Pz1) = 32 : End If : itot+=1 : Wend        iCumul=itot-iCumul2        Pz3=Pz1 : Pz1-=1        While  (*Pz1) = 32 :  Pz1-=1 : uBtmp=1: Wend : Pz1+=1 :  If (*Pz1) = 0 Then : (*Pz1) = 32 : End If        If uBtmp=1 Then : uBtmp=(*Pz1) : End If        (*Pz1) = 0               While (*Pz2) = 32 : Pz2+=1 : k+=1 : Wend        MyStrArray(iTmp)=*Pz2 :         If Ubound(MyStrArray)=iTmp Then : Redim Preserve MyStrArray(iTmp+1) : End If        iTmp+=1 :         If uBtmp=0 Then : (*Pz1) = ubSep         Else : (*Pz1) = uBtmp : uBtmp=0         End If                Pz1=Pz3         If MaxFields=iTmp Then : Return 0 : End If        Pz1+=1  : iCumul+=1-k : Pz2+=iCumul               iCumul2+=iCumul+k : iCumul=0 : k=0     Wend    Return 1End Function`

I did a few tests, and here are my findings:
The compliant qb code is faster for removing white spaces and processing repetitive data (the compiler must be able to better optimize the use of the memory cache), the code with pointers regains the advantage as soon as the input data is differentiated and complete. It should be noted that the test always loops on the same character string, a case which perhaps favors the code "qb"
Otherwise :
- Mixing Mid or Instr type functions with pointers in the same block seems to cause pointer code to slow down, I think that the compiler can better find an optimization on homogeneous code.
- Conversely, I was able to note at times a slowdown (x3) in the "qb" code, but that seems fairly inexplicable!
The measurements seem a bit random and dependent on the input data and the optimization at that time.
The philosophy of use is different: to take a comparison, the standard basic code (qb) is a bit of a small turbo, the c-like code (pointers) is precision mechanics.
Fb is a powerful language that brings the two together by limiting the damage. In fact, all this, we already knew, it's just that we don't always think about it.
fxm
Posts: 9912
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: A\$="123,45,1,89,22" how do I get column 4, which is 89?

Maybe @pagetelegram was just looking for a simple and short code, in -lang qb.

Example of code using recursion:

Code: Select all

`#Lang "qb"  '' useless if compiled with option -lang qbFunction ExtractNthItem (Byref s As String, Byval n As Integer) As String    Dim As Integer d    d = Instr(s, ",")    If n = 0 Then        If d = 0 Then ExtractNthItem = s Else ExtractNthItem = Left\$(s, d - 1)    Else        If d = 0 Then ExtractNthItem = "" Else ExtractNthItem = ExtractNthItem(Mid\$(s, d + 1), n - 1)    End IfEnd FunctionPrint ExtractNthItem("123,45,1,89,22", 3)Sleep`

Similar code but works with any string separating the items:

Code: Select all

`#Lang "qb"  '' useless if compiled with option -lang qbFunction ExtractNthItem (Byref s As String, Byval n As Integer, Byref sep As String = ",") As String    Dim As Integer d    d = Instr(s, sep)    If n = 0 Then        If d = 0 Then ExtractNthItem = s Else ExtractNthItem = Left\$(s, d - 1)    Else        If d = 0 Then ExtractNthItem = "" Else ExtractNthItem = ExtractNthItem(Mid\$(s, d + Len(sep)), n - 1, sep)    End IfEnd FunctionPrint ExtractNthItem("123,45,1,89,22", 3), ExtractNthItem("123;,:45;,:1;,:89;,:22", 3, ";,:")Sleep`
Last edited by fxm on May 19, 2020 15:02, edited 1 time in total.
paul doe
Posts: 1263
Joined: Jul 25, 2017 17:22
Location: Argentina

### Re: A\$="123,45,1,89,22" how do I get column 4, which is 89?

@fxm: nice. A non-recursive version, along with some test code:

Code: Select all

`#lang "qb"'' Enable return from proceduresoption nogosub/'  Returns the number of elements in a string, using  'sep' as character separators.'/function _  elementsOf( _    byref s as const string, _    byref sep as const string => ";,:" ) _  as integer    dim as integer _    count, sp, ep    count => 0  sp => 1  ep => 0    ep => inStr( sp, s, any sep )    do while( ep > 0 )    count +=> 1        sp => ep + 1    ep => inStr( sp, s, any sep )  loop    return( __iif( len( s ), count + 1, 0 ) )end function/'  Returns the Nth element of a string separated with  any of the 'sep' characters.   0 based, non recursive.'/function _  Nth( _    byval index as integer, _    byref s as const string, _    byref sep as const string => ";,:" ) _  as string   dim as integer _    sp, ep, count   sp => 1  ep => 0  count => 0   ep => inStr( sp, s, any sep )   do while( ep > 0 )    count +=> 1       if( count - 1 = index ) then      return( mid\$( s, sp, ep - sp ) )    end if       sp => ep + 1    ep => inStr( sp, s, any sep )  loop   return( __iif( index <= count, _    mid\$( s, sp, len( s ) - sp + 1 ), "" ) )end function'' Disable return from proceduresoption gosub/'  Test code'/dim as string _  ss => "foo,bar;baz:foobar"? "Testing..."? "Elements: " & elementsOf( s )? Nth( -1, s ) '' The string as-is (any negative index)? Nth( 0, s )  '' First element? Nth( 1, s )  '' Second element? Nth( 2, s )  '' Third element? Nth( 3, s )  '' Fourth element? Nth( 4, s )  '' Empty string, out of range?s => "foo"? Nth( 0, s ) '' The string as-is; no separators? Nth( 1, s ) '' Empty string?s => ""? Nth( -1, s ) '' Empty string? Nth( 0, s ) '' Empty string? Nth( 1, s ) '' Empty stringsleep()`