I was suspicious of the fact that my program got only to level 3, row 1, column 2. There was a bug in the code. The answer is still the same, but this time got to
Meaning after both shuffles it got to row 3 column 2 of the third layout before being unable to find a fit that didn't cause a duplicate handshake.
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 = 312 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
' End If
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 And grid(lvl, r, c) > 0 Then
good = 0: Exit For
End If
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
re: computer solution
