All about flooble | fun stuff | Get a free chatterbox | Free JavaScript | Avatars    
perplexus dot info

Home > Probability
He stole my ball! (Posted on 2019-04-24) Difficulty: 3 of 5
Six balls are at the front of the classroom, and six students are each assigned a different colored ball.

Then they are asked to go up one at a time and take the ball they were assigned.

However, the first student doesn't like the color he was assigned, so he picks randomly from the remaining five.

After that, each successive student takes the color they were assigned if it's available, otherwise they choose randomly from the remaining balls.

What is the probability that the last student gets the ball they were assigned?

No Solution Yet Submitted by Danish Ahmed Khan    
No Rating

Comments: ( Back to comment list | You must be logged in to post comments.)
Solution computer assissted solution | Comment 1 of 8
DefDbl A-Z
Dim crlf$, remain$, chosen$, ct, denom, prob, tt



Private Sub Form_Load()
 Text1.Text = ""
 crlf$ = Chr(13) + Chr(10)
 Form1.Visible = True
 DoEvents
 
 remain$ = "ABCDEF": denom = 1
 
 addon
 
Text1.Text = Text1.Text & crlf & ct & "  " & ct / prob & "  " & prob & crlf

Text1.Text = Text1.Text & tt
 
End Sub

Sub addon()
  DoEvents
  If chosen = "" Then st = 2 Else st = 1
  fin = Len(remain)
  If chosen > "" Then
    srch$ = Mid("BCDEF", Len(chosen), 1)
    ix = InStr(remain, srch)
    If ix > 0 Then st = ix: fin = ix
  End If
  For psn = st To fin
    chosen = chosen + Mid(remain, psn, 1)
    denom = denom * (fin - st + 1)
    remain = Left(remain, psn - 1) + Mid(remain, psn + 1)
    
    If Len(chosen) = 6 Then
      If Right(chosen, 1) = "F" Then ct = ct + denom: prob = prob + 1 / denom
      
      Text1.Text = Text1.Text & chosen & "  " & ct & "    " & mform(1 / denom, "0.00000000") & crlf
      
      tt = tt + 1 / denom
    Else
      addon
    End If
    
    remain = Left(remain, psn - 1) + Right(chosen, 1) + Mid(remain, psn)
    chosen = Left(chosen, Len(chosen) - 1)
    denom = denom / (fin - st + 1)

  Next
End Sub

Function mform$(x, t$)
  a$ = Format$(x, t$)
  If Len(a$) < Len(t$) Then a$ = Space$(Len(t$) - Len(a$)) & a$
  mform$ = a$
End Function
 
 
finds 





BACDEF  25    0.04000000
BCADEF  125    0.01000000
BCDAEF  425    0.00333333
BCDEAF  1025    0.00166667
BCDEFA  1025    0.00166667
BCDFEA  1025    0.00333333
BCEDAF  1225    0.00500000
BCEDFA  1225    0.00500000
BCFDEA  1225    0.01000000
BDCAEF  1300    0.01333333
BDCEAF  1450    0.00666667
BDCEFA  1450    0.00666667
BDCFEA  1450    0.01333333
BECDAF  1500    0.02000000
BECDFA  1500    0.02000000
BFCDEA  1500    0.04000000
CBADEF  1520    0.05000000
CBDAEF  1580    0.01666667
CBDEAF  1700    0.00833333
CBDEFA  1700    0.00833333
CBDFEA  1700    0.01666667
CBEDAF  1740    0.02500000
CBEDFA  1740    0.02500000
CBFDEA  1740    0.05000000
DBCAEF  1755    0.06666667
DBCEAF  1785    0.03333333
DBCEFA  1785    0.03333333
DBCFEA  1785    0.06666667
EBCDAF  1795    0.10000000
EBCDFA  1795    0.10000000
FBCDEA  1795    0.20000000

1795  4487.5  0.4
1

0.4 is the probability asked for.

The 1 at the end verifies the probabilities add to 1.


A simulation verifies the 0.4 probablity:

DefDbl A-Z
Dim crlf$, ct, trials



Private Sub Form_Load()
 Text1.Text = ""
 crlf$ = Chr(13) + Chr(10)
 Form1.Visible = True
 DoEvents
  
 sup0$ = "ABCDEF"
 Randomize Timer
 For tr = 1 To 100000
   supply$ = sup0: used$ = ""
   For player = 1 To 6
     If player = 1 Then r = Int(Rnd(1) * 5 + 2) Else r = Int(Rnd(1) * Len(supply) + 1)
     ix = InStr(supply, Mid(sup0, player, 1))
     If player > 1 And ix > 0 Then r = ix
     used = used + Mid(supply, r, 1)
     supply = Left(supply, r - 1) + Mid(supply, r + 1)
   Next
   If Right(used, 1) = "F" Then ct = ct + 1
   trials = trials + 1
   DoEvents
 Next
 
 Text1.Text = Text1.Text & ct & Str(trials) & Str(ct / trials) & crlf
  
  
  
End Sub

succ.  trials  prob.  
39949 100000 .39949

Edited on April 25, 2019, 3:28 pm
  Posted by Charlie on 2019-04-24 16:44:02

Please log in:
Login:
Password:
Remember me:
Sign up! | Forgot password


Search:
Search body:
Forums (2)
Newest Problems
Random Problem
FAQ | About This Site
Site Statistics
New Comments (1)
Unsolved Problems
Top Rated Problems
This month's top
Most Commented On

Chatterbox:
Copyright © 2002 - 2020 by Animus Pactum Consulting. All rights reserved. Privacy Information