Showing that a repeated handshake is unavoidable and therefore that some handshake (or more) is left out:
DefDbl A-Z
Dim crlf$, grid(3, 3, 3), shakes(9, 9), had$, mx
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
crlf = Chr$(13) + Chr$(10)
For row = 1 To 3
For col = 1 To 3
troll = troll + 1
grid(1, row, col) = troll
Next
Next
For row = 1 To 3
For col = 1 To 3
For dr = -1 To 1
For dc = -1 To 1
If dr * dc = 0 And dr + dc <> 0 Then
r = row + dr: c = col + dc
If r > 0 And r < 4 And c > 0 And c < 4 Then
shakes(grid(1, r, c), grid(1, row, col)) = 1
shakes(grid(1, row, col), grid(1, r, c)) = 1
End If
End If
Next
Next
Next
Next
addOn 2, 1, 1
Text1.Text = Text1.Text & crlf & mx & " done"
End Sub
Sub addOn(lvl, row, col)
tr = 100 * lvl + 10 * row + col
If tr > mx Then mx = tr
DoEvents
If row = 1 And col = 1 Then had$ = ""
For newtroll = 1 To 9
t$ = LTrim(Str(newtroll))
If InStr(had, t) = 0 Then
grid(lvl, row, col) = newtroll
good = 1
For dr = -1 To 1
For dc = -1 To 1
If dr * dc = 0 And dr + dc <> 0 Then
r = row + dr: c = col + dc
If r > 0 And r < 4 And c > 0 And c < 4 Then
If shakes(grid(lvl, row, col), grid(lvl, r, c)) > 0 Then good = 0: Exit For
End If
End If
Next
Next
If good Then
For dr = -1 To 1
For dc = -1 To 1
If dr * dc = 0 And dr + dc <> 0 Then
r = row + dr: c = col + dc
If r > 0 And r < 4 And c > 0 And c < 4 Then
shakes(grid(lvl, r, c), grid(lvl, row, col)) = 1
shakes(grid(lvl, row, col), grid(lvl, r, c)) = 1
End If
End If
Next
Next
c = col + 1: r = row: l = lvl
If c > 3 Then
c = 1: r = r + 1
If r > 3 Then
l = l + 1: r = 1
End If
End If
If l = 4 Then
Text1.Text = Text1.Text & " found " & crlf
For l2 = 1 To 3
For r2 = 1 To 3
For c2 = 1 To 3
Text1.Text = Text1.Text & grid(l2, r2, c2)
Next
Text1.Text = Text1.Text & crlf
Next
Text1.Text = Text1.Text & crlf
Next
Text1.Text = Text1.Text & crlf
Else
savehad$ = had
had = had + t
addOn l, r, c
had = savehad
End If
For dr = -1 To 1
For dc = -1 To 1
If dr * dc = 0 And dr + dc <> 0 Then
r = row + dr: c = col + dc
If r > 0 And r < 4 And c > 0 And c < 4 Then
shakes(grid(lvl, r, c), grid(lvl, row, col)) = 0
shakes(grid(lvl, row, col), grid(lvl, r, c)) = 0
End If
End If
Next
Next
End If
grid(lvl, row, col) = 0
End If
Next newtroll
End Sub
reports:
312 done
meaning that it got up to trying to fill the second column on the first row after the second shuffle (thus the 3rd layout), but couldn't get any further without a repeated handshake.
computer solution
