 All about flooble | fun stuff | Get a free chatterbox | Free JavaScript | Avatars  perplexus dot info  Nine trolls (Posted on 2015-07-23) Nine trolls are placed in the cells of a three-by-three square.
The trolls in neighboring cells shake hands with each other.
Later they re-arrange themselves in the square and the neighbors greet each other once more.
Then they repeat it again for the 3rd time.

Prove (or provide a counterexample) that there is at least one pair of trolls who didn’t greet each other.

Based on a problem in Russian "Kvantik",2012 Comments: ( Back to comment list | You must be logged in to post comments.) re: computer solution | Comment 7 of 9 | (In reply to computer solution by Charlie)

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

332 done

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.

Debug code is shown commented out in the listing:

DefDbl A-Z
Dim crlf\$, grid(3, 3, 3), shakes(9, 9), had\$, mx

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

Text1.Text = Text1.Text & crlf & mx & " done"

End Sub

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
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

 Posted by Charlie on 2015-07-23 12:15:34 Please log in:

 Search: Search body:
Forums (2)