String Optimization

[Merri]

I agree with leinad in this one. I originally went on ahead with the offtopic since there wasn't anything better to get on with (and besides, it did get some nice information out). Looking at just one point and finding "The Best" solution for that isn't enough, you still have to look at the bigger picture. And even that "Best Solution" doesn't work for everything (and I still value fixed size growth "better" for most cases). In this case the best one would be to not use ReDim Preserve in the first place, and it can be done easily. Thus talking about the best way to increase an array with ReDim Preserve is "obsolete" at this point and would be only worthy in it's own dedicated thread. Which we don't have.

Hope we'll get a reply from the thread starter, the thread got longer than I expected very fast (and I didn't notice it until we were on the second page ). We can't help further with the optimization until we know more of what the arrays contain and what is being done.

[coolcurrent4u]

thanks all i was trying to make a word wrap routine so that i can use it to send output to the printer. But i will still keep looking. any ideas?

[Ellis Dee]

Of course it will have no relevance if you choose it interpret it as such. It was in reply to what was raised... I really couldn't care less who raised it.

You doggedly refused to answer the question I raised, instead focusing solely on the OP's specific question. So clearly you did care who raised the question.

I repeat: When you need to write a solution where you can't possibly know how many items your array will eventually need -- anywhere from hundreds to millions -- what is the best way to grow that array inside a loop?

[Ellis Dee]

thanks all i was trying to make a word wrap routine so that i can use it to send output to the printer. But i will still keep looking. any ideas?

Didn't si's solution in post 3 and Merri's solution in post 4 both work?

[Merri]

I repeat: When you need to write a solution where you can't possibly know how many items your array will eventually need -- anywhere from hundreds to millions -- what is the best way to grow that array inside a loop?

Continuing in Array ReDim performance thread.

[coolcurrent4u]

What are you trying to do? An example in words would help.

the routine is to filter an array of word eg

original array ('aa','ab','ac','ad','ae','af','ag','ah','ai','aj')

now remove the following array of words ('ah','af','aa','aj')


this should produce

('ab','ac','ad','ae','ag','ai')

hope it explains what am trying to do

[coolcurrent4u]

th reason is to code a word wrapping routine and at the same time to filter an array of words

[leinad31]

th reason is to code a word wrapping routine and at the same time to filter an array of words

Sort both arrays first.

Iterate through second array. If there are duplicates then skip if next element (if not at end of second array) is the same (no sense in searching for the same token in first array twice since first pass would have already removed it).

Find start and end location (array index) of token in first array (to determine how many will be removed). Use Copy Memory API to shift trailing elements towards start index.

For next token in second array, start looking in first array from where you left off (don't restart search at index 0, or you will need to keep track of index in first array).

Repeat process until all tokens in second array have been processed.


Variation is to process the arrays from the end rather than at index 0. This way you end up moving less array elements with copymemory in succeeding passes. There are already several samples in using CopyMemory, do a search.


Summary of concepts:
- Minimize redim preserve (for above process, just once)
- Perform bulk copy instead of moving them one by one (use of CopyMemory).
- You don't always have to process the data as it is. Sometimes it is better to transform data to facilitate processing (tokens sorted first, better if already sorted beforehand such as when array element was added).
- Understand the context of the process... don't focus on just several lines of code (perform relevant systems analysis and design). You also have to take into consideration how components interact at run-time. Try to meet the system requirements as a whole rather than individually.

[MartinLiss]

the routine is to filter an array of word eg

original array ('aa','ab','ac','ad','ae','af','ag','ah','ai','aj')

now remove the following array of words ('ah','af','aa','aj')


this should produce

('ab','ac','ad','ae','ag','ai')

hope it explains what am trying to do

Can the original array contain duplicates, in other words something like this?

original array ('aa','ab','ac','aa','ad','ae','af','ag','aa','ah','ai','aj')

[coolcurrent4u]

Can the original array contain duplicates, in other words something like this?

original array ('aa','ab','ac','aa','ad','ae','af','ag','aa','ah','ai','aj')

yes it can contain duplicates. of course younever can know what data will be passed to the function or mabe class
eg

function filterwords(arry1,arry2)

......

end function

[coolcurrent4u]

Sort both arrays first.

Iterate through second array. If there are duplicates then skip if next element (if not at end of second array) is the same (no sense in searching for the same token in first array twice since first pass would have already removed it).

Find start and end location (array index) of token in first array (to determine how many will be removed). Use Copy Memory API to shift trailing elements towards start index.

For next token in second array, start looking in first array from where you left off (don't restart search at index 0, or you will need to keep track of index in first array).

Repeat process until all tokens in second array have been processed.


Variation is to process the arrays from the end rather than at index 0. This way you end up moving less array elements with copymemory in succeeding passes. There are already several samples in using CopyMemory, do a search.


Summary of concepts:
- Minimize redim preserve (for above process, just once)
- Perform bulk copy instead of moving them one by one (use of CopyMemory).
- You don't always have to process the data as it is. Sometimes it is better to transform data to facilitate processing (tokens sorted first, better if already sorted beforehand such as when array element was added).
- Understand the context of the process... don't focus on just several lines of code (perform relevant systems analysis and design). You also have to take into consideration how components interact at run-time. Try to meet the system requirements as a whole rather than individually.

can you please give me a working code

[anhn]

If both arrays are not too large, this is a simple way to filter as you want:

Sub FilterArray(Array1, Array2)
   Dim sTemp As String, sItem As String
   Dim i As Long
   
   If IsArray(Array1) = False Then Exit Sub
   If IsArray(Array2) = False Then Exit Sub
   
   sTemp = vbTab & Join(Array1, vbTab) & vbTab
   For i = LBound(Array2) To UBound(Array2)
      sItem = vbTab & Array2(i) & vbTab
      Do While InStr(sTemp, sItem)
         sTemp = Replace(sTemp, sItem, vbTab)
      Loop
   Next
   sTemp = Mid$(sTemp, 2, Len(sTemp) - 2)
   Array1 = Split(sTemp, vbTab)

End Sub

Sub Test()
   Dim Array1, Array2
   Dim i As Long
   
   Array1 = Array("aa", "ab", "ac", "ad", "ae", "af", "ag", "ah", "ai", "aj")
   Array2 = Array("ah", "af", "aa", "aj")
   FilterArray Array1, Array2
   
   For i = 1 To UBound(Array1)
      Debug.Print Array1(i)
   Next
End Sub

[leinad31]

BTW I assumed that the array is large and that data volume is one of the root causes of performance bottleneck (hence copymemory suggestion).

[Merri]

There is also VB inbuilt mechanism:

Option Explicit

Private Sub Form_Load()
    Dim strArray() As String, strRemove() As String, lngA As Long
    
    strArray = Split("aa ab ac ad ae af ag ah ai aj")
    strRemove = Split("ah af aa aj")
    
    For lngA = 0 To UBound(strRemove)
        strArray = Filter(strArray, strRemove(lngA), False)
    Next lngA
    
    For lngA = 0 To UBound(strArray)
        Debug.Print strArray(lngA)
    Next lngA
End Sub

Haven't tested the performance.


Edit!
Since I had some code ready I thought to post a slightly optimized version:

Option Explicit

Private Sub Form_Load()
    Dim strArray() As String, strRemove() As String, lngA As Long
    Dim SF As New StringFilter
    
    strArray = Split("aa ab ac ad ae af ag ah ai aj")
    strRemove = Split("ah af aa aj")
    
    SF.Filter strArray, strRemove
    
    For lngA = 0 To UBound(strArray)
        Debug.Print strArray(lngA)
    Next lngA
End Sub

Of course the most interesting code is here: StringFilter.cls – the Filter procedure can be optimized further by sorting at least the Match array and then taking the return value of BinaryCompare/lstrcmpW/lstrcmpiW on comparison and ending comparisons if it is an exact match or if we already went through the possible matches.

[coolcurrent4u]

many thanks for all ya contributions

[Code Doc]

many thanks for all ya contributions

OP, I am not sure why you are trying to choke off this thread. I find it fascinating. When AnHn threw his hat in the ring, things really got interesting. We have a discussion going on between 5 or 6 of the best programmers that exist. That's MHO.

Can someone write a PM to Logophobic to alert him of this thread? I think it deserves his input on growing an array.

[coolcurrent4u]

ok, i just thot abt somting, if i actually have a string of words and will like to remove duplicate words from the string. so i thot converting the string to array andthen filtering it.

but i ound that this is slower as in an instance one array could be 1 million words long convertingto array and then convertingback to string is dam slow

what do you guys suggest?


thanks in advance for any help

[coolcurrent4u]

Code Doc i dont understand what you are trying to say?

We have a discussion going on between 5 or 6 of the best programmers that exist. That's MHO

[coolcurrent4u]

can the vb Filter function be used here?

[Merri]

VB's Filter would be too slow, it creates a new array each time it is called. A better method in your case would be so separate the words into a sorted string array and then remove the duplicates.

You can see a somewhat better approach in StringSort.cls and it's FilterDuplicates method. It isn't optimal, but it uses Merge Sort to create a sorted index array, then remove duplicates and finally sort the indexes back into their original order and create a new array. It for the least beats the easiest-to-come-up-with functions by a great margin (easy: 1) add to Collection using Key or 2) compare each string array item against each other).

There was another thread on almost the same subject, but I'm too lazy to search for it atm

[anhn]

Code Doc i dont understand what you are trying to say?

We have a discussion going on between 5 or 6 of the best programmers that exist. That's MHO

Code Doc is one of them, I am not.

I have spent 3 hours on another approach that is much faster as below. Code Doc and others are welcome to optimize it.
This only works with ANSI text file.
The test was run on WIN32API.TXT with filesize of 652KB that contains 86,445 words. After filtered it was reduced to 9,634 words.
The data reading from the text file is converted to lowercase and cleaned up to remove all non-English-alphabet characters.
All words are separated by single-spaces.
26 Dic strings are used to stored non-duplicated words found.

Option Explicit

Sub FilterDuplicateWords()
    Dim sFolder As String, sFName As String
    Dim bData() As Byte, bData2() As Byte
    Dim sData As String, sWord As String
    Dim sDic(0 To 25) As String
    Dim m(0 To 25) As Long
    Dim bSpace As Byte, b As Byte
    Dim i As Long, j As Long, n As Long, p As Long
    Dim w(-1 To 26) As Long
    
    Dim sMsg As String
    Dim t As Single
        
    t = Timer
        
    sFolder = "C:\API\"
    sFName = "WIN32API.TXT"
    
    Open sFolder & sFName For Binary As #1
    sData = Input(LOF(1), 1)
    Close #1
    
    sMsg = "Reading Data: " & vbTab & (Timer - t) & " seconds"
    t = Timer
    
    bData = StrConv(LCase(sData), vbFromUnicode)
    
    sMsg = sMsg & vbCrLf & "Converting: " & vbTab & (Timer - t) & " seconds"
    t = Timer
    
    '-- clean up Data --------------------------------
    ReDim bData2(UBound(bData) + 2)
    bData2(0) = 32 '-- set a Space as first chararcter
    bSpace = 1
    j = 0
    For i = 0 To UBound(bData)
        Select Case bData(i)
            Case 97 To 122:  j = j + 1: bData2(j) = bData(i): bSpace = 0
            Case Else: If bSpace Then Else j = j + 1: bData2(j) = 32: bSpace = 1
        End Select
    Next
    If bSpace Then Else j = j + 1: bData2(j) = 32 '-- set a Space as last chararcter
    ReDim Preserve bData2(j)
    
    sData = StrConv(bData2, vbUnicode)
    Erase bData, bData2
    
    sMsg = sMsg & vbCrLf & "Cleaning up: " & vbTab & (Timer - t) & " seconds"
    t = Timer

    '-- Filering duplicate words ----------------------
    For b = 0 To 25
        sDic(b) = Space$(Len(sData))        '-- prepare rooms for Dic
        m(b) = 1                            '-- first space position in Dic(b)
    Next
    i = 1 '-- first space position in data
    p = 1 '-- last space position in new data
    Do While i < Len(sData)
        j = InStr(i + 1, sData, " ")        '-- next space position in data
        n = j - i + 1                       '-- len of word with leading and trailing spaces
        sWord = Mid$(sData, i, n)           '-- next word found in data
        b = Asc(Mid$(sWord, 2, 1)) - 97     '-- index of Dic
        w(-1) = w(-1) + 1                   '-- original word counter
        If InStrB(1, Left$(sDic(b), m(b)), sWord) = 0 Then '-- search Dic(b)
            Mid$(sDic(b), m(b), n) = sWord  '-- word not found, add to Dic
            m(b) = m(b) + n - 1             '-- last space position in Dic(b)
            w(b) = w(b) + 1                 '-- Dic(b) word counter
            Mid$(sData, p, n) = sWord       '-- also add word to new data to pretend order
            p = p + n - 1                   '-- last space position in new data
            w(26) = w(26) + 1               '-- new word counter
        End If
        i = j
    Loop
    
    sMsg = sMsg & vbCrLf & "Filtering:   " & vbTab & (Timer - t) & " seconds"
    t = Timer
    
    '-- Saving filtered words ------------------
    Open sFolder & "Words.txt" For Output As #1
    Print #1, Mid$(sData, 1, p);
    Close #1
        
    sMsg = sMsg & vbCrLf & "Saving Data: " & vbTab & (Timer - t) & " seconds"
    
    sMsg = sMsg & vbCrLf & vbCrLf & "Before Filtered: " & vbTab & w(-1) & " words"
    sMsg = sMsg & vbCrLf & "After Filtered: " & vbTab & w(26) & " words"
    For b = 0 To 25
        sMsg = sMsg & vbCrLf & Chr$(b + 97) & " = " & w(b)
    Next
    
    MsgBox sMsg
    
    sData = "": Erase sDic, m, w

End Sub

Reading Data:   2.15625 seconds
Converting:     0.015625 seconds
Cleaning up:    0.265625 seconds
Filtering:      1.078125 seconds
Saving Data:    0.015625 seconds

Before Filtered:    86445 words
After Filtered:     9634 words
a = 386
b = 308
c = 774
d = 835
e = 446
f = 363
g = 588
h = 324
i = 489
j = 40
k = 39
l = 860
m = 465
n = 472
o = 244
p = 579
q = 50
r = 438
s = 983
t = 258
u = 189
v = 82
w = 357
x = 35
y = 21
z = 9

[coolcurrent4u]

anhn

just how do i use your code example. which is the large array and which is the smallar array

the large array is assumed to be the one containig long words
the small array the the words that will either be removed or kept in th larger array
thanks

[coolcurrent4u]

Can you help me otimize this code, i found a way my sefl but it has some bugs

Function ExtractWords(WordsToFind() As String, FindInText() As String, Optional Keep As Boolean = True) As String()
    Dim tmpArray()      As String
    Dim i               As Long, intT1 As Long, intT2 As Long, j As Long, k As Long
    '// check for empty variables//
    If UBound(WordsToFind) = -1 Or UBound(FindInText) = -1 Then
        Exit Function
    End If
    '// check if we have multiple words //
    intT1 = UBound(WordsToFind)
    intT2 = UBound(FindInText)
    k = -1
    For i = 0 To intT2 - 1
        For j = 0 To intT1
            If Keep = True Then
                If InStr(1, FindInText(i), WordsToFind(j), vbTextCompare) > 0 Then
                    k = k + 1
                    ReDim Preserve tmpArray(k)
                    If Not inArray(FindInText(i), tmpArray()) Then
                        tmpArray(k) = Trim$(FindInText(i))
                    End If
                End If
        
            Else
                If InStr(1, FindInText(i), WordsToFind(j), vbTextCompare) < 1 Then
                    k = k + 1
                    ReDim Preserve tmpArray(k)
                    If Not inArray(FindInText(i), tmpArray()) Then
                        tmpArray(k) = Trim$(FindInText(i))
                    End If
                End If
            End If
        Next
    Next
    ExtractWords = tmpArray
End Function
Function inArray(SearchText As String, StringArray() As String) As Boolean
    Dim tmpStrings()      As String, tmpString As String
    tmpString = Join(StringArray, " ")
    tmpStrings() = Split(tmpString, SearchText)
    If UBound(tmpStrings()) > 0 Then
        inArray = True
    Else
        inArray = False
    End If
End Function