[vb6]aiuto per algoritmo

[uMoR]

ho un file con dentro circa 6500 parole e devo contare quante volte ogni singola parola viene ripetuta..
esempio:
-----------------
ciao
cane
neo
muro
cane
monitor
computer
ciao
-----------------

allora l'algoritmo mi deve dire:
ciao presente 2 volte, cane 2 ecc ecc

qual è il modo piu veloce per fare ciò ? (sia a livello codice che a livello esecuzione)

[Brainjar]

Una soluzione potrebbe essere l'uso di una Collection, per sfruttare
la sua proprietà Add che impedisce di inserire più di un oggetto con
la stessa chiave.
In un Form metti una textbox con MultiLine = True,
un bottone e una MSHFlexGrid, per vedere il risultato.
Nel Form copi questo codice.

Option Explicit
Dim Parole As New Collection
Dim sMoniker As String
Dim element As New cElement
Private Sub Command1_Click()
Dim sText As String
sText = Text1.Text
Set Parole = New Collection
Dim element As cElement
On Error Resume Next
Do While sText > ""
    sMoniker = Trim$(UCase$(StripNulls(sText)))
    If IsNull(Parole(sMoniker)) And sMoniker <> "" Then
        Set element = New cElement
        element.Count = 1
        element.Text = sMoniker
        Parole.Add element, sMoniker
    Else
        Set element = Parole(sMoniker)
        element.Count = element.Count + 1
        element.Text = sMoniker
        Set Parole(sMoniker) = element
    End If
Loop

If Parole.Count = 0 Then Exit Sub

MSHFlexGrid1.Rows = 0

For Each element In Parole
    If Trim$(element.Text) <> "" Then
        MSHFlexGrid1.AddItem element.Text & vbTab & element.Count
    End If
Next element


End Sub
Private Function StripNulls(startStrg As String) As String
    Dim c As Integer
    Dim Item As String
    c = 1
    Do
        ' Intercetta i separatori
        If Mid$(startStrg, c, 1) = Chr$(32) Or Mid$(startStrg, c, 1) = vbCr Or Mid$(startStrg, c, 1) = vbLf Or Mid$(startStrg, c, 1) = vbTab Then
            Item = Mid$(startStrg, 1, c - 1)
            startStrg = Mid$(startStrg, c + 1, Len(startStrg))
            StripNulls = Trim$(Item)
            Exit Function
        End If
        If c > Len(startStrg) Then Exit Do
        c = c + 1
    Loop
End Function

Aggiungi un modulo di Classe che chiami cElement

In cElement copi questo codice :

Option Explicit
Public Text As String
Public Count As Long

Come opera l'algoritmo :

1) Estrae le parole dalla stringa di testo del textbox.
Infatti la funzione StripNulls fa due cose
a) restituisce la prima parola contenuta nella stringa
b) accorcia la stringa per estrarre la prossima.

2) controlli se nella collection esiste un elemento con chiave
uguale alla parola che hai appena estratto.
Se no, inserisci l'elemento dopo aver impostato la sua proprietà
Count su 1.
Altrimenti aggiungi 1 a Count.

3) Alla fine scorre tutta la collection e inserisce nella Grid, le
proprietà Text e Count di ciascun elemento

Nell'esempio si parte da una textbox, ma non dovrebbe essere un
problema ottenere la stringa mediante la lettura da un file testo.

Ciao,

[uMoR]

ok provo subito grazie

[uMoR]

sembra andare in loop infinito e si prende il 100% della cpu a tempo indefinito anche con 3 elementi

[Brainjar]

Devi controllare quali caratteri sono utilizzati per separare i campi.
Io ho provato, e funziona, mettendo nella textbox proprio le righe
copiate dal tuo post:

ciao
cane
neo
muro
cane
monitor
computer
ciao

Se, però, usi un qualche altro delimitatore, devi prevederlo nella
funzione StripNulls.

In questa funzione viene escluso il Tab, il Return, il LineFeed e lo
spazio.

Mettilo in debug e controlla la sText in questa riga :

sMoniker = Trim$(UCase$(StripNulls(sText)))

Se va in loop vuol dire che trova un carattere delimitatore che non
riesce ad eliminare.


Ciao,

[Jupy64]

Ciao, se nel tuo file ogni riga è una parola, allora puoi fare anche una cosa del genere:

Private Sub ContaParole()
   Dim parole As Scripting.Dictionary
   Dim I As Long
   Dim riga As String
   Set parole = New Dictionary
   Open App.Path & "\parole.txt" For Input As #1
   Do While Not EOF(1)
      Line Input #1, riga
      If parole.Exists(riga) Then
         parole.Item(riga) = parole.Item(riga) + 1
      Else
         parole.Add riga, 1
      End If
   Loop
   Close #1
   For I = 0 To parole.Count - 1
      List1.AddItem parole.Keys(I) & " ==> " & parole.Items(I)
   Next
   Set parole = Nothing
End Sub

[uMoR]

tipo definito dall'utente non definito

[Brainjar]

tipo definito dall'utente non definito

A quale procedura ti riferisci ?
Se è quella che ti ho suggerito io, dove si verifica ?

Ciao.

[Jupy64]

ciao, per usare l'oggetto dictionary nel tuo progetto devi inserire il riferimento a Microsoft Scripting Runtime

[uMoR]

Set parole = New Dictionary