The version of the program for 7-letter words is shown as it is the more complicated, allowing for one of the hat words not to be used, by allowing the selection point for one of the items to be beyond the end of the source word:
DefDbl A-Z
Dim crlf$, src(8) As String, foundWord$
Function mform$(x, t$)
a$ = Format$(x, t$)
If Len(a$) < Len(t$) Then a$ = Space$(Len(t$) - Len(a$)) & a$
mform$ = a$
End Function
Private Sub Form_Load()
ChDir "C:Program Files (x86)DevStudioVBprojects looble"
Open "madhatter7new.txt" For Output As #2
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
DoEvents
src(1) = "bert"
src(2) = "derby"
src(3) = "fedora"
src(4) = "fez"
src(5) = "pileus"
src(6) = "pilbox"
src(7) = "tembl"
src(8) = "yarmulke"
alw1 = 1
For a = 1 To Len(src(1)) + 1
If a > Len(src(1)) Then alw1 = 0
For b = 1 To Len(src(2)) + alw1
If b > Len(src(2)) Then alw1 = 0
For c = 1 To Len(src(3)) + alw1
If c > Len(src(3)) Then alw1 = 0
Text1.Text = Text1.Text & Str(a) & Str(b) & Str(c) & " "
DoEvents
For d = 1 To Len(src(4)) + alw1
If d > Len(src(4)) Then alw1 = 0
For e = 1 To Len(src(5)) + alw1
If e > Len(src(5)) Then alw1 = 0
For f = 1 To Len(src(6)) + alw1
If f > Len(src(6)) Then alw1 = 0
For g = 1 To Len(src(7)) + alw1
If g > Len(src(7)) Then alw1 = 0
For h = 1 To Len(src(8)) + alw1
DoEvents
If h > Len(src(8)) Then alw1 = 0
anag$ = Mid(src(1), a, 1) + Mid(src(2), b, 1) + Mid(src(3), c, 1) + Mid(src(4), d, 1) + Mid(src(5), e, 1) + Mid(src(6), f, 1) + Mid(src(7), g, 1) + Mid(src(8), h, 1)
seq$ = ""
If a <= Len(src(1)) Then seq$ = seq$ + "1"
If b <= Len(src(2)) Then seq$ = seq$ + "2"
If c <= Len(src(3)) Then seq$ = seq$ + "3"
If d <= Len(src(4)) Then seq$ = seq$ + "4"
If e <= Len(src(5)) Then seq$ = seq$ + "5"
If f <= Len(src(6)) Then seq$ = seq$ + "6"
If g <= Len(src(7)) Then seq$ = seq$ + "7"
If h <= Len(src(8)) Then seq$ = seq$ + "8"
If Len(anag$) = 7 Then
Do
done = 1
For i = 1 To 6
If Mid(anag$, i, 1) > Mid(anag$, i + 1, 1) Then
hold$ = Mid(anag$, i + 1, 1)
Mid(anag$, i + 1, 1) = Mid(anag$, i, 1)
Mid(anag$, i, 1) = hold$
hold$ = Mid(seq$, i + 1, 1)
Mid(seq$, i + 1, 1) = Mid(seq$, i, 1)
Mid(seq$, i, 1) = hold$
done = 0
End If
Next
Loop Until done
If isMatch(anag$) Then
ReDim used(8)
bldseq$ = ""
For i = 1 To Len(foundWord$)
lt$ = Mid(foundWord$, i, 1)
strt = 1
Do
ix = InStr(strt, anag$, lt$)
cube = Val(Mid(seq$, ix, 1))
If used(cube) Then strt = ix + 1: ix = 0
used(cube) = 1
Loop While ix = 0
bldseq$ = bldseq$ + LTrim(Str(cube))
Next
Print #2, foundWord$ & " " & bldseq$
DoEvents
End If
If h > Len(src(8)) Then alw1 = 1
End If
Next
If g > Len(src(7)) Then alw1 = 1
Next
If f > Len(src(6)) Then alw1 = 1
Next
If e > Len(src(5)) Then alw1 = 1
Next
If d > Len(src(4)) Then alw1 = 1
Next
If c > Len(src(3)) Then alw1 = 1
Next
If b > Len(src(2)) Then alw1 = 1
Next
If a > Len(src(1)) Then alw1 = 1
Next
Close 2
Text1.Text = Text1.Text & "done part 1" + crlf
Shell "sort < madhatter7new.txt > madhatter7news.txt"
t = Timer + 20
While Timer < t: Wend
Open "madhatter7news.txt" For Input As #1
Open "mad hatter 7.txt" For Output As #2
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
DoEvents
Do
Line Input #1, l$
p$ = w$
w$ = Left$(l$, 7)
If w$ = p$ Then
Print #2, " "; Right(l$, 7);
Else
Print #2,
Print #2, w$; " "; Right(l$, 7);
End If
Loop Until EOF(1)
Close
End Sub
Function isMatch(anag$)
Open "wordsanadct7.txt" For Binary As #10
l$ = Space$(15)
high = LOF(10) / 15
low = 1
Do
md = Int((high + low) / 2)
Get #10, (md - 1) * 15 + 1, l$
ana$ = Left(l$, 7): wd$ = Right(l$, 7)
If ana$ = anag$ Then Exit Do
If ana$ < anag$ Then low = md + 1
If ana$ > anag$ Then high = md - 1
Loop Until high < low
If ana$ = anag$ Then foundWord$ = wd$: isMatch = 1 Else isMatch = 0
Close 10
End Function
The shell function did not actually work, presumably because the directory change didn't affect the contents of the shelled Command Prompt action. So the sort was done manually when the next Open failed to find its input, and then the program was continued.
The output was further filtered by throwing out words that couldn't be found in a smaller word list than was used for the anagram dictionary files.
I don't know how much of the output will fit in one post, so the 7-letter words will appear in the next post, and the 8-letter words will follow.
BTW while ZEALOTS and YARMULKE do not appear in the condensed (filtered) output, they were in the original files.
Yarmulke had only one way: the way shown, but zealots had several:
4138675 4186375 4237615 4238615 4238675 4286315 4286375 4287315 4287615 4387615 4738615 4786315 4837615
Edited on June 9, 2014, 10:16 pm
|
|
Posted by Charlie
on 2014-06-09 22:02:42 |
computer program
