SuperStrings v 1.99 : String Manipulation Utility Functions

User projects written in or related to FreeBASIC.
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

SuperStrings v 1.99 : String Manipulation Utility Functions

Postby rolliebollocks » Apr 26, 2009 13:46

UPDATE!

added StrReplace
~~~~~~~~~~~

*Searches string for key clump of characters and replaces it with new characters.

I wanted to consolidate all my string theory functions under one thread for ease of repeated updates. So here goes:

rb_strings.bas

Code: Select all

#include once "file.bi"
#include once "fbgfx.bi"
'///////////////////////////////////////////////////////////////////////////////
'                  Contact: dtolkacz@gmail.com  RolliBollocks2009
'///////////////////////////////////////////////////////////////////////////////
declare function isDelimiter ( inchr as ubyte ) as integer
declare function isPunctuation ( inchr as ubyte ) as integer
declare function isInStr ( strbig as const string, strlittle as const string ) as integer
declare Function IsInStr_BCM (Byref strbig As String,Byref strlittle As String, BADCHARMAX as integer = 0 ) As Uinteger
declare Function IsInStr_Naive ( strbig As String, strlittle As String ) As Integer
declare function isInStr_FZZY ( byref strlittle as const string, byref strbig as const string, fzzy as single = 0 ) as uinteger
declare Function IsInStr_OCC (Byref strbig As String,Byref strlittle As String, BADCHARMAX as integer ) As Uinteger
declare function isInStr_WORDIDX ( Byref strbig As String,Byref strlittle As String ) as uinteger
declare function Reverse ( instring as string ) as string
declare function RemChr ( instring as string, remasc as string ) as string
declare function RemWord ( indialog as string, byeword as string ) as string
declare function RemWordIdx ( indialog as string, index as integer ) as string
declare function GetWord ( inDialog as string, index as integer ) as string
declare function PutWord ( indialog as string, index as integer, newword as string ) as string
declare function ParamSwap ( byref instring as string, element as integer,  newparam as string ) as string
declare function CutLeftFrom_Char ( instring as string, idx as integer ) as string
declare function CutRightFrom_Char ( instring as string, idx as integer ) as string
declare function CutRightFrom ( instring as string, wordindexbgn as uinteger ) as string
declare function CutLeftFrom ( instring as string, wordindexend as uinteger ) as string
declare function CAR ( indialog as string ) as string
declare function CDR ( indialog as string ) as string
declare function StrReplace ( instring as string, old as string, newstr as string ) as string
declare function scramble ( instring as string ) as string
declare function WordCounter ( inDialog as string ) as integer
declare function GetCount ( inDialog as string, delim as ubyte ) as integer
declare function ArrayToLine ( inarray() as string ) as string
declare function GetLineCount ( filename as string ) as integer
declare function LoadFileAsString( byref filename as string ) as string
declare function Zleft ( s1 as zstring ptr, idx as integer ) as string
declare function Zright ( s1 as zstring ptr, idx as integer ) as string
declare function zAsc ( s1 as zstring ptr, idx as integer ) as ubyte
declare function zChr ( s1 as zstring ptr, idx as integer ) as string
declare function zstrTOstr ( s1 as zstring ptr ) as string
declare function strTOzstr ( byval s1 as string ) as zstring ptr 
declare function zstrIndexReturn ( s1 as zstring ptr, v1 as uinteger, v2 as uinteger ) as string
declare sub Print_Center ( instring as string, box_x as single , box_y as single, c as integer )
declare sub Make_Box ( inChr as string, box_x1 as single, box_x2 as single, box_y1 as single, box_y2 as single, c as integer )
declare function Stagger ( instring as string ) as string
'///////////////////////////////////////////////////////////////////////////////
enum TOKENS
    _TK_NULL        = asc("")
    _TK_TAB         = 9
    _TK_CR          = 13
    _TK_ENDOFLINE   = asc(!"\n")
    _TK_ENTER       = asc(!"\r")
    _TK_SPACE       = asc(" ")
    _TK_AMPERSAND   = asc("&")
    _TK_COMMA       = asc(",")
    _TK_STRING      = asc("$")
    _TK_INTEGER     = asc("%")
    _TK_PERCENT     = asc("%")
    _TK_AT          = asc("@")
    _TK_POUND       = asc("#")
    _TK_DOT         = asc(".")
    _TK_RPAREN      = asc(")")
    _TK_LPAREN      = asc("(")   
    _TK_PLUS        = asc("+")
    _TK_MINUS       = asc("-")
    _TK_ASTERISK    = asc("*")
    _TK_MULT        = asc("*")
    _TK_DIVIDE      = asc("/")
    _TK_FSLASH      = asc("/")
    _TK_BSLASH      = asc("\")
    _TK_UNDERSCORE  = asc("_")
    _TK_LBRACKET    = asc("[")
    _TK_RBRACKET    = asc("]")
    _TK_EQUAL       = asc("=")
    _TK_COMMENT     = asc("'")
    _TK_APOSTROPHE  = asc("'")
    _TK_LSET        = asc("{")
    _TK_RSET        = asc("}")
    _TK_PIPE        = asc("|")
    _TK_GREATERTHAN = asc(">")
    _TK_LESSTHAN    = asc("<")
    _TK_DBLQUOTE    = asc($"")
    _TK_QUESTION    = asc("?")
    _TK_EXCLAIM     = asc("!")
    _TK_COLON       = asc(":")
end enum
'-------------------------------------------------------------------------------
' Checks for the listed elements at a given point in any string, and returns -1
' for true, 0 for false
'-------------------------------------------------------------------------------
function isDelimiter ( inchr as ubyte ) as integer
    if inchr = _TK_ENDOFLINE _
    or inchr = _TK_TAB _
    or inchr = _TK_NULL _
    or inchr = _TK_CR _
    or inchr = _TK_SPACE then
        return -1
    else
        return 0
    endif
end function
'? isDelimiter(32)
'? isDelimiter(78):sleep
'-------------------------------------------------------------------------------
' Checks for the listed elements at a given point in any string, and returns -1
' for true, 0 for false
'-------------------------------------------------------------------------------
function isPunctuation ( inchr as ubyte ) as integer
    if inchr = _TK_ENDOFLINE _
    or inchr = _TK_SPACE _
    or inchr = _TK_DOT _
    or inchr = _TK_RPAREN _
    or inchr = _TK_LPAREN _
    or inchr = _TK_APOSTROPHE _
    or inchr = _TK_AMPERSAND _
    or inchr = _TK_TAB _
    or inchr = _TK_NULL _
    or inchr = _TK_CR _
    or inchr = _TK_QUESTION _
    or inchr = _TK_EXCLAIM _
    or inchr = _TK_COLON then
        return -1
    else
        return 0
    endif
end function
'-------------------------------------------------------------------------------
'Searches strbig for strlittle, and returns position (fastest)
'-------------------------------------------------------------------------------
function isInStr ( strbig as const string, strlittle as const string ) as integer
     Dim As Uinteger ll=Len(strlittle)-1, lb = Len(strbig) - 1, i=0,ii=0, position=0
     if strbig = strlittle then return 1
    For i   = 0 To lb
        If strbig[i] = strlittle[0] Then
            if strbig[i+ll] = strlittle[ll] then
                if i+ll <= lb then
                    position=i+1
                    For ii   = (i) To i + ( ll / 2 )
                        if strbig[ i+ll - ( ii-i ) ] <> strlittle [ll-(ii-i)] _
                        or strbig[ii] <> strlittle[ ii - i ] then
                            position=0:Exit For
                        endif
                    Next ii
                    i+=ll
                Endif
            endif
        endif
                If position Then Return position
            Next i
                Return 0
end function
'? isInStr ("dhfjkshlfjkdhsfjkhdsjkhfdjkshfjkldshjkfhdskjlhfdkjlshfjkdshlfds", "jkhdsjkhfdjkshfjkldshjkfhdskjlhfdkjlshfjkdshlf" ):sleep
'-------------------------------------------------------------------------------
'Searches strbig for strlittle
'-------------------------------------------------------------------------------
Function IsInStr_Naive ( strbig As String, strlittle As String ) As Integer
   
    dim as integer ll = len(strlittle)-1, lb = len(strbig)-1
    Dim As Integer OK = 0
    For i As Integer = 0 To lb
        If strbig[i] = strlittle[0] Then
            if strbig[i+ll] = strlittle[ll] then
                OK = i+1
                For ii As Integer = i To i+ll
                    If strbig[ii] <> strlittle[ ii - i ] Then OK = 0:Exit For
                Next
            else
                i+=ll
            endif
        Endif
        If OK Then Return OK
    Next
   
    Return OK
   
End Function
'-------------------------------------------------------------------------------
'Searches strbig for strlittle, allows for a bad character max which will return
'a false result as true if enough of the characters are similar
'-------------------------------------------------------------------------------
Function IsInStr_BCM (Byref strbig As String,Byref strlittle As String, BADCHARMAX as integer = 0 ) As Uinteger
    Dim As Uinteger position, bcm
     Dim ll As Uinteger=Len(strlittle)-1
     Dim lb As Uinteger=Len(strbig) - 1
     Dim As Uinteger i,ii     
     if strbig = strlittle then return 1
    For i   = 0 To lb
        If strbig[i] = strlittle[0] Then
            if strbig[i+ll] = strlittle[ll] then
                if i+ll <= lb then
                    position=i+1
                    For ii   = (i) To i + ( ll shr 1 )
                        if strbig[ i+ll - ( ii-i ) ] <> strlittle [ll-(ii-i)] _
                        or strbig[ii] <> strlittle[ ii - i ] then
                            bcm+=1
                            if bcm > BADCHARMAX then
                                position=0
                                Exit For
                            endif
                        endif                       
                    Next ii
                    bcm = 0
                    i+=ll
                Endif
            endif
        endif
                If position Then Return position
            Next i
                Return 0
End Function
'-------------------------------------------------------------------------------
'Searches strbig for strlittle, wherein strlittle is a whole word separated by a
'space, and it returns its position in reference to other whole words
'-------------------------------------------------------------------------------
function isInStr_WORDIDX ( Byref strbig As String,Byref strlittle As String ) as uinteger
   
    dim as integer i
   
    for i = 0 to GetCount ( strbig, _TK_SPACE )
        if GetWord ( strbig, i ) = strlittle then return i+1
    next
   
    return 0
   
end function
'-------------------------------------------------------------------------------
'searches strbig for strlittle and returns how many times the word occurs in the
'strbig string
'-------------------------------------------------------------------------------
Function IsInStr_OCC (Byref strbig As String,Byref strlittle As String, BADCHARMAX as integer ) As Uinteger
    Dim As Uinteger position, bcm, occ
     Dim ll As Uinteger=Len(strlittle)-1
     Dim lb As Uinteger=Len(strbig) - 1
     Dim As Uinteger i,ii
     
     if strbig = strlittle then return 1
     
    For i   = 0 To lb
        If strbig[i] = strlittle[0] Then
            if strbig[i+ll] = strlittle[ll] then
                if i+ll <= lb then
                    position=i+1
                    For ii   = (i) To i + ( ll shr 1 )
                        if strbig[ i+ll - ( ii-i ) ] <> strlittle [ll-(ii-i)] _
                        or strbig[ii] <> strlittle[ ii - i ] then
                            bcm+=1
                            if bcm > BADCHARMAX then
                                position=0
                                Exit For
                            endif
                        endif                       
                    Next ii
                    bcm = 0
                    i+=ll
                Endif
            endif
        endif
                If position Then occ+=1:position = 0
            Next i
                Return occ
End Function
'-------------------------------------------------------------------------------
'searches for the occurence of a word backward in a string, returns position
'-------------------------------------------------------------------------------
function IsInStrRev ( strbig as string, strlittle as string ) as uinteger
   
    strlittle = Reverse ( strlittle )
    function = isinstr ( strbig, strlittle )
   
end function
'-------------------------------------------------------------------------------
'returns the string written backward
'-------------------------------------------------------------------------------
function Reverse ( instring as string ) as string
   
    dim outstring as string = instring
    dim as integer l = len(instring) - 1
   
    for i as integer = 0 to l
        outstring[ l - i ] = instring[i]
    next

    return outstring

end function
'-------------------------------------------------------------------------------
'returns the string minus the character specified by remasc
'-------------------------------------------------------------------------------
function RemChr ( instring as string, remasc as string ) as string
    dim as string outstring = ""
    for i as integer = 0 to len(instring) - 1
        if instring[i] <> remasc[0] then outstring &= chr(instring[i])
    next
    return outstring
end function
'-------------------------------------------------------------------------------
'returns the string minus the word specified by byeword
'-------------------------------------------------------------------------------
function RemWord ( indialog as string, byeword as string ) as string

    dim as string outstring = ""
    dim as string text = indialog
   
    for i as integer = 0 to WordCounter ( text ) - 1
        if GetWord ( text, i ) <> byeword then
            outstring &= GetWord ( text, i ) & " "
        endif
    next
   
    return outstring

end function
'-------------------------------------------------------------------------------
'returns the string minus the word's index (position in string) specified by index
'-------------------------------------------------------------------------------
function RemWordIdx ( indialog as string, index as integer ) as string

    dim as string outstring = ""
   
    for i as integer = 0 to WordCounter (indialog)
        if i <> index then
            outstring &= GetWord ( indialog, i ) & " "
        endif
    next
   
    return outstring

end function
'-------------------------------------------------------------------------------
'gets a specified word in accord with specified index
'-------------------------------------------------------------------------------
function GetWord ( inDialog as string, index as integer ) as string

    dim as integer wordcount = 0
    dim as string word = ""
   
    indialog &= chr(32)
   
    if index = 0 then
        for i as integer = 0 to len(inDialog) - 1
            if isDelimiter ( inDialog[i] ) then
                return word
                exit function
            else
                word &= chr(inDialog[i])
            endif
        next
       
    endif
   
    for i as integer = 0 to len(inDialog) - 1
        if isDelimiter ( inDialog[i] ) then
            wordcount += 1
            if wordcount = index then
                for ii as integer = i+1 to len(inDialog) - 1
                    if isDelimiter ( inDialog[ii] ) then
                        word = RemChr (word," ")
                        return word
                    else
                        word &= chr(inDialog[ii])
                    endif
                next
            endif
        endif
    next
   
    return ""
                   
end function
'-------------------------------------------------------------------------------
'inserts a word at specified index
'-------------------------------------------------------------------------------
function PutWord ( indialog as string, index as integer, newword as string ) as string
   
    dim as integer wordcount = 0
    dim as string edit1 = indialog
    dim as string edit2 = indialog
   
    if index = 0 then
        edit1 = newword & " " & edit1
        return edit1
    endif
   
        for i as integer = 0 to len(inDialog) - 1
            if isDelimiter ( inDialog[i] ) then
                wordcount += 1
                if wordcount = index then
                    edit1 = zstrindexreturn ( strtozstr(indialog), 0, i )
                    edit2 = zstrindexreturn ( strtozstr(indialog), i+1, len(indialog)-1 )
                    edit1 &= " " & newword & " " & edit2
                    return edit1
                endif
            endif
        next
   
end function
'-------------------------------------------------------------------------------
'swaps a word with new word at specified index (element)
'-------------------------------------------------------------------------------
function ParamSwap ( byref instring as string, element as integer,  newparam as string ) as string

    instring = RemWordIdx ( instring, element )
    instring = PutWord ( instring, element, newparam )   
   
    return instring

end function
'-------------------------------------------------------------------------------
'returns a new string with old string's characters all shuffled up (requires
'randomize to be initialized)
'-------------------------------------------------------------------------------
function scramble ( instring as string ) as string
   
    dim as string outstring = space(len(instring))
    dim as integer i = 0, r = 0, l = len(instring) - 1
   
    do while isinstr ( outstring, " " )
        r = rnd * l
        if outstring[r] = 32 then
            outstring[r] = instring[i]
            i+=1
        endif
    loop
   
    return outstring
   
end function
'-------------------------------------------------------------------------------
'searches instring for old and replaces it with newstr
'-------------------------------------------------------------------------------
function StrReplace ( instring as string, old as string, newstr as string ) as string
   
    dim as integer spot = 0
    dim as string outstring = ""
   
    for i as integer = 1 to isinstr_OCC ( instring, old, 0 )
   
        spot = isinstr_naive ( instring, old ) - 1
        outstring &= cutleftfrom_char ( instring, spot ) & newstr
        instring = cutrightfrom_char ( instring, spot+len(old) )
        spot += len(old)
       
    next
   
    return outstring & instring
       
end function
'-------------------------------------------------------------------------------
'returns all the characters left of index idx
'-------------------------------------------------------------------------------
function CutLeftFrom_Char ( instring as string, idx as integer ) as string
   
    dim as string outstring
   
    for i as integer = 0 to idx - 1
        outstring &= chr(instring[i])
    next
   
    return outstring
   
end function
'-------------------------------------------------------------------------------
'returns all the characters right of index idx
'-------------------------------------------------------------------------------
function CutRightFrom_Char ( instring as string, idx as integer ) as string
   
    dim as string outstring
   
    for i as integer = idx to len(instring)-1
        outstring &= chr(instring[i])
    next
   
    return outstring
   
end function
'-------------------------------------------------------------------------------
'returns all words left of word index wordindexbgn
'-------------------------------------------------------------------------------
function CutRightFrom ( instring as string, wordindexbgn as uinteger ) as string
   
    dim as string outstring = ""
   
    for i as integer = wordindexbgn - 1 to WordCounter( instring )
        outstring &= GetWord( instring, i ) & chr(32)
    next
   
    function = outstring
   
end function
'-------------------------------------------------------------------------------
'returns all words right of word index wordindexbgn
'-------------------------------------------------------------------------------
function CutLeftFrom ( instring as string, wordindexend as uinteger ) as string
   
    dim as string outstring = ""
   
    for i as integer = 0 to wordindexend - 1
        outstring &= GetWord( instring, i ) & chr(32)
    next
   
    function = outstring
   
end function
'-------------------------------------------------------------------------------
'returns first element in a string list
'-------------------------------------------------------------------------------
function CAR ( indialog as string ) as string
    return GetWord ( indialog, 0)
end function
'-------------------------------------------------------------------------------
'returns all elements except the first element in a string list
'-------------------------------------------------------------------------------
function CDR ( indialog as string ) as string
    return RemWordIdx ( indialog, 0)
end function
'-------------------------------------------------------------------------------
'counts words in a string
'-------------------------------------------------------------------------------
function WordCounter ( inDialog as string ) as integer
    dim as integer wordcount
    indialog &= !"\n"
    for i as integer = 0 to len(inDialog) - 1
        if isPunctuation ( indialog[i] ) then
            if NOT isPunctuation ( indialog[i-1] ) then
                wordcount += 1
            endif
        endif
    next
    return wordcount
   
end function
'-------------------------------------------------------------------------------
'counts words in a string by specified delimeter
'-------------------------------------------------------------------------------
function GetCount ( inDialog as string, delim as ubyte ) as integer
    dim as integer wordcount
    indialog &= !"\n"
    for i as integer = 0 to len(inDialog) - 1
        if indialog[i] = delim then
            wordcount += 1
        endif
    next
    return wordcount
end function
'-------------------------------------------------------------------------------
'Makes an array of words from any given sentence
'-------------------------------------------------------------------------------
#Macro Str_LineToArray ( instring, varname )
    dim as integer wc##varname = GetCount ( instring, _TK_SPACE )
    redim as string varname ( wc##varname )
    for i as integer = 0 to wc##varname
        if GetWord ( instring, i) <> "" then varname(i) = GetWord ( instring, i)
    next
#endmacro
'-------------------------------------------------------------------------------
'Makes an array of strings into a single string
'-------------------------------------------------------------------------------
function ArrayToLine ( inarray() as string ) as string
    dim as string outstring = ""
   
    for i as integer = 0 to ubound(inarray)
        if inarray(i) <> "" then
            outstring &= inarray(i) & " "
        endif
    next
   
    return outstring
end function   
'-------------------------------------------------------------------------------
'Makes a multiline string into an array of lines
#macro Str_ToLineArray ( inscript, varname )
    dim as integer varname##linecount = GetCount(inscript, _TK_ENDOFLINE)
    dim as string varname##newline
    dim as string varname(varname##linecount)
    inscript &= !"\n"
    varname##linecount = 0   
    for i as integer = 0 to len(inscript)
        if inscript[i]  <> _TK_ENDOFLINE _
        and inscript[i] <> _TK_TAB _
        and inscript[i] <> _TK_CR _
        and inscript[i] <> _TK_NULL _
        and inscript[i] <> _TK_COLON then
            varname##newline &= chr(inscript[i])
        else
            varname(varname##linecount) = varname##newline
            varname##newline = "":varname##linecount += 1
        endif
        if varname##linecount >= ubound(varname) then exit for
    next 
#endmacro
'-------------------------------------------------------------------------------
'///////////////////////////File Stuff//////////////////////////////////////////
'Returns the amount of lines in a file
'-------------------------------------------------------------------------------
function GetLineCount ( filename as string ) as integer
  dim as integer f = freefile
  dim as integer count = 0
  dim as string nil
 
  if fileexists(filename) then
      open filename for input as #f
         while not eof(f)
             line input #f, nil
             count += 1
         wend
  else
      count = -1
  endif
  close #f
  return count
end function
'-------------------------------------------------------------------------------
'takes a file and loads into an array line by line
'-------------------------------------------------------------------------------
#Macro File_ToLineArray ( filename, varname )
    dim as string inscript = LoadFileAsString ( filename )
    inscript = RemChr ( inscript, chr(_TK_CR) )
    Str_ToLineArray ( inscript, varname )
#endmacro   
'-------------------------------------------------------------------------------
'loads a file into a string
'Borrowed from Jeff Marshall
'-------------------------------------------------------------------------------
function LoadFileAsString( byref filename as string ) as string

   dim x as string

   if( open( filename for input access read as #13 ) = 0 ) then
      close #13
      if( open( filename for binary access read as #13 ) = 0 ) then
         x = space( lof( 13 ))
         get #13,,x
         close #13
      else
         'print "Unable to open '" & filename & "'"
      end if
   else
        'print "File not found '" & filename & "'"
   end if

   function = x

end function
'-------------------------------------------------------------------------------
'returns all characters between index v1, and v2
'-------------------------------------------------------------------------------
function StrIndexReturn ( byval text as string, v1 as uinteger, v2 as uinteger ) as string
    if v1 = v2 then return chr(text[v1])
    if v1>v2 then
        dim as string result = ""
        for i as integer = v2 to v1
            result &= chr(text[i])
        next
        return result
    endif
    if v1<v2 then
        dim as string result = ""
        for i as integer = v2 to v1
            result &= chr(text[i])
        next
        return result
    endif
    return ""   
end function
'-------------------------------------------------------------------------------
'///////////////////////////Zstrings to strings functions///////////////////////
'Inspirational Quote:
'The end of the string is marked by a character 0 ASCII, this is automatically managed by
'the FreeBASIC string handling functions. A character 0 ASCII must never enter in the text
'of a Zstring or it will be truncated, as no descriptor exists. -FBWiki
function Zleft ( s1 as zstring ptr, idx as integer ) as string
    dim as string res = ""
    dim as zstring ptr temp = s1
    temp[idx] = 0
    res = zstrTOstr ( temp )
    return res   
end function
'-------------------------------------------------------------------------------
function zRight ( s1 as zstring ptr, idx as integer ) as string
    return zstrTOstr (s1[idx])
end function
'-------------------------------------------------------------------------------
function zAsc ( s1 as zstring ptr, idx as integer ) as ubyte
    return asc ( zleft ( zright ( s1, idx-1 ), 1 ) )
end function
'-------------------------------------------------------------------------------
function zChr ( s1 as zstring ptr, idx as integer ) as string
    return zleft ( zright ( s1, idx-1 ), 1 )
end function
'-------------------------------------------------------------------------------
function strTOzstr ( byval s1 as string ) as zstring ptr   
    return cast ( zstring ptr, @s1 )
end function
'-------------------------------------------------------------------------------
function zstrTOstr ( s1 as zstring ptr ) as string
    return s1[0]
end function
'-------------------------------------------------------------------------------
function zstrIndexReturn ( s1 as zstring ptr, v1 as uinteger, v2 as uinteger ) as string
    if v2 <= len(*s1) then
        dim as string ret = zstrTOstr ( zleft ( zright ( s1, v1), v2 ) )
        return ret
    else
        return ""
    endif
end function
 
'----------------------------Bonus Functions------------------------------------

function round ( inint as single ) as integer
   
    dim as single outint = inint - int(inint)
   
    if outint >= .5 then
        outint = int(inint + 1)
    else
        outint = int(inint)
    endif
   
    return outint
   
end function
'-------------------------------------------------------------------------------
' splits a string in half
'-------------------------------------------------------------------------------
#macro Zenoctomy ( instring, varname )
    dim as string varname(2)
    varname(0) = instring
    if len(varname(0)) = 1 _
    or len(varname(0)) = 0 then
        'Pick nose
    else
        dim as integer varname##length = len(varname(0))
        'Find Middle
        dim as single varname##middle =  ( varname##length / 2 ) ' or divide by 2^N
        'Odd or Even?
        if varname##middle = int(varname##middle) then
            varname(0) = zleft(varname(0), varname##middle )
            varname(2) = zright(instring, varname##middle )
        else
            varname(1) =  zChr(varname(0), Round( varname##middle ) )
            varname(0) = zleft(varname(0), Round( varname##middle ) -1 )
            varname(2) = zright(instring, Round (varname##middle) )
        endif
    endif
#endmacro
'-----------------------------Cosmetic Routines---------------------------------
'center text according to the diagonal opposite 0,0
'-------------------------------------------------------------------------------
sub Print_Center ( instring as string, box_x as single , box_y as single, c as integer )

    draw string ( box_x shr 1 - ( len(instring) shr 1)*8, box_y shr 1), instring, c

end sub
'-------------------------------------------------------------------------------
sub Make_Box ( inChr as string, box_x1 as single, box_x2 as single, box_y1 as single, box_y2 as single, c as integer )
   
    dim as integer widstr = (box_x2 - box_x1) / 8
    dim as integer lenstr = (box_y2 - box_y1) / 8
   
    for i as integer = box_x1 to box_x2 step 8
        draw string ( i, box_y1 ), inChr, c
    next
   
    for i as integer = box_x1 to box_x2 step 8
        draw string ( i, box_y2), inChr, c
    next

    for i as integer = box_y1 to box_y2 step 8
        draw string ( box_x1, i ), inChr, c
    next
   
    for i as integer = box_y1 to box_y2 step 8
        draw string ( box_x2, i ), inChr, c
    next

end sub
'-------------------------------------------------------------------------------
'Turns every other character upper/lower/upper/lower
'-------------------------------------------------------------------------------
function Stagger ( instring as string ) as string

    for i as integer = 0 to len(instring) step 2
        if chr(instring[i]) = lcase(chr(instring[i])) then
            instring[i] -= 32
        elseif chr(instring[i]) = ucase(chr(instring[i])) then
            instring[i] += 32
        endif
    next

    return instring
end function

'-----------------------------Console Functions---------------------------------
'print and get input from the console while in graphics mode
'-------------------------------------------------------------------------------
sub ConsOut ( byref Msg as string )
    open cons for output as #99: print #99, Msg;: close #99
end sub
'-------------------------------------------------------------------------------
function ConsIn () as string
    dim as string msg
    Open cons For INPUT As #99:line input #99, Msg:Close #99
    function = msg
end function
'-------------------------------------------------------------------------------
Last edited by rolliebollocks on Jun 09, 2009 14:23, edited 11 times in total.
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

String Theory 1:

Postby rolliebollocks » Apr 26, 2009 13:48

A demonstration of Zeno's Paradox of Achilles and the Tortoise.

Of interest to chaoticians and mathematicians.

Code: Select all

#include "rb_strings.bas"
'Zeno's Paradox - A demonstration...

'If you remember the race between Achilles and the Tortoise, Achilles loses because
'(for whatever reason) he's only capable of halving the distances between himself
'and the sluggish beast.
'
'We know by logic he loses, and yet it defies all expectation, knowing that if he
'is faster, he must win.
'
'Here we have our first instance of a parable which deals with infinite sets in
'finite spaces.

'Let's Imagine That we have a Line:

dim as string theline = "123456789"

'The first thing we want to do is find the center of the line. The center of the
'line can be described as the point on the line at which we can bisect it to form
'two lines of equal size...
'
'In an infinite set this is super easy: Any point on the line can be taken as the
'center... But there would be no way to determine the magnitude of the infinity
'vector in either direction... :(
'
'In a finite set, the problem of the center is equally frustrating.
'
'Take our line for example. We can easily intuit that the center of the line falls
'at 5. But what happens if we add a 0 to the end of our sequence? The point no
'longer falls on our line, but rather between elements 5 and 6.
'
'We can say the center of the line is 5&6...
'
'In this universe we have only integers. These integers are "atomic" in the Olde
'sense of being "uncuttable", "irreducible". They signify themselves and their
'meaning is gleaned from the sequence in which they fall. Certainly "1234098765"
'is no less of a line than our variable "theline" is... They signify a space in
'a sequnce, and the one which is more familiar, our number line, confuses the
'fact that this sequence can be "anything".
'
'Godel invented a way to number "anything" via a 1:1 correspondence between element
'and number.
'
'Back to Zeno's paradox. Forget the outcome of the race, the key here is the bisecting:
'the halving of the distance between Achilles and the Tortoise.
'
'Firstly. How do we find the center of any line without relying on our eyes?
'
'Simply!
'
'The equation is this:
'
' center = len(str)-1 shr 1 = (len(str)-1) / 2
'
'This equation will produce the center of the line at which the two halves have
'an equal length. But what about the center of that line? Well wait a minute!
'There are two lines! We can call the left hand line L1, and the right hand line
'R1. Further more, we can determine the center for the Nth iteration of our line
'through our equation. Therefore
'
'L(N) = len(str)-1 / 2^N
'R(N) = ( len(str)-1 - L(N) ) / 2^N
'
'Now we cannot return 2 strings from a function, so we need to pray to the chaos
'gods of the preprocessor by invoking the name of their Archon: Macro!EndMacro
'the caretaker and patron of all Macros.
'
'Now, the thing you need to understand about the Macros is, they're frowned upon by
'the demigods who invoke them (only) as a last resort. But the Macro also likes
'living in the shadows where it is free to create as it pleases and is the keeper
'of one of the Seven Great Secrets of Everything. Firstly, we need a function to
'properly deal with the possibility of fractional results. In fact, we need to
'force our little strings into a world, which is (perhaps) less real.

'#macro Zenoctomy ( instring, varname )
'    dim as string varname(2)
'    varname(0) = instring
'    if len(varname(0)) = 1 _
'    or len(varname(0)) = 0 then
'        'Pick nose
'    else
'        dim as integer varname##length = len(varname(0))
'        'Find Middle
'        dim as single varname##middle =  ( varname##length / 2 ) + 1' or divide by 2^N
'        'Odd or Even?
'        if varname##middle = int(varname##middle) then
'            varname(0) = cutleftfrom(instring, varname##middle -1)
'            varname(2) = cutrightfrom(instring, varname##middle - 1)
'        else
'            varname(1) =  Chr(Asc(varname(0), varname##middle))
'            varname(0) = cutleftfrom(varname(0), varname##middle -1 )
'            varname(2) = cutrightfrom(instring, Round (varname##middle) -1)
'        endif
'    endif
'#endmacro
'

'The left cut:
Zenoctomy ("0123456789", h)
? h(0), h(1), h(2)
Zenoctomy ( h(0), hh)
? hh(0), hh(1), hh(2)
Zenoctomy ( hh(0), hhh)
? hhh(0), hhh(1), hhh(2)
sleep
'The right cut:
Zenoctomy ("0123456789", g)
? g(0), g(1), g(2)
Zenoctomy ( g(2), gg)
? gg(0), gg(1), gg(2)
Zenoctomy ( gg(2), ggg)
? ggg(0), ggg(1), ggg(2)
sleep

Zenoctomy ("fudgeround", z)
? z(0), z(1), z(2)
sleep

Zenoctomy ("fudgeround2", z2)
? z2(0), z2(1), z2(2)
sleep

'So you see, what has happened here... is the equations...

'LcenterN = len(str)-1/2^n
'RcenterN = ( (len(str)-1)-(len(str)-1/2^N ) / 2^N
'
'Are being translated into an extremely efficient repeatable process...

'///////////////////////////////////END/////////////////////////////////////////
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » May 27, 2009 15:45

Update!
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » May 28, 2009 19:13

Update:

Added:

CutLeftFrom_Char ( instring, index )
CutRightFrom_Char ( instring, index )

These functions use string indexing to replace MID$ They cut from any place in the index, while the originals cut from an entire word...

StrReverse

Print a string in reverse

IsInStrRev ( strbig, strlittle ) as uinteger

Search for a string backward... Depends on isinstr, and StrReverse

Print_Center ( instring as string, box_x as single , box_y as single, c as integer )

Cosmetic function to center a string in a defined box.

FIXED:

Bug in GetWord that would choke on numeric strings...
stylin
Posts: 1253
Joined: Nov 06, 2005 5:19

Postby stylin » May 28, 2009 22:56

rolliebollocks, good job, looks like you have some useful stuff there ! Since you seem interested in string manipulation, have you thought about contributing to fbext ? It has a couple of strings modules, with some of the same functionality too (one general-purpose and the other an attempt to replicate some of PHP's string API; links are below). Anyway, keep up the good work !

http://code.google.com/p/fb-extended-li ... xt/strings
http://code.google.com/p/fb-extended-li ... strings.bi
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » May 29, 2009 12:26

Thanks, yeah, I'd love to.

I'm still working out the kinks in some of the procedures here and there as I test them, but I'll definitely contribute.

I took a look at the fb extended library to see if I could write some of those on my own (as a challenge to myself).

One issue you may have is that the functions are extremely interdependent. That is to say, you can't take out one without inheriting 6 other ones.

I'm going to be doing more testing today. There is weirdness happening with some of the macros. And I removed the function which makes the Zeno Paradox thing work for a better one.

I'll get back soon.

rb
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » May 29, 2009 14:15

How does one go about submitting, exactly, and what would I have to do to get the string lib ready?

rb
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » May 29, 2009 14:39

Update!

File_ToLineArray ( inscript, varname )

Now functions according to specs. The Macro loads any file into an array of lines...

Is that cool or what?

rb
AGS
Posts: 1283
Joined: Sep 25, 2007 0:26
Location: the Netherlands

Postby AGS » May 30, 2009 0:52

I've changed the implementation of one of your functions (isDelimiter) and tested it's performance against my implementation.

Code: Select all

enum TOKENS
    _TK_NULL        = Asc("")
    _TK_TAB         = 9
    _TK_CR          = 13
    _TK_ENDOFLINE   = Asc(!"\n")
    _TK_ENTER       = Asc(!"\r")
    _TK_SPACE       = Asc(" ")
    _TK_AMPERSAND   = Asc("&")
    _TK_COMMA       = Asc(",")
    _TK_STRING      = Asc("$")
    _TK_INTEGER     = Asc("%")
    _TK_PERCENT     = Asc("%")
    _TK_AT          = Asc("@")
    _TK_POUND       = Asc("#")
    _TK_DOT         = Asc(".")
    _TK_RPAREN      = Asc(")")
    _TK_LPAREN      = Asc("(")   
    _TK_PLUS        = Asc("+")
    _TK_MINUS       = Asc("-")
    _TK_ASTERISK    = Asc("*")
    _TK_MULT        = Asc("*")
    _TK_DIVIDE      = Asc("/")
    _TK_FSLASH      = Asc("/")
    _TK_BSLASH      = Asc("\")
    _TK_UNDERSCORE  = Asc("_")
    _TK_LBRACKET    = Asc("[")
    _TK_RBRACKET    = Asc("]")
    _TK_EQUAL       = Asc("=")
    _TK_COMMENT     = Asc("'")
    _TK_APOSTROPHE  = Asc("'")
    _TK_LSET        = Asc("{")
    _TK_RSET        = Asc("}")
    _TK_PIPE        = Asc("|")
    _TK_GREATERTHAN = Asc(">")
    _TK_LESSTHAN    = Asc("<")
    _TK_DBLQUOTE    = Asc($"")
    _TK_QUESTION    = Asc("?")
    _TK_EXCLAIM     = Asc("!")
    _TK_COLON       = Asc(":")
End enum
'-------------------------------------------------------------------------------
' Checks for the listed elements at a given point in any string, and returns -1
' for true, 0 for false
Function isDelimiter1 ( inchr As Ubyte ) As Integer
    If inchr = _TK_ENDOFLINE _
    Or inchr = _TK_TAB _
    Or inchr = _TK_NULL _
    Or inchr = _TK_CR _
    Or inchr = _TK_SPACE Then
        Return -1
    Else
        Return 0
    Endif
End Function


' Checks for the listed elements at a given point in any string, and returns -1
' for true, 0 for false
Function isDelimiter2 ( inchr As Ubyte ) As Integer   
      
      Select Case inchr
      Case _TK_NULL, _TK_TAB To _TK_ENDOFLINE, _TK_CR, _TK_SPACE      
         Return -1
      Case Else
         Return 0
      End Select
      
End Function


Sub main()

Dim As String input_ = _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n" _
!"Hello        how do you do         \n" _
!"there is much   whitespace                       \r"_
!"      in this                                 string\n"

Dim As Integer hits = 0

Var t1 = Timer()
For i As Integer = 0 To Len(input_) - 1
   hits += isDelimiter1(input_[i])
Next i
Var t2 = Timer()
Print Using "Time isDelimiter1 = ####.######";t2 - t1
Print hits
Print Len(input_)

hits = 0
t1 = Timer()
For j As Integer = 0 To Len(input_) - 1
   hits += isDelimiter2(input_[j])
Next j
t2 = Timer()
Print Using "Time isDelimiter2  = ####.######";t2 - t1
Print hits
Print Len(input_)

End Sub

main()


isDelimiter1 is the original version.
isDelimiter2 is my version.

Run the program a couple of times and notice the timing indications (execution time isDelimiter1 versus execution time isDelimiter2).

Do you see what I see...? (or is it just that my PC 'likes' a select case statement better than an if statement?)
KristopherWindsor
Posts: 2428
Joined: Jul 19, 2006 19:17
Location: Sunnyvale, CA
Contact:

Postby KristopherWindsor » May 30, 2009 3:21

.00001 seconds doesn't really matter. :o
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » May 30, 2009 12:24

I was informed by several knowledgeable that select case is often slower and that if then's are preferable when speed is an issue. Select Case is prettier and easier to work with, and for that reason, I would use it. It may be that the OR/AND operators slow down the process, and under normal circumstances IF/THEN is faster.

I'm not really knowledgeable about such things... I go by what I hear.

But now that I tested it, you're right, select case is faster on my machine too by .00005 seconds.

My theory on optimization still seems to hold here:
the fewer the lines, the more optimized it is... except (of course) when its not true, like when you're weeding out with extra checks.

For the record, the difference in speed between the naive version of isInStr is not appreciably different from the optimized version. Also, if you check 2, 3, 4 characters at a time, it slows it's time through the string array, effectively. The naive function is still the best for everyday searches primarily because there are so few lines of code. The optimized version of the Fuzzy and BCM variety work for needles which are over 300 characters... But the BCM has the added power to do hackish pattern matching, and the FZZY version works by only checking a percentage of the characters.

I need to comment them better...

Thanks, though... you're right, in this instance select case is faster.

Praise be to string indexing...

rb
1000101
Posts: 2556
Joined: Jun 13, 2005 23:14
Location: SK, Canada

Postby 1000101 » May 30, 2009 16:49

Both methods are slow.

The If/Then statement can be changed from "Or" to "OrElse" so the first hit it will return -1 instead of doing equality checks on them all, then combining them all via or and finally checking for zero equality (jnz).

The Select/Case can become more efficient with the "As Const" operator forcing fbc to generate a jump table so it will go to the proper response directly from the input value.
AGS
Posts: 1283
Joined: Sep 25, 2007 0:26
Location: the Netherlands

Postby AGS » May 31, 2009 14:39

rolliebollocks wrote:Praise be to string indexing...
rb


Changed another function and got some nice timing results. StrReverse is your version, StrReverse2 is mine.

Code: Select all

Function StrReverse ( ByRef instring As String ) As String
   
    Dim As String newstring = ""
   
    For i As Integer = Len(instring) - 1 To 0 Step -1
        newstring &= Chr( instring[i] )
    Next
   
    Return newstring
   
End Function

Function StrReverse2 (ByRef instring As String) As String

   Dim As Integer l = Len(instring) - 1
   Dim newstring As String
   
   newstring = String(l+1,69)
   
   
   For i As Integer = 0 To l
      newstring[l-i] = instring[i]
   Next i
   
   Return newstring
End Function

Sub main()
   Var test = String(10000,65)
   Var t1 = Timer()
   Var test2 = StrReverse(test)
   Var t2 = Timer()
   Print Using "Execution time StrReverse  = #####.########";t2 - t1
   t1 = Timer()
   Var test3 = StrReverse2(test)
   t2 = Timer()
   Print Using "Execution time StrReverse2 = #####.########";t2 - t1   
End Sub

main


Testresults (test done on my very old and very slow PC (celeron 1ghz))

Execution time StrReverse = 0.03024183
Execution time StrReverse2 = 0.00024137


If you use a very long string (Var test = String(100000,65)) performance of StrReverse degrades dramatically. That is, on the old PC I'm using.

How much the results of my benchmark are worth is debatable. Looking at the results of the program I posted before the one above I'd say my PC is a piece of .... when compared to, say, the PC KristopherWindsor is using. The numbers looked like this (difference in runtime between Select Case and If... Then):

.0003 (me)
.00005 (rolliebollocks)
.00001 (KristopherWindsor)

The difference between .00001 and .0003 is huge.

And a .00001 seconds difference in runtime is nothing. Clearly KristopherWindsor and rolliebollocks are using machines that perform very differently from the PC I'm using.

I agree with 1000101 that Select Case As Const is the best. It performs better than Select Case (tried it myself :) ).
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » May 31, 2009 20:29

@AGS

It looks like CHR is slowing things down. If you didn't have to fill the string before rewriting it, yours would be even faster. Anyway, kudos on a creative solution.

rb
vdecampo
Posts: 2974
Joined: Aug 07, 2007 23:20
Location: Florida, USA
Contact:

Postby vdecampo » May 31, 2009 20:55

Is it too late to get in on the algo speed check?

Code: Select all

Function _StrRev (Byref instring As String) As String
Dim As Integer lenstr = Len(instring)
Dim As Byte ptr newstring = Callocate(lenstr+1)
           
   For i As Integer = 0 To lenstr-1
      newstring[i] = instring[lenstr-i-1]
   Next i
       
   Return *Cast(ZString Ptr,newstring)
   
End Function

Print _StrRev("The cow jumped over the moon")

Sleep


-Vince

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 2 guests