Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Experimenting with a "StringList" type for simpler handling of string arrays/lists
#11
Quote:Do you by the way share your array functions anywhere? If so, I'd be interested in having a look. Maybe they will reduce my phobia.

Sure! 
Code: (Select All)
Option _Explicit

_Title "String Array Tools works mainly with Dynamic arrays"

'2018-11-05 Unique, Split might benefit from chunking with REDIM _PRESERVE
'2019-04-06 added slice which can replace copy

Randomize Timer
Dim n As Integer, x As Integer, r As Integer, i As Integer
Dim b$, store$, t$, enter$

''test subs and functions from Float Tools
'REDIM test(n) AS STRING
't$ = "B B C D D D A B C D B A C"
'PRINT "Test: "; t$
'PRINT "Split, Unique, Sorted, Reversed and Join$: ";
'Split t$, " ", test()
'Unique test()
'Sort 0, UBOUND(test), test()
'Reverse test()
't$ = Join$(test(), ",")
'PRINT t$
'INPUT "Press enter for next test, Addend (Append) and copie and Show (boring stuff)..."; enter$
'REDIM test(1 TO 1) AS STRING
'test(1) = "This is a test."
'store$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz 0123456789"
''store$ = "ABCD" 'test unique
'PRINT "Test addend"
'n = 10
'FOR x = 1 TO n
'    b$ = ""
'    r = (RND * 3) \ 1 + 2
'    FOR i = 0 TO r
'        b$ = b$ + MID$(store$, INT(RND * LEN(store$)) + 1, 1)
'    NEXT
'    Addend test(), b$
'NEXT
'PRINT "Result of Addend:"
'Show test()

'REDIM copie(0) AS STRING
'PRINT "Copying test()..."
'Copy test(), copie()
'PRINT "Showing copied array:"
'Show copie()
'PRINT "Here is joint, of first 5 items: "; Joint$(copie(), 0, 4, ", ")
'PRINT "Here is whole join: "; Join$(copie(), ": ")
ReDim copie(0) As String
Split "0 1 2 3 4 5 6 7", copie(), " "
Insert copie(), 3, "This is inserted into the " + Str$(3) + " index position."
Show copie()
Print
Delete copie(), 3
Show copie()

'a() must be initialized as redim a(lb to ub)
Sub Unique (a() As String) 'make all the items in the a array unique like a proper set
    Dim i As Long, ti As Long, j As Long, u As Integer, lba As Long
    lba = LBound(a)
    ReDim t(lba To lba) As String 'rebuild container
    t(lba) = a(lba): ti = lba
    For i = lba + 1 To UBound(a) 'for each element in array
        u = -1
        For j = lba To ti 'check if not already in new build
            If a(i) = t(j) Then u = 0: Exit For 'oh it is unique is false
        Next
        If u Then 'OK add it to rebuild
            ti = ti + 1
            ReDim _Preserve t(lba To ti) As String
            t(ti) = a(i)
        End If
    Next
    ReDim a(lba To ti) As String 'goodbye old array
    For i = lba To ti 'now copy the unique elements into array
        a(i) = t(i)
    Next
End Sub

Sub Sort (a() As String, start As Long, finish As Long)
    Dim Hi As Long, Lo As Long, Middle As String
    Hi = finish: Lo = start
    Middle = a((Lo + Hi) / 2) 'find middle of array
    Do
        Do While a(Lo) < Middle: Lo = Lo + 1: Loop
        Do While a(Hi) > Middle: Hi = Hi - 1: Loop
        If Lo <= Hi Then
            Swap a(Lo), a(Hi)
            Lo = Lo + 1: Hi = Hi - 1
        End If
    Loop Until Lo > Hi
    If Hi > start Then Sort a(), start, Hi
    If Lo < finish Then Sort a(), Lo, finish
End Sub

Sub Reverse (a() As String)
    Dim i As Long, ti As Long
    ReDim t(LBound(a) To UBound(a)) As String
    ti = LBound(a)
    For i = UBound(a) To LBound(a) Step -1 'load t from top to bottom of a
        t(ti) = a(i)
        ti = ti + 1
    Next
    For i = LBound(a) To UBound(a) 'reload a from t
        a(i) = t(i)
    Next
End Sub

'notes: REDIM the a(0) as string to be loaded before calling Split '<<<<<<<<<<<<<<<<<<<<<<< IMPORTANT!!!!
Sub Split (mystr As String, a() As String, delim As String)
    ' I am hoping strings will cover any number type
    ' bplus modifications of Galleon fix of Bulrush Split reply #13
    ' http://www.qb64.net/forum/index.php?topic=1612.0
    ' this sub further developed and tested here: \test\Strings\Split test.bas
    Dim copee As String, p As Long, curpos As Long, arrpos As Long, lc As Long, dpos As Long
    copee = mystr 'make copee since we are messing with mystr
    'special case if delim is space, probably want to remove all excess space
    If delim = " " Then
        copee = RTrim$(LTrim$(copee))
        p = InStr(copee, "  ")
        While p > 0
            copee = Mid$(copee, 1, p - 1) + Mid$(copee, p + 1)
            p = InStr(copee, "  ")
        Wend
    End If
    curpos = 1
    arrpos = 0
    lc = Len(copee)
    dpos = InStr(curpos, copee, delim)
    Do Until dpos = 0
        a(arrpos) = Mid$(copee, curpos, dpos - curpos)
        arrpos = arrpos + 1
        ReDim _Preserve a(arrpos + 1) As String
        curpos = dpos + Len(delim)
        dpos = InStr(curpos, copee, delim)
    Loop
    a(arrpos) = Mid$(copee, curpos)
    ReDim _Preserve a(arrpos) As String
End Sub

' tie only a continuous section together
Function Joint$ (a() As String, aStart As Long, aStop As Long, delimiter As String)
    Dim i As Long, iStart, iStop, b As String
    If aStart < LBound(a) Then iStart = LBound(a) Else iStart = aStart
    If aStop > UBound(a) Then iStop = UBound(a) Else iStop = aStop
    For i = iStart To iStop
        If i = iStop Then
            b = b + a(i)
        Else
            b = b + a(i) + delimiter
        End If
    Next
    Joint$ = b
End Function

'tie it all together
Function Join$ (a() As String, delimiter As String)
    Dim i As Long, b As String
    For i = LBound(a) To UBound(a)
        If i = UBound(a) Then
            b = b + a(i)
        Else
            b = b + a(i) + delimiter
        End If
    Next
    Join$ = b
End Function

Sub Delete (a() As String, deletePlace As Long)
    Dim i As Long
    If deletePlace >= LBound(a) And deletePlace <= UBound(a) Then
        For i = deletePlace To UBound(a) - 1
            a(i) = a(i + 1)
        Next
        ReDim _Preserve a(LBound(a) To UBound(a) - 1) As String
    End If
End Sub

Sub Insert (a() As String, insertPlace As Long, insertValue As String)
    Dim uba As Long, i As Long
    uba = UBound(a)
    If insertPlace > uba Then
        Addend a(), insertValue
    Else
        ReDim _Preserve a(LBound(a) To uba + 1) As String
        For i = uba To insertPlace Step -1
            a(i + 1) = a(i)
        Next
        a(insertPlace) = insertValue
    End If
End Sub

'not append? append is a command word
Sub Addend (a() As String, addon As String)
    Dim lba As Long, uba As Long
    lba = LBound(a): uba = UBound(a)
    ReDim _Preserve a(lba To uba + 1) As String
    a(uba + 1) = addon
End Sub

Sub aCopy (a() As String, b() As String)
    Dim lba As Long, uba As Long, i As Long
    lba = LBound(a): uba = UBound(a)
    ReDim b(lba To uba) As String
    For i = lba To uba
        b(i) = a(i)
    Next
End Sub

Sub Show (a() As String)
    Dim lba As Long, uba As Long, i As Long
    lba = LBound(a): uba = UBound(a)
    For i = lba To uba
        Print a(i)
    Next
End Sub

'replace copy with more versatile tool
'start is assumed to be <= fini but start or fini can be less than lbound and ubound of source
Sub slice (source() As String, start, fini, copy() As String)
    Dim copyI As Long, begin As Long, finish As Long, i As Long
    If start < LBound(source) Then begin = LBound(source) Else begin = start
    If fini > UBound(source) Then finish = UBound(source) Else finish = fini
    ReDim copy(0 To finish - begin + 1) As String
    copyI = 0
    For i = begin To finish
        copy(copyI) = source(i)
        copyI = copyI + 1
    Next
End Sub
<230 LOC


In all the commented code in main, I was testing each routine and using: Show test(), to show result after each test. Once checked I set up next test and moved the: Show test() line below the next test. That's why there isn't Show test() after each test of a routine.

A shorter version of Split (where space as delimiter is not checked):
Code: (Select All)
' note: I buggered this twice now, FOR base 1 array REDIM MyArray (1 to 1) AS ... the (1 to 1) is not same as (1) which was the Blunder!!!
'notes: REDIM the array(0) to be loaded before calling Split '<<<< IMPORTANT dynamic array and empty, can use any lbound though
'This SUB will take a given N delimited string, and delimiter$ and create an array of N+1 strings using the LBOUND of the given dynamic array to load.
'notes: the loadMeArray() needs to be dynamic string array and will not change the LBOUND of the array it is given.  rev 2019-08-27
Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
    Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
    curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
    dpos = InStr(curpos, SplitMeString, delim)
    Do Until dpos = 0
        loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
        arrpos = arrpos + 1
        If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
        curpos = dpos + LD
        dpos = InStr(curpos, SplitMeString, delim)
    Loop
    loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
    ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
End Sub


And as posted elsewhere, a routine for displaying and selecting, like from a menu only the "menu" can go for pages and pages!:
Code: (Select All)
Option _Explicit
_Title "GetArrayItem$ v 2021-02-07" 'b+       NEED dev 1.5
' build from getArrayItemNumber& function 2019-05-18
' Main testing and demo of the FUNCTION  getArrayItem$

Const Xmax = 1200, Ymax = 600 'Window Width and Height

Screen _NewImage(Xmax, Ymax, 32)
_Delay .25
_ScreenMove _Middle

Dim As Long lb, ub, i, locRow, locCol, boxWidth, boxHeight, snap
Dim As String selected
'test string array, use indexes in lines for alignment to code for function
lb = 1: ub = 45 ' <<<<<<<<<<<<<< different size arrays
ReDim arr(lb To ub) As String
For i = lb To ub
    arr(i) = "This is arr item:" + Str$(i)
Next
'set variables to call display
locRow = 5: locCol = 80: boxWidth = 30: boxHeight = 20 ' character cell units not pixels
Do
    Cls
    ' off by 1 row too height in display
    Locate locRow - 2, locCol - 1: Print "*" ' height starts 1 less than spec'd
    ' this is box that contains the getArrItem box
    Line ((locCol - 1) * 8 - 1, (locRow - 2) * 16 - 1)-Step(boxWidth * 8 + 2, boxHeight * 16 + 2), &HFFFFFF00, B
    selected = GetArrayItem$(locRow, locCol, boxWidth, boxHeight, arr())
    Print "You selected: "; selected; ", press any to continue..."
    Sleep
Loop Until _KeyDown(27)


' Help: all this I hope is intuitive so Help not needed
' "Mouse, mouse wheel, and arrow keys should work as expected for item selection."
' "Press spacebar to select a highlighted item or just click it."
' "Use number(s) + enter to select an array item by it's index number,"
' "backspace will remove last number pressed, c will clear a number started. << Change to Delete
' "Numbers started are shown in bottom right PgDn bar."
' "Enter will also select the highlighted item, if no number has been started."
' "Home starts you at lowest array index, End highlights then highest index."
' "Use PgUp and PgDn keys to flip through pages of array items."
'
' Escape to Cancel Return "" else Return the selected string from the array
Function GetArrayItem$ (locateRow, locateColumn, boxWidth, boxHeight, arr() As String)
    'This sub needs ScrState to store and restore screen condition before and after this sub does it's thing


    'Notes: locateRow, locateColumn for top right corner of selection box on screen in characters for LOCATE.
    'boxWidth and boxHeight are in character units, again for locate and print at correct places.
    'All displaying is restricted to inside the box, which has PgUP and PgDn as top and bottom lines in the display.

    Dim maxWidth As Integer, maxHeight As Integer, page As Integer, hlite As Integer, mx As Integer, my As Integer
    Dim lastMX As Integer, lastMY As Integer, row As Integer, mb As Integer
    Dim lba As Long, uba As Long, choice As Long, kh As Long, index As Long
    Dim clrStr As String, b As String

    'save old settings to restore at end ofsub
    ScnState 0

    maxWidth = boxWidth '       number of characters in box
    maxHeight = boxHeight - 2 ' number of lines displayed of array at one time = 1 page
    lba = LBound(arr)
    uba = UBound(arr)
    page = 0
    hlite = 0 '                 line in display ready for selection by spacebar or if no number is started, enter
    clrStr$ = Space$(maxWidth) 'clearing a display line

    GoSub update '              show the beginning of the array items for selection
    choice = -1719
    Do 'until get a selection or demand exit

        'handle the key stuff
        kh& = _KeyHit
        If kh& Then
            If kh& > 0 And kh& < 255 Then
                If InStr("0123456789", Chr$(kh&)) > 0 Then b$ = b$ + Chr$(kh&): GoSub update

                If Chr$(kh&) = "c" Then b$ = "": GoSub update
                If kh& = 13 Then 'enter pressed check if number is being entered?
                    If Len(b$) Then
                        If Val(b$) >= lba And Val(b$) <= uba Then 'we have number started
                            choice = Val(b$): Exit Do
                        Else 'clear b$ to show some response to enter
                            b$ = "": GoSub update 'clear the value that doesn't work
                        End If
                    Else
                        choice = hlite + page * maxHeight + lba 'must mean to select the highlighted item
                    End If
                End If
                If kh& = 27 Then Exit Do 'escape clause offered to Cancel selection process
                If kh& = 32 Then choice = hlite + page * maxHeight + lba 'best way to choose highlighted selection
                If kh& = 8 Then 'backspace to edit number
                    If Len(b$) Then b$ = Left$(b$, Len(b$) - 1): GoSub update
                End If
            Else
                Select Case kh& 'choosing sections of array to display and highlighted item
                    Case 20736 'pg dn
                        If (page + 1) * maxHeight + lba <= uba Then page = page + 1: GoSub update
                    Case 18688 'pg up
                        If (page - 1) * maxHeight + lba >= lba Then page = page - 1: GoSub update
                    Case 18432 'up
                        If hlite - 1 < 0 Then
                            If page > 0 Then
                                page = page - 1: hlite = maxHeight - 1: GoSub update
                            End If
                        Else
                            hlite = hlite - 1: GoSub update
                        End If
                    Case 20480 'down
                        If (hlite + 1) + page * maxHeight + lba <= uba Then 'ok to move up
                            If hlite + 1 > maxHeight - 1 Then
                                page = page + 1: hlite = 0: GoSub update
                            Else
                                hlite = hlite + 1: GoSub update
                            End If
                        End If
                    Case 18176 'home
                        page = 0: hlite = 0: GoSub update
                    Case 20224 ' end
                        page = Int((uba - lba) / maxHeight): hlite = maxHeight - 1: GoSub update
                End Select
            End If
        End If

        'handle the mouse stuff
        While _MouseInput
            If _MouseWheel = -1 Then 'up?
                If hlite - 1 < 0 Then
                    If page > 0 Then
                        page = page - 1: hlite = maxHeight - 1: GoSub update
                    End If
                Else
                    hlite = hlite - 1: GoSub update
                End If
            ElseIf _MouseWheel = 1 Then 'down?
                If (hlite + 1) + page * maxHeight + lba <= uba Then 'ok to move up
                    If hlite + 1 > maxHeight - 1 Then
                        page = page + 1: hlite = 0: GoSub update
                    Else
                        hlite = hlite + 1: GoSub update
                    End If
                End If
            End If
        Wend
        mx = Int((_MouseX - locateColumn * 8) / 8) + 2: my = Int((_MouseY - locateRow * 16) / 16) + 2
        If _MouseButton(1) Then 'click contols or select array item
            'clear mouse clicks
            mb = _MouseButton(1)
            If mb Then 'clear it
                While mb 'OK!
                    If _MouseInput Then mb = _MouseButton(1)
                    _Limit 100
                Wend
            End If

            If mx >= 1 And mx <= maxWidth And my >= 1 And my <= maxHeight Then
                choice = my + page * maxHeight + lba - 1 'select item clicked
            ElseIf mx >= 1 And mx <= maxWidth And my = 0 Then 'page up or exit
                If my = 0 And (mx <= maxWidth And mx >= maxWidth - 2) Then 'exit sign
                    Exit Do 'escape plan for mouse click top right corner of display box
                Else 'PgUp bar clicked
                    If (page - 1) * maxHeight + lba >= lba Then page = page - 1: GoSub update
                End If
            ElseIf mx >= 1 And mx <= maxWidth And my = maxHeight + 1 Then 'page down bar clicked
                If (page + 1) * maxHeight + lba <= uba Then page = page + 1: GoSub update
            End If
        Else '   mouse over highlighting, only if mouse has moved!
            If mx >= 1 And mx <= maxWidth And my >= 1 And my <= maxHeight Then
                If mx <> lastMX Or my <> lastMY Then
                    If my - 1 <> hlite And (my - 1 + page * maxHeight + lba <= uba) Then
                        hlite = my - 1
                        lastMX = mx: lastMY = my
                        GoSub update
                    End If
                End If
            End If
        End If
        _Limit 200
    Loop Until choice >= lba And choice <= uba
    If choice <> -1719 Then GetArrayItem$ = arr(choice) 'set function and restore screen
    ScnState -1 'restore
    Exit Function

    'display of array sections and controls on screen  ====================================================
    update:

    'fix hlite if it has dropped below last array item
    While hlite + page * maxHeight + lba > uba
        hlite = hlite - 1
    Wend

    'main display of array items at page * maxHeight (lines high)
    For row = 0 To maxHeight - 1
        If hlite = row Then Color _RGB(200, 200, 255), _RGB32(0, 0, 88) Else Color _RGB32(0, 0, 88), _RGB(200, 200, 255)
        Locate locateRow + row, locateColumn: Print clrStr$
        index = row + page * maxHeight + lba
        If index >= lba And index <= uba Then
            Locate locateRow + row, locateColumn
            Print Left$(LTrim$(Str$(index)) + ") " + arr(index), maxWidth)
        End If
    Next

    'make page up and down bars to click, print PgUp / PgDn if available
    Color _RGB32(200, 200, 255), _RGB32(0, 100, 50)
    Locate locateRow - 1, locateColumn: Print Space$(maxWidth)
    If page <> 0 Then Locate locateRow - 1, locateColumn: Print Left$(" Pg Up" + Space$(maxWidth), maxWidth)
    Locate locateRow + maxHeight, locateColumn: Print Space$(maxWidth)
    If page <> Int(uba / maxHeight) Then
        Locate locateRow + maxHeight, locateColumn: Print Left$(" Pg Dn" + Space$(maxWidth), maxWidth)
    End If
    'make exit sign for mouse click
    Color _RGB32(255, 255, 255), _RGB32(200, 100, 0)
    Locate locateRow - 1, locateColumn + maxWidth - 3
    Print " X "

    'if a number selection has been started show it's build = b$
    If Len(b$) Then
        Color _RGB(255, 255, 0), _RGB32(0, 0, 0)
        Locate locateRow + maxHeight, locateColumn + maxWidth - Len(b$) - 1
        Print b$;
    End If
    _Display
    _Limit 100
    Return
End Function

' see if this version of screen state is OK because the above one does not play nice with old mBox and InputBox$
Sub ScnState (restoreTF As Long) 'Thanks Steve McNeill
    Static As _Unsigned Long defaultColor, backGroundColor
    Static As Long font, dest, source, row, col, autodisplay, mb
    If restoreTF Then
        _Font font
        Color defaultColor, backGroundColor
        _Dest dest
        _Source source
        Locate row, col
        If autodisplay Then _AutoDisplay Else _Display
        _KeyClear
        While _MouseInput: Wend 'clear mouse clicks
        mb = _MouseButton(1)
        If mb Then
            Do
                While _MouseInput: Wend
                mb = _MouseButton(1)
                _Limit 100
            Loop Until mb = 0
        End If
    Else
        font = _Font: defaultColor = _DefaultColor: backGroundColor = _BackgroundColor
        dest = _Dest: source = _Source
        row = CsrLin: col = Pos(0): autodisplay = _AutoDisplay
        _KeyClear
    End If
End Sub
255 LOC
  724  855  599  923  575  468  400  206  147  564  878  823  652  556 bxor cross forever
Reply
#12
(12-17-2025, 01:52 PM)bplus Wrote:
Quote:Do you by the way share your array functions anywhere? If so, I'd be interested in having a look. Maybe they will reduce my phobia.
Sure! 

Awesome! Thanks for sharing!
Reply
#13
I made one too, and I use it in a lot of my programs.
But I made it in a different way - it uses strings instead of storing them in the memory with a handle.
And it is slower, because it uses sequential access, and not random access.
But it also has some benefits.
Have a look here: on GitHubqb64_libraries/dsa/ListString.bas at master · AadityaParashar0901/qb64_libraries · GitHub
Reply
#14
@Heimdall Perhaps I should not enable a phobic but AP's post above reminded me there is a workaround for 1 dim string arrays AKA Lists and that's "long strings" where each item is seperate by a delimter in a very long "list" of string items that can be "indexed" just like in arrays.

Here is an example demo, short and sweet you don't have to go to gethub to get:
Code: (Select All)
_Title "Word tools Demo" 'from: Word tools 2018-03-23.bas"  'B+ 2019-04-15

test$ = " 1   2 3  4  5  6  7  8  9  10   11 12 13 14 15   16 "
Print "Test string: *"; test$; "*"
test$ = wPrep$(test$)
Print: Print "Test string run through wPrep$() to remove excess spaces:"
Print "*"; test$; "*"
Print: Print "Test string has"; wCnt(test$); "'words' in it."
Print: Print "Show every third word in test string:"
For i = 3 To 16 Step 3
    Print "wrd$(test$,"; _Trim$(Str$(i)); ") = "; Wrd$(test$, i)
Next
Print: Print "What multiples of 5 are in test string?"
For i = 5 To 20 Step 5
    If wIn(test$, _Trim$(Str$(i))) > 0 Then Print i; "is in test string." Else Print i; "is NOT in test string."
Next
Print: Print "Substitute the phrase 'and all the rest...' for words after 10:"
Print wSubst$(test$, 11, wCnt(test$), "and all the rest...")


'return trimmed  source string s with one space between each word
Function wPrep$ (ss$)

    s$ = LTrim$(RTrim$(ss$))
    If Len(s$) = 0 Then wPrep$ = "": Exit Function
    'remove all double or more spaces
    p = InStr(s$, "  ")
    While p > 0
        s$ = Mid$(s$, 1, p) + Mid$(s$, p + 2, Len(s$) - p - 1)
        p = InStr(s$, "  ")
    Wend
    b$ = ""
    For i = 1 To Len(s$)
        c$ = Mid$(s$, i, 1)
        If Asc(c$) > 31 Then b$ = b$ + c$
    Next
    wPrep$ = b$
End Function

' This duplicates JB word(string, wordNumber) base 1, space as default delimiter
' by returning the Nth word of source string s
' this function assumes s has been through wPrep
Function Wrd$ (ss$, wNumber)
    's$ = wPrep(ss$)
    s$ = ss$ 'don't change ss$
    If Len(s$) = 0 Then Wrd$ = "": Exit Function
    w$ = "": c = 1
    For i = 1 To Len(s$)
        If Mid$(s$, i, 1) = " " Then
            If c = wNumber Then Wrd$ = w$: Exit Function
            w$ = "": c = c + 1
        Else
            w$ = w$ + Mid$(s$, i, 1)
        End If
    Next
    If c <> wNumber Then Wrd$ = " " Else Wrd$ = w$
End Function

'This function counts the words in source string s
'this function assumes s has been thru wPrep
Function wCnt (s$)
    Dim c As Integer, p As Integer, ip As Integer
    's = wPrep(s)
    If Len(s$) = 0 Then wCnt = 0: Exit Function
    c = 1: p = 1: ip = InStr(p, s$, " ")
    While ip
        c = c + 1: p = ip + 1: ip = InStr(p, s$, " ")
    Wend
    wCnt = c
End Function

'Where is word In source s, 0 = Not In source
'this function assumes s has been thru wPrep
Function wIn (s$, wd$)
    Dim wc As Integer, i As Integer
    wc = wCnt(s$): wIn = 0
    For i = 1 To wc
        If Wrd$(s$, i) = wd$ Then wIn = i: Exit Function
    Next
End Function

' substitute string in s to replace section first to last words inclusive
'this function assumes s has been thru wPrep
Function wSubst$ (s$, first, last, subst$)
    Dim wc As Integer, i As Integer, subF As Integer
    wc = wCnt(s$): b$ = ""
    For i = 1 To wc
        If first <= i And i <= last Then 'do this only once!
            If subF = 0 Then b$ = b$ + subst$ + " ": subF = 1
        Else
            b$ = b$ + Wrd$(s$, i) + " "
        End If
    Next
    wSubst$ = LTrim$(RTrim$(b$))
End Function

Now the above demo is set to work with a space as a delimter between each item so only words and numbers in string form work but it would be a piece of cake to use a comma for a delimiter so you can use spaces for phrases even sentences as long as commas not used in sentence. As AP says it's way slower than arrays would be but if you are really desparate it would be a fun exercise to practice coding skills and have something handy to show for your efforts.
  724  855  599  923  575  468  400  206  147  564  878  823  652  556 bxor cross forever
Reply
#15
(12-17-2025, 08:36 AM)Heimdall Wrote: @Pete: I can't access your link. It seems there is a hidden VIP section, which my 2 forum posts don't qualify me for  Big Grin
@Heimdall

This explains the forum. It's not VIP (based on rep). It's open to everyone, but password protected.

https://qb64phoenix.com/forum/showthread.php?tid=107

Steve's a little long on wind, so just go to the bottom sentence, and look at the 4-ltter word in quotes. That's your password to get into the forum. It for all off-topic stuff, and because that often involves points of view or politics, Steve decided to make it a little less accessible.

Pete
Reply
#16
@bplus and @aadityap0901: Thanks for these "long string" list examples! I was actually considering something like that too. But my assumption was that it would be slow and also that I might run into a string length limit, if I ever needed to use it for a large list. If I remember correctly, arrays can fit more items, and strings are limited (perhaps to 32k characters or something like that)? Might of course work very well for shorter lists.

@Pete: Ah, that's clever - I hadn't seen that post! But yeah, I would probably never have succeeded in reading/decoding that explanation Big Grin
Reply
#17
@Heimdall

Thanks! Glad you got in. 

In regard to humor, I do all my own material, although I'm pretty sure a lot of stuff I made up was also thought up by others. I actually did standup in my college years, but decided to go a different rout, professionally. Sometimes I regret it, as comedians always have tons of return fans... mostly because they are too drunk to remember the jokes... just like the fans!

Pete Big Grin
Reply
#18
Actually, strings aren't limited. It is just a continous memory block, and it can be of any size.
I use it for sizes upto 4gb...

But they are slow, because whenever we edit the length of a string, it is copied to another location. -> Workaround is to use string buffers (which I use in my compression algorithms)
And about arrays, they are fast, but they use more data to store than strings, and are harder to manage when it comes to multi dimensional...
What about nested lists? Arrays cannot do that...

And Arrays are also slower for insertion and deletion.
But we have a workaround with strings for that too. (We can partition a string into multiple strings which will form an array -> this data structure is a Rope)
And I use Rope for my text editors, it is blazingly fast for both opening and saving files of sizes upto 200mb...

Now about my ListString: It uses sequential access, so I will make a new one which supports:
1. Lists
2. Maps (can be compared to Python Dictionaries)
3. Nested Data
This will enable us to parse JSON too.
And I will use an index map in the beginning of the list. Yes, it will make it bigger, but it will be useful for random access.
Then we can think of hash tables... Now this is a little far... Big Grin

Well, if you wanna build something, good luck.
And we are always here to help.
Reply
#19
(12-19-2025, 04:32 AM)aadityap0901 Wrote: Now about my ListString: It uses sequential access, so I will make a new one which supports:
1. Lists
2. Maps (can be compared to Python Dictionaries)
3. Nested Data
This will enable us to parse JSON too.
And I will use an index map in the beginning of the list. Yes, it will make it bigger, but it will be useful for random access.
Then we can think of hash tables... Now this is a little far... Big Grin

Well, if you wanna build something, good luck.
And we are always here to help.
@aadityap0901, thanks for elaborating. I don't have any strong urge to reinvent the wheel, just for the sake of reinventing the wheel  Big Grin So if you want to share your updated version when you have it, I'd be happy to try that instead. Meanwhile, I think i have some reading to do. There's a lot of interesting information here to process for a QB64-PE newbie  Smile
Reply


Possibly Related Threads…
Thread Author Replies Views Last Post
  Sub not Reconizing Dim as String pmackay 18 1,449 10-16-2025, 03:32 PM
Last Post: pmackay
  for performance, what's the best variable type to use for boolean _TRUE & _FALSE ? madscijr 12 1,227 09-29-2025, 02:59 PM
Last Post: dakra137
  Using modulo to loop through lists fistfullofnails 3 708 09-03-2025, 11:50 PM
Last Post: fistfullofnails
  Loading from file into _MEM? and LEN a TYPE... Unseen Machine 9 958 08-03-2025, 02:55 AM
Last Post: SMcNeill
  Illegal string-number conversion Herve 7 759 07-07-2025, 09:53 AM
Last Post: a740g

Forum Jump:


Users browsing this thread: 1 Guest(s)