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