A sequence of letters is considered "valid" if it occurs as a substring of a common English word. For example, "RGRO" is valid because it occurs in the word "undeRGROund."
Find a sequence of four distinct letters such that all 23 non-identity permutations of the sequence are valid.
Everyone seems to have the same set of letters. I used a quickie program to identify all the candidate substrings, then the program below to identify the words.
My sequence of letters is IART
iatr = diatribe
irat = admiration
irta = flirtation
itar = humanitarian
itra = arbitrage
airt = airtime
aitr = waitress
arit = angularity
arti = article
atir = satire
atri = patriarch
riat = appropriate
rita = authoritarian
rait = portrait
rati = ratio
rtia = impartial
rtai = certain
tiar = penitentiary
tira = multiracial
tair = stairs
tari = militarism
tria = equestrian
trai = constrain
The VB program is:
Imports System
Imports System.IO
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.Math
Module Module1
Sub Main()
Randomize()
Dim intsize1 As Integer
Dim intloop1 As Integer
Dim strwordlist(0) As String
size_strwordlist(intsize1)
ReDim strwordlist(intsize1)
load_strwordlist(strwordlist, intloop1)
While 100 > 0
justdoit(strwordlist, intloop1)
End While
End Sub
Sub justdoit(ByRef strwordlist, ByRef intloop1)
Dim strsubstring(4) As String
Dim strstring As String
Dim strflag As String
loopgetstring:
strstring = ""
Console.WriteLine(" ")
Console.WriteLine("Enter substring - or just hit enter for " & _
"random string.")
strstring = LCase(Console.ReadLine())
If Len(strstring) <> 4 Then
If strstring > " " Then
GoTo loopgetstring
End If
End If
If strstring <= " " Then
random_substring(strsubstring)
Else
parse_substring(strstring, strsubstring)
For index1 As Integer = 0 To 2
For index2 As Integer = index1 + 1 To 3
If strsubstring(index1) = strsubstring(index2) Then
GoTo loopgetstring
End If
Next
Next
End If
Console.WriteLine(" ")
strstring = ""
For index1 As Integer = 0 To 3
strstring &= strsubstring(index1)
Next
Console.WriteLine( _
"substring = " & strstring)
Console.WriteLine("Press ENTER to begin search")
Console.ReadLine()
Console.WriteLine(" ")
check_strsubstring(strsubstring, strflag, _
strwordlist, intloop1)
If strflag = "n" Then
Console.WriteLine(" ")
Console.WriteLine("Not a good substring.")
Else
Exit Sub
End If
End Sub
Sub random_substring(ByRef strsubstring)
Dim intsubstring(4) As Integer
For index1 As Integer = 0 To 3
randomloop:
intsubstring(index1) = Int((26 - 1 + 1) * Rnd()) + 1
If index1 > 0 Then
For index2 As Integer = 0 To index1 - 1
If intsubstring(index1) = intsubstring(index2) Then
GoTo randomloop
End If
Next
End If
Next
For index1 As Integer = 0 To 3
Select Case intsubstring(index1)
Case 1
strsubstring(index1) = "a"
Case 2
strsubstring(index1) = "b"
Case 3
strsubstring(index1) = "c"
Case 4
strsubstring(index1) = "d"
Case 5
strsubstring(index1) = "e"
Case 6
strsubstring(index1) = "f"
Case 7
strsubstring(index1) = "g"
Case 8
strsubstring(index1) = "h"
Case 9
strsubstring(index1) = "i"
Case 10
strsubstring(index1) = "j"
Case 11
strsubstring(index1) = "k"
Case 12
strsubstring(index1) = "l"
Case 13
strsubstring(index1) = "m"
Case 14
strsubstring(index1) = "n"
Case 15
strsubstring(index1) = "o"
Case 16
strsubstring(index1) = "p"
Case 17
strsubstring(index1) = "q"
Case 18
strsubstring(index1) = "r"
Case 19
strsubstring(index1) = "s"
Case 20
strsubstring(index1) = "t"
Case 21
strsubstring(index1) = "u"
Case 22
strsubstring(index1) = "v"
Case 23
strsubstring(index1) = "w"
Case 24
strsubstring(index1) = "x"
Case 25
strsubstring(index1) = "y"
Case 26
strsubstring(index1) = "z"
End Select
Next
End Sub
Sub parse_substring(ByRef strstring, ByRef strsubstring)
For index1 As Integer = 1 To Len(strstring)
strsubstring(index1 - 1) = Mid(strstring, index1, 1)
Next
End Sub
Sub check_strsubstring(ByRef strsubstring, ByRef strflag, _
ByRef strwordlist, ByRef intloop1)
Dim strsearch As String
Dim intcount As Integer
Dim strnext As String
strflag = "y"
For index1 As Integer = 0 To 3
For index2 As Integer = 0 To 3
If index2 <> index1 Then
For index3 As Integer = 0 To 3
If index3 <> index1 And _
index3 <> index2 Then
For index4 As Integer = 0 To 3
If index4 <> index1 And _
index4 <> index2 And _
index4 <> index3 Then
If Not ( _
index1 = 0 And index2 = 1 And _
index3 = 2 And index4 = 3) Then
intcount = 0
strsearch = "*" _
& strsubstring(index1) _
& strsubstring(index2) _
& strsubstring(index3) _
& strsubstring(index4) _
& "*"
display_words(strsearch, _
strwordlist, intloop1, _
intcount, _
strnext)
If intcount = 0 Then
strflag = "n"
Exit Sub
End If
If strnext = "s" Then
Exit Sub
End If
End If
End If
Next
End If
Next
End If
Next
Next
End Sub
Sub display_words(ByRef strsearch, _
ByRef strwordlist, ByRef intloop1, _
ByRef intcount, ByRef strnext)
intcount = 0
Console.WriteLine(" ")
Console.WriteLine(strsearch)
Console.ReadLine()
For index1 As Integer = 0 To intloop1
If strwordlist(index1) Like strsearch Then
Console.WriteLine(strwordlist(index1))
intcount += 1
If (intcount Mod 20) = 0 Then
strnext = " "
Console.WriteLine("Next ? (p = permutation, s = substring)")
strnext = LCase(Console.ReadLine())
If strnext = "p" Or strnext = "s" Then
Exit Sub
End If
End If
End If
Next
If intcount = 0 Then
Exit Sub
End If
strnext = " "
Console.WriteLine("Next ? (p = permutation, s = substring)")
strnext = LCase(Console.ReadLine())
If strnext = "p" Or strnext = "s" Then
Exit Sub
End If
End Sub
Sub size_strwordlist(ByRef intsize1)
Dim strstring As String
Dim objStreamReader As StreamReader
objStreamReader = _
New StreamReader("C:\VB.WORD.MASTER")
intsize1 = 0
While 100 > 0
strstring = LCase(objStreamReader.ReadLine)
If strstring <= " " Then
Exit While
End If
intsize1 += 1
End While
objStreamReader.Close()
End Sub
Sub load_strwordlist(ByRef strwordlist, ByRef intloop1)
Dim strstring As String
Dim objStreamReader As StreamReader
objStreamReader = _
New StreamReader("C:\VB.WORD.MASTER")
intloop1 = -1
While 100 > 0
strstring = LCase(objStreamReader.ReadLine)
If strstring <= " " Then
Exit While
End If
intloop1 += 1
strwordlist(intloop1) = strstring
End While
objStreamReader.Close()
End Sub
End Module
|
Posted by Penny
on 2005-01-13 05:50:58 |