02-29-2024, 02:50 PM
Hey @PhilOfPerth -- Are you certain that this dictionary is 100% alphabetic, and that these words don't have any typos in them? Particularly a typo which might cause a word to be out of order?
From the screenshot above, "zebra" isn't found.
I edited my code to add in a simple little CombSort routine, to make certain our lists were alphabetical, and then PRESTO -- "zebra" exists once again and gives me a definition.
Also need to point out that after looking at the actual file, we need to skip the first two lines of this file as they're header information and not part of the wordlist itself. Code above also accounts for that change.
From the screenshot above, "zebra" isn't found.
I edited my code to add in a simple little CombSort routine, to make certain our lists were alphabetical, and then PRESTO -- "zebra" exists once again and gives me a definition.
Code: (Select All)
dict$ = "Collins.txt"
Screen _NewImage(800, 600, 32)
Type Dict_Type
As String Word, Definition
End Type
ReDim Shared Dict(1000000) As Dict_Type
load_time1# = Timer
temp$ = _ReadFile$(dict$)
sp = 1
count = -1
Do
ep = InStr(sp, temp$, Chr$(13) + Chr$(10))
temp1$ = Mid$(temp$, sp, ep - sp)
l = InStr(temp1$, Chr$(9)) 'tab separated data file
count = count + 1
If count > 0 Then 'first two lines in the data file are garbage.
Dict(count).Word = _Trim$(Left$(temp1$, l - 1))
Dict(count).Definition = _Trim$(Mid$(temp1$, l))
End If
sp = ep + 2
Loop Until sp >= Len(temp$)
ReDim _Preserve Dict(count) As Dict_Type
combsort
load_time2# = Timer
Dim Junk(10) As String
Data cheese,dog,cat,elephant,rootbeer,house,food,drink,mouse,zebra
For i = 1 To 10
Read Junk(i)
Next
t# = Timer
For k = 1 To 10000
For i = 1 To 10
f = FindWord(Junk(i))
If k = 1 Then 'no need to scroll the screen and print the words repeatedly
If f = 0 Then
Print Junk(i), "Word not found"
Else
Print Junk(i), Dict(FindWord(Junk(i))).Definition
End If
End If
Next
Next
t1# = Timer
Print Using "###.######## seconds to load dictionary with ###,###,### words."; loadtimer2# - loadtime1#, count
Print Using "###.######## seconds to find #### words and definitions, ###,###,### repeated times."; t1# - t#, i - 1, k - 1
Function FindWord (word$)
Dim As Long low, hi, test
low = 1: hi = UBound(Dict)
While low <= hi
test = Int((low + hi) / 2)
Select Case _StriCmp(Dict(test).Word, word$)
Case 0
'Print "found"; test
FindWord = test: Exit Function
Case -1
'Print "low"; Dict(test).Word
low = test + 1
Case 1
'Print "high"; Dict(test).Word
hi = test - 1
End Select
Wend
End Function
Sub combsort
'This is the routine I tend to use personally and promote.
'It's short, simple, and easy to implement into code.
gap = UBound(Dict)
Do
gap = 10 * gap \ 13
If gap < 1 Then gap = 1
i = 0
swapped = 0
Do
If Dict(i).Word > Dict(i + gap).Word Then
Swap Dict(i).Word, Dict(i + gap).Word
Swap Dict(i).Definition, Dict(i + gap).Definition
swapped = -1
End If
i = i + 1
Loop Until i + gap > UBound(Dict)
Loop Until gap = 1 And swapped = 0
End Sub
Also need to point out that after looking at the actual file, we need to skip the first two lines of this file as they're header information and not part of the wordlist itself. Code above also accounts for that change.