

The Problem

 100 prisoners are individually numbered 1 to 100
 A room having a cupboard of 100 opaque drawers numbered 1 to 100, that cannot be seen from outside.
 Cards numbered 1 to 100 are placed randomly, one to a drawer, and the drawers all closed; at the start.
 Prisoners start outside the room
 They can decide some strategy before any enter the room.
 Prisoners enter the room one by one, can open a drawer, inspect the card number in the drawer, then close the drawer.
 A prisoner can open no more than 50 drawers.
 A prisoner tries to find his own number.
 A prisoner finding his own number is then held apart from the others.
 If all 100 prisoners find their own numbers then they will all be pardoned. If any don't then all sentences stand. 


The task

 Simulate several thousand instances of the game where the prisoners randomly open drawers
 Simulate several thousand instances of the game where the prisoners use the optimal strategy mentioned in the Wikipedia article, of:
 First opening the drawer whose outside number is his prisoner number.
 If the card within has his number then he succeeds otherwise he opens the drawer with the same number as that of the revealed card. (until he opens his maximum).


Show and compare the computed probabilities of success for the two strategies, here, on this page.




References

 The unbelievable solution to the 100 prisoner puzzle standupmaths (Video).
 wp:100 prisoners problem
 100 Prisoners Escape Puzzle DataGenetics.
 Random permutation statistics#One hundred prisoners on Wikipedia.


' Gambas module file
 
Public DrawerArray As Long[]
Public NumberFromDrawer As Long
Public FoundOwnNumber As Long
 
Public Sub Main()
 
  Dim NumberOfPrisoners As Long
  Dim Selections As Long
  Dim Tries As Long
 
  Print "Number of prisoners (default, 100)?"
  Try Input NumberOfPrisoners
  If Error Then NumberOfPrisoners = 100
 
  Print "Number of selections (default, half of prisoners)?" 
  Try Input Selections
  If Error Then Selections = NumberOfPrisoners / 2
 
  Print "Number of tries (default, 1000)?"
  Try Input Tries
  If Error Then Tries = 1000
 
  Dim AllFoundOptimal As Long = 0
  Dim AllFoundRandom As Long = 0
  Dim AllFoundRandomMem As Long = 0
 
  Dim i As Long
  Dim OptimalCount As Long
  Dim RandomCount As Long
  Dim RandomMenCount As Long
 
  Dim fStart As Float = Timer
 
  For i = 1 To Tries
    OptimalCount = HundredPrisoners_Optimal(NumberOfPrisoners, Selections)
    RandomCount = HundredPrisoners_Random(NumberOfPrisoners, Selections)
    RandomMenCount = HundredPrisoners_Random_Mem(NumberOfPrisoners, Selections)
 
    If OptimalCount = NumberOfPrisoners Then AllFoundOptimal += 1
    If RandomCount = NumberOfPrisoners Then AllFoundRandom += 1
    If RandomMenCount = NumberOfPrisoners Then AllFoundRandomMem += 1
  Next
 
  Dim fTime As Float = Timer - fStart
  fTime = Round(ftime, -1)
 
  Print
  Print "Result with " & NumberOfPrisoners & " prisoners, " & Selections & " selections and " & Tries & " tries. "
  Print
  Print "Optimal: " & AllFoundOptimal & " of " & Tries & ": " & Str(AllFoundOptimal / Tries * 100) & " %"
  Print "Random: " & AllFoundRandom & " of " & Tries & ": " & Str(AllFoundRandom / Tries * 100) & " %"
  Print "RandomMem: " & AllFoundRandomMem & " of " & Tries & ": " & Str(AllFoundRandomMem / Tries * 100) & " %"
  Print
  Print "Elapsed Time: " & fTime & " sec"
  Print
  Print "Trials/sec: " & Round(Tries / fTime, -1)
 
End
 
Function HundredPrisoners_Optimal(NrPrisoners As Long, NrSelections As Long) As Long
 
  DrawerArray = New Long[NrPrisoners]
  Dim Counter As Long
 
  For Counter = 0 To DrawerArray.Max
    DrawerArray[Counter] = Counter + 1
  Next
 
  DrawerArray.Shuffle()
 
  Dim i As Long
  Dim j As Long
  FoundOwnNumber = 0
 
  For i = 1 To NrPrisoners
    For j = 1 To NrSelections
      If j = 1 Then NumberFromDrawer = DrawerArray[i - 1]
 
      If NumberFromDrawer = i Then
        FoundOwnNumber += 1
        Break
      Endif
      NumberFromDrawer = DrawerArray[NumberFromDrawer - 1]
    Next
  Next
  Return FoundOwnNumber
 
End
 
Function HundredPrisoners_Random(NrPrisoners As Long, NrSelections As Long) As Long
 
  Dim RandomDrawer As Long
  Dim Counter As Long
 
  DrawerArray = New Long[NrPrisoners]
 
  For Counter = 0 To DrawerArray.Max
    DrawerArray[Counter] = Counter + 1
  Next
 
  DrawerArray.Shuffle()
 
  Dim i As Long
  Dim j As Long
  FoundOwnNumber = 0
 
  Randomize
 
  For i = 1 To NrPrisoners
    For j = 1 To NrSelections
      RandomDrawer = CLong(Rand(NrPrisoners - 1))
      NumberFromDrawer = DrawerArray[RandomDrawer]
      If NumberFromDrawer = i Then
        FoundOwnNumber += 1
        Break
      Endif
    Next
  Next
  Return FoundOwnNumber
 
End
 
Function HundredPrisoners_Random_Mem(NrPrisoners As Long, NrSelections As Long) As Long
 
  Dim SelectionArray As New Long[NrPrisoners]
  Dim Counter As Long
 
  DrawerArray = New Long[NrPrisoners]
 
  For Counter = 0 To DrawerArray.Max
    DrawerArray[Counter] = Counter + 1
 
  Next
 
  For Counter = 0 To SelectionArray.Max
    SelectionArray[Counter] = Counter + 1
 
  Next
 
  DrawerArray.Shuffle()
 
  Dim i As Long
  Dim j As Long
  FoundOwnNumber = 0
 
  For i = 1 To NrPrisoners
    SelectionArray.Shuffle()
    For j = 1 To NrSelections
      NumberFromDrawer = DrawerArray[SelectionArray[j - 1] - 1]
      If NumberFromDrawer = i Then
        FoundOwnNumber += 1
        Break
      Endif
      NumberFromDrawer = DrawerArray[NumberFromDrawer - 1]
    Next
  Next
  Return FoundOwnNumber
 
End