147 lines
4 KiB
Text
147 lines
4 KiB
Text
Type PathNode
|
|
word As String
|
|
parent As Integer
|
|
End Type
|
|
|
|
Function FindIndex(words() As String, w As String) As Integer
|
|
For i As Integer = 0 To Ubound(words)
|
|
If words(i) = w Then Return i
|
|
Next
|
|
Return -1
|
|
End Function
|
|
|
|
Function OneAway(a As String, b As String) As Boolean
|
|
If Len(a) <> Len(b) Then Return False
|
|
Dim As Integer diff = 0
|
|
For i As Integer = 1 To Len(a)
|
|
If Mid(a, i, 1) <> Mid(b, i, 1) Then
|
|
diff += 1
|
|
If diff > 1 Then Return False ' Early exit optimization
|
|
End If
|
|
Next
|
|
Return diff = 1
|
|
End Function
|
|
|
|
Sub WordLadder(words() As String, startWord As String, endWord As String)
|
|
If startWord = endWord Then
|
|
Print startWord
|
|
Return
|
|
End If
|
|
If Len(startWord) <> Len(endWord) Then
|
|
Print startWord; " into "; endWord; " cannot be done."
|
|
Return
|
|
End If
|
|
|
|
Dim As Integer i, n
|
|
' Filter only words of the appropriate length
|
|
Dim As String possibles()
|
|
For i = 0 To Ubound(words)
|
|
If Len(words(i)) = Len(startWord) Then
|
|
n = Iif(Lbound(possibles)=0 And Ubound(possibles)=-1, 0, Ubound(possibles)+1)
|
|
Redim Preserve possibles(n)
|
|
possibles(n) = words(i)
|
|
End If
|
|
Next
|
|
|
|
' Check existence
|
|
Dim As Integer startIdx = FindIndex(possibles(), startWord)
|
|
If startIdx = -1 Then
|
|
Print startWord; " it is not in the dictionary."
|
|
Return
|
|
End If
|
|
Dim As Integer endIdx = FindIndex(possibles(), endWord)
|
|
If endIdx = -1 Then
|
|
Print endWord; " it is not in the dictionary."
|
|
Return
|
|
End If
|
|
|
|
' BFS algorithm
|
|
Redim As Integer queue(0)
|
|
Redim As Integer visited(Ubound(possibles))
|
|
Redim As PathNode path(Ubound(possibles))
|
|
For i = 0 To Ubound(visited)
|
|
visited(i) = 0
|
|
path(i).parent = -1
|
|
Next
|
|
|
|
queue(0) = startIdx
|
|
visited(startIdx) = 1
|
|
path(startIdx).word = possibles(startIdx)
|
|
path(startIdx).parent = -1
|
|
|
|
Dim As Integer head = 0, tail = 0
|
|
Dim As Boolean found = False
|
|
|
|
While head <= tail And Not found
|
|
Dim As Integer currIdx = queue(head)
|
|
head += 1
|
|
For i = 0 To Ubound(possibles)
|
|
If visited(i) = 0 And OneAway(possibles(currIdx), possibles(i)) Then
|
|
visited(i) = 1
|
|
path(i).word = possibles(i)
|
|
path(i).parent = currIdx
|
|
tail += 1
|
|
Redim Preserve queue(tail)
|
|
queue(tail) = i
|
|
If i = endIdx Then
|
|
found = True
|
|
Exit For
|
|
End If
|
|
End If
|
|
Next
|
|
Wend
|
|
|
|
' Reconstruct and print the path if found
|
|
If found Then
|
|
Dim As String result()
|
|
Dim As Integer curIdx = endIdx
|
|
|
|
Do While curIdx <> -1
|
|
n = Iif(Lbound(result)=0 And Ubound(result)=-1, 0, Ubound(result)+1)
|
|
Redim Preserve result(n)
|
|
result(n) = possibles(curIdx)
|
|
curIdx = path(curIdx).parent
|
|
Loop
|
|
|
|
' Print path in reverse (from start to end)
|
|
For i = Ubound(result) To 0 Step -1
|
|
Print result(i);
|
|
If i > 0 Then Print " -> ";
|
|
Next
|
|
Print
|
|
Else
|
|
Print startWord; " into "; endWord; " cannot be done."
|
|
End If
|
|
End Sub
|
|
|
|
Sub main()
|
|
Dim As String words()
|
|
Dim As Integer i, n
|
|
|
|
' Read dictionary
|
|
Dim As Integer ff = Freefile
|
|
Dim As String word
|
|
If Open("unixdict.txt" For Input As #ff) = 0 Then
|
|
Do Until Eof(ff)
|
|
Line Input #ff, word
|
|
n = Iif(Lbound(words)=0 And Ubound(words)=-1, 0, Ubound(words)+1)
|
|
Redim Preserve words(n)
|
|
words(n) = word
|
|
Loop
|
|
Close #ff
|
|
Else
|
|
Print "Error reading file"
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim As String pairs(7, 1) = { _
|
|
{"boy", "man"}, {"girl", "lady"}, {"john", "jane"}, {"child", "adult"}, _
|
|
{"cat", "dog"}, {"lead", "gold"}, {"white", "black"}, {"bubble", "tickle"} }
|
|
For i = 0 To Ubound(pairs, 1)
|
|
WordLadder(words(), pairs(i, 0), pairs(i, 1))
|
|
Next
|
|
End Sub
|
|
|
|
main()
|
|
|
|
Sleep
|