The names of 100 prisoners are placed in 100 wooden boxes, one name to a box, and the boxes are
lined up on a table in a room. One by one, the prisoners are led into the room; each may look
in at most 50 boxes, but must leave the room exactly as he found it and is permitted no further
communication with the others.
The prisoners have a chance to plot their strategy in advance, and they are going to need it,
because unless every single prisoner finds his own name all will subsequently be executed.
Find a strategy for them which has probability of success exceeding 30%.
Comment: If each prisoner examines a random set of 50 boxes, their probability of survival
is an unenviable 1/2^{100} ∼ 0.0000000000000000000000000000008. They could do worse—if they all
look in the same 50 boxes, their chances drop to zero. 30% seems ridiculously out of reach—but
yes, you heard the problem correctly!
(In reply to
re(2): Loops by Jer)
After thinking about it I did see that the box pointed to as well as the original box and the box that points to that (and therefore contains the prisoner's number) all belong to that cycle.
Out of 100,000 trials, the below program found 31,339 successes. This version, because of the line highlighted here:
If looked(ptr) = 0 Then
looked(ptr) = 1
Else
Exit For
For i = 1 To 100
If looked(i) = 0 Then
ptr = i: Exit For
End If
Next
End If
does not continue beyond a given cycle even if it's shorter than 50.
If that line is commented out, the program restarts outside the cycle already tried. Of course this time part of its 50 has been used up, and it uses only what remains of the 50. The program that always goes the full 50 unless it finds the correct number first finds only 31,317 successes. It looks like looking beyond the initial cycle has no significant benefit.
DefDbl AZ
Dim crlf$, box(), looked()
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
crlf = Chr$(13) + Chr$(10)
maxtrials = 100000
Randomize Timer
For trial = 1 To maxtrials
ReDim box(100)
For i = 1 To 100
found = 0
Do
r = Int(Rnd(1) * 100 + 1)
If box(r) = 0 Then
box(r) = i
found = 1
End If
Loop Until found
Next
' For i = 1 To 100
' Text1.Text = Text1.Text & Str(box(i))
' Next
' Text1.Text = Text1.Text & crlf
good = 1
For prisoner = 1 To 100
DoEvents
found = 0
ReDim looked(100)
ptr = prisoner
For looking = 1 To 50
DoEvents
v = box(ptr)
If v = prisoner Then
found = 1: Exit For
End If
ptr = v
If looked(ptr) = 0 Then
looked(ptr) = 1
Else
Exit For
For i = 1 To 100
If looked(i) = 0 Then
ptr = i: Exit For
End If
Next
End If
Next
If found = 0 Then
' Text1.Text = Text1.Text & "Failed for prisoner " & prisoner & crlf
Exit For
End If
Next
If found Then
' Text1.Text = Text1.Text & "Succeeded" & crlf
success = success + 1
End If
Next trial
Text1.Text = Text1.Text & crlf & success & " done"
End Sub

Posted by Charlie
on 20170412 14:41:51 