This Visual Basic program is a lot simpler (if lengthy) than the overcomplicated algorithm I posted on 1/16/2004.
Imports System
Imports System.IO
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.Math
Module Module1
Sub Main()
Randomize()
Dim strinputword As String = LCase("and")
Dim strwordlist(600000) As String
Dim intwordlistloop As Integer = 599999
Dim intloopnew As Integer
Dim strladder1(0, 0) As String
Dim strladder2(0, 0) As String
Dim intladdersize As Integer
Dim intladderloop1 As Integer
Dim intladderloop2 As Integer
Dim strstring As String
Dim strstarttime As String
Dim intcount1 As Integer
Dim strend As String
strstarttime = TimeOfDay
Console.WriteLine( _
strstarttime & ": " & _
"Beginning execution with word " & strinputword)
build_wordlist(strinputword, _
strwordlist, _
intwordlistloop, intloopnew)
intladdersize = Len(strinputword) + 1
ReDim strladder1(100000, intladdersize)
ReDim strladder2(100000, intladdersize)
intladderloop1 = 99999
intladderloop2 = intladdersize - 1
For index1 As Integer = 0 To intladderloop1
For index2 As Integer = 0 To intladderloop2
strladder1(index1, index2) = " "
Next
Next
gen_ladders(strladder1, strladder2, _
intladderloop1, intladderloop2, _
strinputword, _
strwordlist, intwordlistloop)
intcount1 = 0
For index1 As Integer = 0 To intladderloop1
If strladder1(index1, intladderloop2) <> " " Then
intcount1 += 1
End If
Next
If intcount1 = 0 Then
Console.WriteLine( _
"No word ladders found for this word.")
Else
write_wordladders( _
strladder1, intladderloop1, intladderloop2)
End If
Console.WriteLine( _
"Began ladder construction at " & strstarttime)
Console.WriteLine(TimeOfDay & ": done")
strend = "?"
While strend <> "x"
Console.WriteLine("Enter x to terminate program.")
strend = LCase(Console.ReadLine())
End While
End Sub
Sub build_wordlist(ByRef strinputword, _
ByRef strwordlist, _
ByRef intwordlistloop, ByRef intloopnew)
Dim strword As String
Dim strflag As String
Dim objStreamReader As StreamReader
objStreamReader = _
New StreamReader("C:VB.WORD.MASTER")
intloopnew = 0
While 100 > 0
strword = objStreamReader.ReadLine
If strword <= "" Then
Exit While
End If
strword = LCase(strword)
If Len(strword) = Len(strinputword) Then
strwordlist(intloopnew) = strword
intloopnew += 1
If intloopnew > intwordlistloop Then
Console.WriteLine( _
"Increase strwordlist file " & _
Str(intloopnew) & Str(intwordlistloop))
Console.ReadLine()
Exit While
End If
End If
End While
objStreamReader.Close()
If intloopnew > intwordlistloop Then
Console.ReadLine()
End
End If
intwordlistloop = intloopnew
strflag = "n"
For index1 As Integer = 0 To intwordlistloop
If strinputword = strwordlist(index1) Then
strflag = "y"
Exit For
End If
Next
If strflag = "n" Then
Console.WriteLine( _
strinputword & " is not a valid word")
strinputword = " "
End If
End Sub
Sub gen_ladders(ByRef strladder1, ByRef strladder2, _
ByRef intladderloop1, ByRef intladderloop2, _
ByRef strinputword, _
ByRef strwordlist, ByRef intwordlistloop)
Dim intendloop1 As Integer
Dim intsub9 As Integer
For index1 As Integer = 0 To intladderloop1
strladder1(index1, 0) = strinputword
For index2 As Integer = 1 To intladderloop2
strladder1(index1, index2) = " "
Next
Next
seed_strladder1(strladder1, _
intladderloop1, intladderloop2, _
strwordlist, intwordlistloop, strinputword)
For intnextword As Integer = 2 To intladderloop2
For index1 As Integer = 0 To intladderloop1
For index2 As Integer = 0 To intladderloop2
strladder2(index1, index2) = " "
Next
Next
intendloop1 = -100
For index99 As Integer = intladderloop1 To 0 Step -1
If strladder1(index99, intnextword - 1) <> " " Then
intendloop1 = index99
Exit For
End If
Next
If intendloop1 < 0 Then
Exit Sub
End If
intsub9 = 0
For intladder As Integer = 0 To intendloop1
addaword(intladder, intnextword, _
strladder1, strladder2, _
intladderloop1, intladderloop2, _
strwordlist, intwordlistloop, _
intendloop1, intsub9)
Next
For index1 As Integer = 0 To intladderloop1
For index2 As Integer = 0 To intladderloop2
strladder1(index1, index2) = _
strladder2(index1, index2)
Next
Next
Next
End Sub
Sub seed_strladder1(ByRef strladder1, _
ByRef intladderloop1, ByRef intladderloop2, _
ByRef strwordlist, ByRef intwordlistloop, _
ByRef strinputword)
Dim strword As String
Dim strnewword As String
Dim strwork1(50) As String
Dim strwork2(50) As String
Dim intsub1 As Integer
Dim intcount1 As Integer
strinputword = LCase(strinputword)
intsub1 = 0
For index1 As Integer = 0 To 49
strwork1(index1) = " "
Next
intsub1 = 0
For index1 As Integer = 1 To Len(strinputword)
If Mid(strinputword, index1, 1) >= "a" And _
Mid(strinputword, index1, 1) <= "z" Then
strwork1(intsub1) = Mid(strinputword, index1, 1)
intsub1 += 1
End If
Next
For index1 As Integer = 0 To intwordlistloop
strword = LCase(strwordlist(index1))
For index10 As Integer = 0 To 49
strwork2(index10) = " "
Next
intsub1 = 0
For index2 As Integer = 1 To Len(strword)
If Mid(strword, index2, 1) >= "a" And _
Mid(strword, index2, 1) <= "z" Then
strwork2(intsub1) = Mid(strword, index2, 1)
intsub1 += 1
End If
Next
intcount1 = 0
For index2 As Integer = 0 To 49
If strwork1(index2) <> strwork2(index2) Then
intcount1 += 1
End If
Next
If intcount1 <> 1 Then
GoTo loopnext823
End If
If strladder1(intladderloop1, intladderloop2) <> " " Then
For index76 As Integer = 0 To 4
Console.WriteLine("strladdder1 has too few rows")
Next
Console.ReadLine()
End
End If
For index10 As Integer = 0 To intladderloop1
If strladder1(index10, 1) = " " Then
strladder1(index10, 1) = strword
GoTo loopnext823
End If
Next
loopnext823:
Next
End Sub
Sub addaword(ByRef intladder, ByRef intnextword, _
ByRef strladder1, ByRef strladder2, _
ByRef intladderloop1, ByRef intladderloop2, _
ByRef strwordlist, ByRef intwordlistloop, _
ByRef intendloop1, ByRef intsub9)
Dim strprevword As String
Dim strword As String
Dim strwork1(50) As String
Dim strwork2(50) As String
Dim intsub1 As Integer
Dim intcount1 As Integer
If strladder1(intladder, intnextword - 1) = " " Then
Exit Sub
End If
Console.WriteLine( _
Str(intladder) & _
" of " & Str(intendloop1) & ";" & _
Str(intnextword))
strprevword = LCase(strladder1(intladder, intnextword - 1))
intsub1 = 0
For index1 As Integer = 0 To 49
strwork1(index1) = " "
Next
intsub1 = 0
For index1 As Integer = 1 To Len(strprevword)
If Mid(strprevword, index1, 1) >= "a" And _
Mid(strprevword, index1, 1) <= "z" Then
strwork1(intsub1) = Mid(strprevword, index1, 1)
intsub1 += 1
End If
Next
For index1 As Integer = 0 To intwordlistloop
strword = LCase(strwordlist(index1))
For index10 As Integer = 0 To 49
strwork2(index10) = " "
Next
intsub1 = 0
For index2 As Integer = 1 To Len(strword)
If Mid(strword, index2, 1) >= "a" And _
Mid(strword, index2, 1) <= "z" Then
strwork2(intsub1) = Mid(strword, index2, 1)
intsub1 += 1
End If
Next
intcount1 = 0
For index2 As Integer = 0 To 49
If strwork1(index2) <> strwork2(index2) Then
intcount1 += 1
End If
Next
If intcount1 <> 1 Then
GoTo loopnext425
End If
For index2 As Integer = 0 To intnextword - 1
If strword = _
strladder1(intladder, index2) Then
GoTo loopnext425
End If
Next
strladder1(intladder, intnextword) = strword
If strladder2(intladderloop1, 0) <> " " Then
For indexerr As Integer = 0 To 4
Console.WriteLine( _
"ERROR: strladder1,strladder2 too small")
Next
Console.ReadLine()
End
End If
For index20 As Integer = 0 To intladderloop2
strladder2(intsub9, index20) = _
strladder1(intladder, index20)
Next
intsub9 += 1
strladder1(intladder, intnextword) = " "
GoTo loopnext425
loopnext425:
Next
End Sub
Sub write_wordladders( _
ByRef strladder1, ByRef intladderloop1, ByRef intladderloop2)
Dim objStreamWriter As StreamWriter
objStreamWriter = _
New StreamWriter("C:VB.WORDLADDERS")
Dim strstring As String
Dim intcount1 As Integer
Console.WriteLine( _
"Writing wordladders...")
intcount1 = 0
For index1 As Integer = 0 To intladderloop1
If strladder1(index1, intladderloop2) <> " " Then
intcount1 += 1
strstring = ""
For index2 As Integer = 0 To intladderloop2
If strladder1(index1, index2) <> " " Then
strstring &= strladder1(index1, index2)
strstring &= " "
End If
Next
objStreamWriter.WriteLine(strstring)
End If
Next
objStreamWriter.Close()
Console.WriteLine( _
"Done. " & Str(intcount1) & " records written.")
End Sub
End Module