100 prisoners' problem

[TempodiBasic]

Hi
here a mathematical issue showed by a problem.

I have taken from Rosetta Code the issue and the solutions posted in different program language.
There is also a solution posted using QB64. Here the link QB64 100 prisoners

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

1. Simulate several thousand instances of the game where the prisoners randomly open drawers
   
2. 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.

The solution posted on that site has for founding the mathematical CHAIN knowledge, if i can use no professional words  in a group of randomly creating set of values (index/key  and its internal value) linked using the internal value to call the next item of the set, it happens that chains (subgroup of the original set) born naturally.

The code from Rosetta Code in QB64

Code: (Select All)

Const Found = -1, Searching = 0, Status = 1, Tries = 2
Const Attempt = 1, Victories = 2, RandomW = 1, ChainW = 2
Randomize Timer

Dim Shared Prisoners(1 To 100, Status To Tries) As Integer, Drawers(1 To 100) As Integer, Results(1 To 2, 1 To 2) As Integer
Print "100 prisoners"
Print "Random way to search..."
For a = 1 To 10000
    Init
    Results(RandomW, Attempt) = Results(RandomW, Attempt) + 1
    RandomWay
    If verify% Then Results(RandomW, Victories) = Results(RandomW, Victories) + 1
Next

Print: Print "Chain way to search..."
For a = 1 To 10000
    Init
    Results(ChainW, Attempt) = Results(ChainW, Attempt) + 1
    ChainWay
    If verify% Then Results(ChainW, Victories) = Results(ChainW, Victories) + 1
Next
Print: Print "RandomWay Results: "
Print " Attempts "; Results(RandomW, Attempt); " "; "Victories "; Results(RandomW, Victories); " Ratio:"; Results(RandomW, Victories); "/"; Results(RandomW, Attempt)
Print: Print "ChainWay Results:"
Print " Attempts "; Results(ChainW, Attempt); " "; "Victories "; Results(ChainW, Victories); " Ratio:"; Results(ChainW, Victories); "/"; Results(ChainW, Attempt)
End

Function verify%
    Dim In As Integer
    Print "veryfing "
    verify = 0
    For In = 1 To 100
        If Prisoners(In, Status) = Searching Then Exit For
    Next
    If In = 101 Then verify% = Found
End Function

Sub ChainWay
    Dim In As Integer, ChainChoice As Integer
    Print "Chain search"
    For In = 1 To 100
        ChainChoice = In
        Do
            Prisoners(In, Tries) = Prisoners(In, Tries) + 1
            If Drawers(ChainChoice) = In Then Prisoners(In, Status) = Found: Exit Do
            ChainChoice = Drawers(ChainChoice)
        Loop Until Prisoners(In, Tries) = 50
    Next In
End Sub

Sub RandomWay
    Dim In As Integer, RndChoice As Integer
    Print "Random search"
    For In = 1 To 100
        Do
            Prisoners(In, Tries) = Prisoners(In, Tries) + 1
            If Drawers(Int(Rnd * 100) + 1) = In Then Prisoners(In, Status) = Found: Exit Do
        Loop Until Prisoners(In, Tries) = 50
    Next
    Print "Executed "
End Sub


Sub Init
    Dim I As Integer, I2 As Integer
    Print "initialization"
    For I = 1 To 100
        Prisoners(I, Status) = Searching
        Prisoners(I, Tries) = Searching
        Do
            Drawers(I) = Int(Rnd * 100) + 1
            For I2 = 1 To I
                If Drawers(I2) = Drawers(I) Then Exit For
            Next
            If I2 = I Then Exit Do
        Loop
    Next I
    Print "Done "
End Sub

and its output



Bplus code

Code: (Select All)

_Title "100 Prisoners Problem" ' b+ 2022-07-17
Randomize Timer
Dim slots(1 To 100) As Long
For i = 1 To 100
    slots(i) = i
Next
Do
    freed = 0: executions = 0
    Do
        GoSub shuffle
        For p = 1 To 100 ' prisoner number
            count = 1: test = p: madeit = -1
            While count <= 50
                If slots(test) = p Then Exit While Else test = slots(test)
                count = count + 1
                If count > 50 Then madeit = 0: Exit For
            Wend
        Next
        If madeit Then freed = freed + 1 Else executions = executions + 1
    Loop Until (freed + executions) = 100000
    Print "Freed"; freed
    Print "Exceutions"; executions
    Print
    Print "Press any for another run of 100,000... "
    Sleep
    Cls
Loop Until _KeyDown(27)
End
shuffle:
For i = 100 To 2 Step -1
    Swap slots(Int(Rnd * i) + 1), slots(i)
Next
Return


'  I saw this last night and just have to check out the solution in code!
' https://www.youtube.com/watch?v=iSNsgj1OCLA

' So 100 prisoners go into a room one at a time and have 50 chances to draw their number from mailbox slots
' they must return the numbers in same box they checked.

' If all the prisoners find their number they go free else they are all executed. Whew!

' But there is a strategy that if used gives them around a 31% chance of being set free!

'       A 31% Change of being set free, how can this be!?

' Here is the startegy, go into the room and pull the number from slot that matches your number.
' From that number go to the number found in the box, contimue in this manner until you find your
' number or you've drawn from 50 slots. If you hit 50 then everyone is doomed might as well start
' another run on the experiment.

' If we run this strategy 100000 times will we get around 31,000 Set Frees and 69,000 Executions?

' Let's see...

' Wow! as predicted

and its output





References:
Youtube chain method for 100 prisoners
Chain strategy 100 prisoners (the same used by Bplus)
Probability chain rule
wikipedia page 100 prisoners
math stackexchange page 100 prisoners solution

---------------------------------------------------------------------------------
welcome some other implementations of chain method.