RosettaCodeData/Task/Inverted-index/FreeBASIC/inverted-index.basic

116 lines
3.2 KiB
Plaintext

Const NULL As Any Ptr = 0
Type WordCant
arch As String
cant As Integer
sgte As WordCant Ptr
End Type
Type WordEntry
word As String
cnts As WordCant Ptr
sgte As WordEntry Ptr
End Type
Function addWord(root As WordEntry Ptr, word As String, arch As String) As WordEntry Ptr
Dim As WordEntry Ptr actual = root
Dim As WordCant Ptr newCant
' Search existing word
While actual <> NULL
If actual->word = word Then
' Word exists, update cant for file
Dim As WordCant Ptr cant = actual->cnts
While cant <> NULL
If cant->arch = arch Then
cant->cant += 1
Return root
End If
cant = cant->sgte
Wend
' Add new file cant
newCant = New WordCant
newCant->arch = arch
newCant->cant = 1
newCant->sgte = actual->cnts
actual->cnts = newCant
Return root
End If
actual = actual->sgte
Wend
' Add new word
Dim As WordEntry Ptr newEntry = New WordEntry
newCant = New WordCant
newCant->arch = arch
newCant->cant = 1
newCant->sgte = NULL
newEntry->word = word
newEntry->cnts = newCant
newEntry->sgte = root
Return newEntry
End Function
Function makeDoubleIndex(files() As String) As WordEntry Ptr
Dim As WordEntry Ptr index = NULL
For i As Integer = Lbound(files) To Ubound(files)
Dim As Integer ff = Freefile
Open files(i) For Input As #ff
Dim As String linea, word
While Not Eof(ff)
Line Input #ff, linea
linea = Lcase(linea)
Dim As Integer start = 1, posic
Do
posic = Instr(start, linea, Any " ,.;:!?()[]{}""'")
word = Mid(linea, start, Iif(posic = 0, Len(linea) - start + 1, posic - start))
word = Trim(word)
If Len(word) > 0 Then index = addWord(index, word, files(i))
start = posic + 1
Loop Until posic = 0
Wend
Close #ff
Next
Return index
End Function
Sub wordSearch(index As WordEntry Ptr, searchTerms() As String)
For i As Integer = Lbound(searchTerms) To Ubound(searchTerms)
Dim As String word = Lcase(searchTerms(i))
Dim As WordEntry Ptr entry = index
While entry <> NULL
If entry->word = word Then
Print Chr(34); word; Chr(34); " found in ";
Dim As WordCant Ptr cant = entry->cnts
While cant <> NULL
Print cant->arch;
If cant->sgte <> NULL Then Print ", ";
cant = cant->sgte
Wend
Print
Exit While
End If
entry = entry->sgte
Wend
If entry = NULL Then Print Chr(34); word; """ not found."
Next
End Sub
' Main program
Dim As String files(3) = {"file1.txt", "file2.txt", "file3.txt", "file4.txt"}
Dim As String searchTerms(4) = {"forehead", "of", "hand", "a", "foot"}
Dim As WordEntry Ptr index = makeDoubleIndex(files())
wordSearch(index, searchTerms())
Sleep