Program som sammenligner ord

[LooneyTune]

Jeg holder på å lage et program som skal kunne sammenligne ord, f.eks: Du har ordet "matte", du stokker om på bokstavene og får ordet "tetam". I mitt program skal brukeren kunne skrive inn en liste over ord som er stokket om på, listen skal bli sammenlignet med en ord liste, og brukeren skal få di rette ordene. Måten jeg skal sammenligne brukerens liste med ordlisten på, er å konvertere alle ordene i begge listene om til ascii. Deretter finner programmet summen av alle ascii verdiene i hvert ord, ord som er like vil da få samme ascii verdi. Koden jeg har skrevet til nå er til å konvertere ordlisten om til ascii, men det er en feil i koden og jeg finner ikke ut hva den er Koden min:

Dim tekst
Dim buff

Option Base 1

Dim ascWordlist()
Dim teller
Dim worslist()
Dim i As Integer
Dim s As Integer
Dim lengde

Private Sub Command1_Click()
wordlist = Split(Text1.Text, vbNewLine)
lengde = UBound(wordlist)
teller = "1"
For s = 1 To lengde
For i = 1 To Len(wordlist(teller))
ascWordlist(teller) = ascWordlist(teller) + Asc(Mid(wordlist(teller), i))
Next i
teller = teller + 1
Next s
End Sub

[Jonas]

Det første jeg legger merke til er at du har deklarert worslist, men bruker wordlist. Skriv Option Explicit i toppen av koden for å unngå slik variabel-feil. Det bør gjøres alltid, ikke bare under debugging - da forhindrer du slike feil.

 

Det er også forøvrig unødvendig å legge til +1 hver loop (teller) da du bare kan skrive S istedenfor.

 

I tillegg kan du også droppe Option Base 1, skaper ikke annet enn surr. Du kan hente out Lower Bound i et array på samme måte som du henter ut Upper Bound, med LBound().

 

Legger med et eksempel på hvordan jeg ville ha gjort det.

 

Option Explicit

 

Private Sub Form_Load()

   

    MsgBox ascWord("matte")

    MsgBox ascWord("tetam")

   

End Sub

 

Private Function ascWord(strWord As String) As Integer

   

    Dim intTell As Integer

    Dim intValue As Integer

   

    For intTell = 1 To Len(strWord)

       

        intValue = intValue + Asc(Mid(strWord, intTell, 1))

       

    Next intTell

   

    ascWord = intValue

   

End Function

Endret 6. januar 2007 av Jonas

[Harald Staff]

Du vet selvfølgelig at ascii-sum av "AC" er det samme som av "BB". Det gjør kanskje ikke så mye.

Du har et valg "require variable declarations" i editoren din et sted. Slå den på så kommer Option Explicit i alle nye moduler. Det er litt uvant å måtte være nøyaktig i starten, men det er den eneste måten å få meningsfylte feilmeldinger underveis.

 

Beste hilsen Harald

[HDSoftware]

Du vet selvfølgelig at ascii-sum av "AC" er det samme som av "BB". Det gjør kanskje ikke så mye.

Du har et valg "require variable declarations" i editoren din et sted. Slå den på så kommer Option Explicit i alle nye moduler. Det er litt uvant å måtte være nøyaktig i starten, men det er den eneste måten å få meningsfylte feilmeldinger underveis.

 

Beste hilsen Harald

7672248[/snapback]

Og "LIV" vil gi det samme som "VIL" etc. etc.

 

Jeg er litt nysgjerrig på hva du prøver å lage her. Er det et ANAGRAM program eller en slags Rettskrivings liste?

 

Hvis det er Rettskriving du prøver på ville jeg gått for lydskrift i stedet for ascii verdier. Tror det er den mest effektive ord gjennkjennings metoden. Skulle ikke meg forunder om du ikke finner dette i .net biblioteket et sted, men det er ikke godt å si.

 

Ole

[GeirGrusom]

Det virker som et anagram-program (hehe) og da spiller jo det ingen rolle, siden det er akkurat det resultatet han er ute etter. (tror jeg da)

[HDSoftware]

Det virker som et anagram-program (hehe) og da spiller jo det ingen rolle, siden det er akkurat det resultatet han er ute etter. (tror jeg da)

7679455[/snapback]

Ja, men problemet er at hans fremgangsmåte umulig kan brukes til anagram, nettop fordi AC i så fall vil ha samme verdi som BB o.s.v. og derfor ikke gi anagrammer. Da må han i så fall lage en "Anagramifisator" (hehe), noe jeg ikke en gang orker å tenke på å si noe om ;-)

 

Ole

[GeirGrusom]

Det er sant, det tenkte jeg ikke på

Tell opp antall bokstaver, og gå igjennom en tekststreng, og sjekk hvor mange ganger hver bokstav blir brukt?

 

Hmmmm... virker veldig tungvint....

[LooneyTune]

For å gjøre det klart hva programmet skal gjøre: Jeg får 10 ord (der bokstavene er stokket om), som er tatt tilfeldig ut av en ordliste (som er lagt ved i denne posten). Jeg har 30 sekunder til å finne ut hvilkene ord det er, og skrive dem inn som "ord1, ord2" osv. Har noen en bedre idè til hvordan jeg kan løse denne oppgaven?

wordlist.txt

Endret 13. januar 2007 av LooneyTune

[aadnk]

Har noen en bedre idè til hvordan jeg kan løse denne oppgaven?

7714974[/snapback]

Jada. Du kan søke etter forekomster av karakterer og sammenlikne dette med alle ord i listen. Dette kan du eksempelvis gjøre som følger (legg til en tekstboks kalt txtWord, en knapp kalt cmdSearch):

' Teller hvor mange ganger en karakter forekommer

Private Type Character

    Char As Long

    Count As Long

End Type

 

' Representerer et ord

Private Type Word

    Text As String

    Characters() As Character

End Type

 

' Listen over alle ord

Private aWords() As Word

 

Private Function CountCharacters(Text As String) As Character()

 

    Dim Tell As Long, aCharacters() As Character, iCount As Long, iChar As Long, iIndex As Long

 

    ' Gå gjennom hver karakter i strengen

    For Tell = 1 To Len(Text)

   

        ' Hent ut en numerert reresentasjon

        iChar = AscW(Mid(Text, Tell, 1))

   

        ' Dersom karakteren ikke er opplistet, ...

        If Not FindCharacter(aCharacters, iChar, iIndex) Then

       

            ' ... lager vi en nytt element

            ReDim Preserve aCharacters(iCount)

           

            ' Lagre karakterverdi

            aCharacters(iCount).Char = iChar

           

            ' Sett indeks og øk teller

            iIndex = iCount

            iCount = iCount + 1

       

        End If

   

        ' Øk antall forekomster

        aCharacters(iIndex).Count = aCharacters(iIndex).Count + 1

   

    Next

 

    ' Returner array

    CountCharacters = aCharacters

 

End Function

 

Private Function FindCharacter(aCharacters() As Character, ByVal Char As Long, outIndex As Long) As Boolean

 

    On Error GoTo EmptyArray

    Dim iLow As Long, iHigh As Long, Tell As Long

   

    ' Finn grenseverdier

    iLow = LBound(aCharacters)

    iHigh = UBound(aCharacters)

 

    ' Gå gjennom alle elementer

    For Tell = iLow To iHigh

        If aCharacters(Tell).Char = Char Then

   

            ' Vi fant karakteren - returner indeks

            outIndex = Tell

            FindCharacter = True

            Exit Function

   

        End If

    Next

   

Exit Function

EmptyArray:

    ' Arrayen er sannsynligvis tom, og vi kan følgelig ikke finne karakteren.

End Function

 

Private Sub LoadWords(Path As String, aWords() As Word)

 

    Dim Free As Long, sLine As String, iCount As Long

   

    ' Hent ledig filnummer

    Free = FreeFile

 

    ' Last inn ordliste, ord for ord

    Open Path For Input As #Free

       

        ' Gå gjennom alle linjer

        Do Until EOF(Free)

           

            ' Last inn linje

            Line Input #Free, sLine

           

            ' Lag et nytt element

            ReDim Preserve aWords(iCount)

           

            ' Sett egenskaper

            With aWords(iCount)

                .Text = sLine

                .Characters = CountCharacters(sLine)

            End With

           

            ' Øk teller

            iCount = iCount + 1

       

        Loop

       

    Close #Free

 

End Sub

 

' Leter etter et ord basert på en array av karakterer i ordlisten.

Private Function FindWord(Characters() As Character) As Long

 

    Dim Tell As Long, Temp As Long, bNotFound As Boolean

   

    ' Gå gjennom alle ord i listen

    For Tell = LBound(aWords) To UBound(aWords)

   

        ' Se om antall karakterer i vår array er lik den i ordet

        If CountArray(aWords(Tell).Characters) = CountArray(Characters) Then

           

            ' Tilbakestill variabler

            bNotFound = False

           

            ' Se om hver karakter i den første arrayen er tilstede i den andre

            For Temp = LBound(Characters) To UBound(Characters)

                If Not Exists(aWords(Tell).Characters, Characters(Temp)) Then

                    bNotFound = True

                    Exit For

                End If

            Next

           

            ' Dersom alle karakterer var funnet, ...

            If Not bNotFound Then

                ' ... vet vi at ordet vi leter etter er dette.

                FindWord = Tell

                Exit Function

            End If

           

        End If

       

    Next

 

    ' Returner ikke funnet

    FindWord = -1

 

End Function

 

Private Function Exists(Characters() As Character, ToFind As Character) As Boolean

 

    Dim Tell As Long

 

    ' Gå gjennom alle karakterer

    For Tell = LBound(Characters) To UBound(Characters)

   

        ' ... og se om noen av karakterene er lik den gitte karakter

        If (ToFind.Char = Characters(Tell).Char) And (ToFind.Count = Characters(Tell).Count) Then

            Exists = True

            Exit Function

        End If

    Next

 

End Function

 

Private Function CountArray(aCharacters() As Character) As Long

On Local Error Resume Next

 

    ' Returner antall elementer

    CountArray = -1

    CountArray = UBound(aCharacters) - LBound(aCharacters) + 1

   

End Function

 

Private Sub cmdSearch_Click()

 

    Dim Index As Long

 

    ' Først, finn alle karakterer i inndata

    Index = FindWord(CountCharacters(txtWord.Text))

   

    ' Hvis vi fant det, ...

    If Index >= 0 Then

        ' ... vis det til brukeren.

        MsgBox aWords(Index).Text

    Else

        MsgBox "Ikke funnet!"

    End If

 

End Sub

 

Private Sub Form_Load()

 

    ' Laster inn alle ord (endre sti til der du har lagret ordlisten)

    LoadWords "C:\Wordlist.txt", aWords

 

End Sub

Endret 14. januar 2007 av aadnk