100 prisoners' problem

[SMcNeill]

Sequential checking of boxes until the proper number is found:

Code: (Select All)

Dim Shared As Integer Boxes(1 To 100), PC(1 To 100)
Dim Shared As Integer Win, Lose, Games
Games = 1000
For i = 1 To Games
    SetChances
    ShuffleCards
    Box = 1
    For Turns = 1 To 50
        For Prisoner = 1 To 100
            CheckBox Prisoner, Box
        Next
    Next
    GameResult
Next
PrintResult








Sub ShuffleCards
    Randomize Timer
    For i = 1 To 100: Boxes(i) = i: Next
    For i = 1 To 100: Swap Boxes(i), Boxes(Int(Rnd * 100) + 1): Next
End Sub

Sub SetChances
    For i = 1 To 100: PC(i) = 0: Next 'reset each prisoner to not having a card
End Sub

Sub CheckBox (Prisoner, Box)
    If PC(Prisoner) = -1 Then Exit Sub 'prisoner has found his number
    If Prisoner = Boxes(Box) Then
        PC(Prisoner) = -1 '-1 indicated he found his box
        Box = Box + 1 'prisoners now move on to the next box
    End If
End Sub

Sub GameResult '-1 for loss, +1 for win
    For i = 1 To 100
        If PC(i) <> -1 Then Lose = Lose + 1: Exit Sub
    Next
    Win = Win + 1
End Sub

Sub PrintResult
    Print "Of"; Games; "there were"; Win; "which were won, and"; Lose; "which were lost."
    Print Using "Win Ratio: ###.###"; Win / Games
    Print Using "Lose Ratio: ###.###"; Lose / Games
End Sub

   


Strategy here is as I described above:  Each prisoner just starts checking at the first box, until his number comes up, then the prisoners move on to checking the next box.  This assumes that they only open 1 box per trip inside, and that they don't have to check all 50 boxes in a single trip.  They go in, check, walk out. Others take a turn, then they walk back in and check once again for their number.

50ish percent chance for a full pardon seems to me to be much better than just an impossible task.