[RESOLVED] finding the number of tokens of a word in a string

[litlewiki]

hello everyone

i'm writing a program that finds out how many times a word has been repeated in a string

this is what i did

Dim chkstr(1 To 10) As String
 
temp = rtb.Text
 
Do While i <= Len(temp)
 
i = i + 1
chkstr(i) = Mid$(temp, 1, InStr(1, temp, Chr(32)))
 
temp = Mid$(temp, InStr(1, temp, Chr(32)) + 1, Len(temp))
 
If InStr(1, temp, Chr(32)) <= 0 Then
 
chkstr(i) = temp
 
Exit Do
 
End If
 
Loop

this adds all the words to the chkstr() array

now
the following should check if any word was repeated again before in the string

Dim wrdtoken(1 to 10) As Integer
 
For i = 2 To numWords
 
    For j = 1 To i - 1
 
        If StrComp(chkstr(i), chkstr(j), vbTextCompare) = 0 Then
            
            wrdtoken(i) = wrdtoken(i) + 1
         Else
 
            unique = False
            
        End If
    Next j
 
Next i

the numWords function::

Public Function NumWords() As Integer
Dim i As Integer
Dim temp As String
i = 0
temp = rtb.Text
 
Do While i <= Len(temp)
i = i + 1
temp = Mid$(temp, InStr(1, temp, Chr(32)) + 1, Len(temp))
If InStr(1, temp, Chr(32)) <= 0 Then Exit Do
Loop
 
numwords = i
End Function

but it doesnt work the way i thought it would.....any suggestions please

[Dnereb]

There is another approch to count the amount of repetitions of a word/character sequence.

on the fly:

Function CountA_Word(ByVal StrText As String, StrSequence As String) As Long

Dim L As Long

L = Len(Text)                                               'total length of text
CountA_Word = L - Len(Replace(StrText, StrSequence, ""))    'Length taken by the sequence

CountA_Word = CountA_Word / Len(StrSequence) 'divede throug the length of the sequence to get the number of occurences.

End Function

[bushmobile]

Private Function StringCount(ByVal sText As String, ByVal sFind As String) As Long
    StringCount = Len(Replace(sText, sFind, sFind & vbNullChar)) - Len(sText)
End Function

[litlewiki]

thanks bushmob it works like a charm but how to match for whole word only for eg the above code will give 3 if stext is say "why white which" and sfind is "wh"

[bushmobile]

here's one way:

Private Function WordCount(ByVal sText As String, ByVal sFind As String) As Long
    sText = " " & sText & " "
    Do While sText Like "*[!A-Z,a-z]" & sFind & "[!A-Z,a-z]*"
        sText = Replace(sText, sFind, vbNullString, , 1)
        WordCount = WordCount + 1
    Loop
End Function

[litlewiki]

okay bushmob this is what my assignment is abt

given a string
1.find repititive words in the strings
2.replace them with the the "starting pos:ending pos" of the first occurence of that word in the string

for e.g
the string "abc ddd efg abc abc ddd" will be "abc ddd efg 1:3 1:3 5:7"

iam trying to incorporate your ideas but things are getting really complicated ...

[bushmobile]

hmmmm, this is one of those things that have countless ways of being approached. It all depends on the situation really - on what is going to be contained in the string.

If it's only going to be "word word word word word" without any punctuation or anything then something similar to what you were attempting to do earlier might be one approach.

Create an array of the words using split:

sParts() = Split(sText)

Loop through each item in the array and compare it against all the following items:

For N = 0 To UBound(sParts)
        For I = N + 1 To UBound(sParts)

then compare the items and change if necessary:

If UCase$(sParts(I)) = UCase$(sParts(N)) Then sParts(I) = lPos & ":" & lPos + Len(sParts(N)) - 1

you'll need to keep track of the of the word, then at the end join all the bits of the array back together.

This is just one suggestion - writing a function that'll will work with punctuation as well is a bit more work.

[litlewiki]

no no there are no punctuation or special symbols just plain string of words... thanks for those code snippets anyway .i will be working on these and keep you updated as and when required...thanks a million bushmob

[bushmobile]

An alternative - which is a bit faster, would be to loop through the string picking out the words from between the spaces

Do
        lStart = InStr(lEnd, sText, " ")
        If lStart Then
            lEnd = InStr(lStart + 1, sText, " ")
            If lEnd Then
                ' Get the word with Mid$ including spaces either side

and then using the Replace function, starting it after the instance of the first word (which crops the string so you have to tack the start on yourself):

sText = Left$(sText, lEnd - 1) & Replace(sText, sWord, " " & lStart & ":" & lEnd - 2 & " ", lEnd)

[Dnereb]

You seem to overlook my example post 2. it's in basic the same as bushmobile only written less compact to let you understand the code.
The big diffrence is Bushmobile doesn't divide through the length of the string thet was searched to get the correct occurences.

Why gives 3 instead of one if it was 1 time in the text, but if it was diveded though the number of characters in Why (3) it would have been correct and the same as my post only written compact.

[bushmobile]

Dnereb: the code in posts #2 and #3 will give exactly the same answer - but post #3 has one less operation.

You'll also notice (posts 6 and onward) that getting the number of occurances of a string within another string isn't what litlewiki is actually trying to do making those posts redundant anyway.

[Dnereb]

I've noticed the change as well but I fail to see any use for it.

My two cents about this counting:
It is a poor way to compact text. In particular longer text with sequence that occur later in the text more often wil increas in size suppos the 'word'
Bad is first encountered at position 200 an wil be used often from then on.
bad...... 200:203....200:203.........200:203 etc
The number of three letter (not adding interpunction and numbers) sequences posible is 17576 (dutch alfabet) although not all are prenounceble.
the pronblem increases if you add four letter sequences.

[bushmobile]

I'm not sure there is a purpose to the modifying the string - i think it's just an exercise in string manipulation.

[litlewiki]

okay this is my new coding which iam attaching it here.
it works as per what i expected but now my professor says that i need to check for phrase and not words alone.
that is if the text is "the quick brown fox jumps over the red brown fox"
then it should be coded as "the quick brown fox jumps over 1:3 red 11:19"
and not the "quick brown fox jumps over 1:3 red 11:15 17:19" .
Now im totally confused as to how to do that...

i will paste the coding here

Option Explicit
Dim sText() As String
Dim N, i As Integer
 
 
Private Sub Command1_Click()
Dim tempstr, tempstr2, tempstr3 As String
Dim temp As Integer
sText() = Split(rtb.Text)
 
For N = 0 To UBound(sText)
    temp = 0
    For i = 0 To UBound(sText)
    
        If ((i <> N) And UCase$(sText(N)) = UCase$(sText(i))) Then
        
            temp = temp + 1
            
        End If
    
    Next i
    
        If temp = 0 Then
        'unique
        
        Else
        
 
rtb.Text = Mid$(rtb.Text, 1, InStr(1, rtb.Text, sText(N)) + Len(sText(N))) & Trim(Replace(Mid$(rtb.Text, Len(Mid$(rtb.Text, 1, InStr(1,_
rtb.Text, sText(N)) + Len(sText(N))))), sText(N), CStr(InStr(1, rtb.Text,_ 
sText(N))) & ":" & CStr(InStr(1, rtb.Text, sText(N)) + Len(sText(N)) - 1)))
        End If
 
Next N
 
 
End Sub

[litlewiki]

its just a string manipulation exercise ...the other name to this compression is dictionary based text compression and iam not supposed to use any inbuilt functions except the most used ones...

[bushmobile]

just a comment on your current code: that line is so ridiculously long that it's a wonder you have any idea what it's doing - you should store the results of functions that you are going to need more than once.

If you're interested, here is the function using Split that i came up with:

Private Function ProcessString(ByVal sText As String) As String
    Dim sParts() As String, lPos As Long, N As Long, I As Long
    sParts = Split(sText, " ")
    lPos = 1
    For N = 0 To UBound(sParts)
        If InStr(sParts(N), ":") = 0 And Len(sParts(N)) > 0 Then
            For I = N + 1 To UBound(sParts)
                If UCase$(sParts(I)) = UCase$(sParts(N)) Then sParts(I) = lPos & ":" & lPos + Len(sParts(N)) - 1
            Next I
        End If
        lPos = lPos + Len(sParts(N)) + 1
    Next N
    ProcessString = Join(sParts)
End Function

[litlewiki]

yea i know its ridiculously long i actually stored them in variables but .i just merged them to keep the code short (height wise ) .anyway ur code is smarter than mine ...but now how should i tackle the new situation....(detecting the pattern of phrases and not words)

[bushmobile]

well, to develop post #16 as an example - once you've found a match between sParts(I) and sParts(N) you'll need to loop comparing the consecutive words to each other, e.g.

If UCase$(sParts(I)) = UCase$(sParts(N)) Then
        For J = 1 To UBound(sParts) - I
            If UCase$(sParts(I + J)) = UCase$(sParts(N + J)) Then

[litlewiki]

alright i will work on that idea and post back if iam stuck thanks again bushmob