Eight Words
After just 6 button presses return this grid to a position where four words can be read horizontally and four vertically.
Report your button presses and the 8 words found.
The "R" button resets the grid.
Either of: |
| While:
bhdgap |
hdgabp | hmfaab
will produce | will produce
SPAR | SPAR
TACO | TARO
ARID | ACID
BEDS | BEDS
The solutions with different results, by switching the locations of ARID and ACID, causes some words to have alternates: TACO-TARO and PARE-PACE, making 10 words in all.
Of course in the first sequence the A and P can be reversed, and in the other two sequences, the last three can be in any order (6 permutations of ABP, and 3 of AAB). That makes 11 possible sequences in all. ... or actually, the two A's can be replaced by two M's, so that's another three sequences bringing the total to 14, as even mbm is the same as aab, for example.
The program actually examined the results of 2,859,032 sequences of moves, rather than 16^6, as negating the previous move was disallowed as was moving the same up or left button twice in a row or the same right or down button more than twice in a row. Parallel moves done in succession had to be done in a certain sequence.
Dim bd(4, 4), mName, seq, hist(6), highRec, w2 As String * 4, solCt
Private Sub Form_Load()
Open "\words\words4.txt" For Random As #1 Len = 4
highRec = LOF(1) / 4
w2 = Space$(4)
Me.Visible = True
For r = 1 To 4
For c = 1 To 4
bd(r, c) = Choose(4 * (r - 1) + c, "t", "a", "a", "a", "o", "r", "c", "r", "b", "e", "i", "d", "s", "p", "d", "s")
Next
Next
mName = "abcdegikmnopfhjl" ' translation from numbered move to letter
seq = ""
mkMove 1
CurrentY = 6000: CurrentX = 1400
Print "done"
DoEvents
End Sub
Sub mkMove(mNo)
CurrentX = 1: CurrentY = 1: Print seq;
For m = 1 To 16
DoEvents
good = 1
ltr = Mid(mName, m, 1)
If mNo > 1 Then
If m > 8 Then
If ltr = Right(seq, 1) Then good = 0
' same leftward or upward allowed only once in row
End If
If Abs(m - hist(mNo - 1)) = 8 Then good = 0
' undoing previous move not allowed
Select Case m
Case 1 To 4, 9 To 12
If hist(mNo - 1) <= 4 Or hist(mNo - 1) >= 9 And hist(mNo - 1) <= 12 Then
If m < hist(mNo - 1) Then good = 0
' cluster of vertical moves must be done in sorted order
End If
Case 5 To 8, 13 To 16
If hist(mNo - 1) >= 5 And hist(mNo - 1) <= 8 Or hist(mNo - 1) >= 13 Then
If m < hist(mNo - 1) Then good = 0
' cluster of horizonal moves must be done in sorted order
End If
End Select
End If
If mNo > 2 Then If ltr & ltr = Right(seq, 2) Then good = 0
' no three of same move in row, even if rightward or downward
If good Then
seq = seq & ltr
hist(mNo) = m
Select Case m
Case 1 To 4
col = m
h = bd(4, col)
For row = 4 To 2 Step -1
bd(row, col) = bd(row - 1, col)
Next
bd(1, col) = h
Case 5 To 8
row = m - 4
h = bd(row, 4)
For col = 4 To 2 Step -1
bd(row, col) = bd(row, col - 1)
Next
bd(row, 1) = h
Case 9 To 12
col = m - 8
h = bd(1, col)
For row = 1 To 3
bd(row, col) = bd(row + 1, col)
Next
bd(4, col) = h
Case 13 To 16
row = m - 12
h = bd(row, 1)
For col = 1 To 3
bd(row, col) = bd(row, col + 1)
Next
bd(row, 4) = h
End Select
If mNo = 6 Then
wr1 = bd(1, 1) + bd(1, 2) + bd(1, 3) + bd(1, 4)
If isWord(wr1) Then
wr2 = bd(2, 1) + bd(2, 2) + bd(2, 3) + bd(2, 4)
If isWord(wr2) Then
wr3 = bd(3, 1) + bd(3, 2) + bd(3, 3) + bd(3, 4)
If isWord(wr3) Then
wr4 = bd(4, 1) + bd(4, 2) + bd(4, 3) + bd(4, 4)
If isWord(wr4) Then
wc1 = bd(1, 1) + bd(2, 1) + bd(3, 1) + bd(4, 1)
If isWord(wc1) Then
wc2 = bd(1, 2) + bd(2, 2) + bd(3, 2) + bd(4, 2)
If isWord(wc2) Then
wc3 = bd(1, 3) + bd(2, 3) + bd(3, 3) + bd(4, 3)
If isWord(wc3) Then
wc4 = bd(1, 4) + bd(2, 4) + bd(3, 4) + bd(4, 4)
If isWord(wc4) Then
CurrentX = 1: CurrentY = 200 + 900 * solCt:
Print wr1; " "
Print wr2; " "
Print wr3; " "
Print wr4; " "; seq
solCt = solCt + 1
End If
End If
End If
End If
End If
End If
End If
End If
Else
mkMove mNo + 1
End If
' undo the move before exiting recursion level
m2 = m + 8: If m2 > 16 Then m2 = m2 - 16
Select Case m2
Case 1 To 4
col = m2
h = bd(4, col)
For row = 4 To 2 Step -1
bd(row, col) = bd(row - 1, col)
Next
bd(1, col) = h
Case 5 To 8
row = m2 - 4
h = bd(row, 4)
For col = 4 To 2 Step -1
bd(row, col) = bd(row, col - 1)
Next
bd(row, 1) = h
Case 9 To 12
col = m2 - 8
h = bd(1, col)
For row = 1 To 3
bd(row, col) = bd(row + 1, col)
Next
bd(4, col) = h
Case 13 To 16
row = m2 - 12
h = bd(row, 1)
For col = 1 To 3
bd(row, col) = bd(row, col + 1)
Next
bd(row, 4) = h
End Select
seq = Left(seq, Len(seq) - 1)
End If
Next m
End Sub
Function isWord(w)
low = 1: high = highRec
Do
mddl = Int((low + high) / 2)
Get #1, mddl, w2
If w2 > w Then high = mddl - 1
If w2 < w Then low = mddl + 1
If w2 = w Then Exit Do
Loop Until low > high
If w = w2 Then isWord = True Else isWord = False
End Function
|
Posted by Charlie
on 2009-03-19 17:43:13 |