Predict Heads Tails Sequence

[B+]

Something I saw on Numberphile I wanted to test, it's true!


' Heads Tails Sequence as seen on Numberphile.txt b+ 2019-11-17
' Something I saw on Numberphile, a simple little coding experiment

while 1
   do
       cls
       print "Experiment update: You = ";You;", Math = ";Math
       print
       print "For a sequence of Head and Tails, H's and T's, eg: TTTTTHTHTHHHTTHTHTT..."
       print "Enter a sequence of 3 H's or T's, like HTT or THT or HHH..."
       input "that might appear first (nothing to quit) ";mark$
       if mark$ = "" then end
       mark$ = upper$(mark$)
       if len(mark$) = 3 then
           notGood = 0
           for i = 1 to 3
               if mid$(mark$, i, 1) <> "H" and mid$(mark$, i, 1) <> "T" then notGood = 1
           next
       else
           notGood = 1
       end if
   loop until notGood = 0
   math$ = mid$(mark$, 2, 1)
   if math$ = "T" then math$ = "H" else math$ = "T"
   math$ = math$ + mid$(mark$, 1, 2)
   print "Math picks: ";math$;", let's see which turns up first."
   notDone = 1 :seq$ = ""
   while notDone
       scan
       cls
       Print "You picked ";mark$;", math picked ";math$
       if rnd(0) < .5 then L$ = "H" else L$ = "T"
       seq$ = seq$ + L$
       print seq$
       call pause 1000
       if mid$(seq$, len(seq$) - 2) = mark$ then print "You won!" : You = You + 1 : notDone = 0
       if mid$(seq$, len(seq$) - 2) = math$ then print "Math won!" : Math = Math + 1 : notDone = 0
       if notDone = 0 then call pause 4000
   wend
wend

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub



[tsh73]

1000 tests each:
your bet you comp
HHH 126 874
HHT 245 755
HTH 325 675
HTT 310 690
TTH 327 673
THT 339 661
TTH 252 748
TTT 117 883


That must be dark magic!!!

Computer wins

74% to 26%
So how they do it?

[B+]

That must be dark magic!!!

Computer wins

74% to 26%
So how they do it?

Interesting isn't it, each permutation equally likely BUT commit to one and it is easy to find a permutation that will "short-circuit" that choice.
If you run the program and observe, you get a feel for the "dark magic".

I have found if you go first, you do better with Alternating HTH or THT than say HTT or TTH but still odds are against you in long run.
www.youtube.com/watch?v=Sa9jLWKrX0c&t=6s

[Rod]

can we see the code for testing 1000 times?

[B+]

Nov 18, 2019 18:38:03 GMT Rod said:

can we see the code for testing 1000 times?

Here is a quicky mod to see 1000 tests for each permutation:

' Heads Tails Sequence 1000 Trials.txt b+ 2019-11-18
' Something I saw on Numberphile, a simple little coding experiment

for m = 1 to 8
   You = 0 : Math = 0
   'do
   '    cls
   '    print "Experiment update: You = ";You;", Math = ";Math
   '    print
   '    print "For a sequence of Head and Tails, H's and T's, eg: TTTTTHTHTHHHTTHTHTT..."
   '    print "Enter a sequence of 3 H's or T's, like HTT or THT or HHH..."
   '    input "that might appear first (nothing to quit) ";mark$
   '    if mark$ = "" then end
   '    mark$ = upper$(mark$)
   '    if len(mark$) = 3 then
   '        notGood = 0
   '        for i = 1 to 3
   '            if mid$(mark$, i, 1) <> "H" and mid$(mark$, i, 1) <> "T" then notGood = 1
   '        next
   '    else
   '        notGood = 1
   '    end if
   'loop until notGood = 0
   scan
   select case m
   case 1 : mark$ = "TTT"
   case 2 : mark$ = "TTH"
   case 3 : mark$ = "THT"
   case 4 : mark$ = "THH"
   case 5 : mark$ = "HTT"
   case 6 : mark$ = "HTH"
   case 7 : mark$ = "HHT"
   case 8 : mark$ = "HHH"
   end select

   math$ = mid$(mark$, 2, 1)
   if math$ = "T" then math$ = "H" else math$ = "T"
   math$ = math$ + mid$(mark$, 1, 2)
   'print "Math picks: ";math$;", let's see which turns up first."
   for test = 1 to 1000
       notDone = 1 :seq$ = ""
       while notDone
           scan
           'cls
           'Print "You picked ";mark$;", math picked ";math$
           if rnd(0) < .5 then L$ = "H" else L$ = "T"
           seq$ = seq$ + L$
           'print seq$
           'call pause 1000
           if mid$(seq$, len(seq$) - 2) = mark$ then
               'print "You won!"
                You = You + 1 : notDone = 0
           end if
           if mid$(seq$, len(seq$) - 2) = math$ then
               'print "Math won!"
               Math = Math + 1 : notDone = 0
           end if
           'if notDone = 0 then call pause 4000
       wend
   next
   print "For Mark$ = ";mark$;" and math$ = ";math$;" mark$ won ";You;" times and math$ won ";Math;" times."
next

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub




Sample Output:
For Mark$ = TTT and math$ = HTT mark$ won 113 times and math$ won 887 times.
For Mark$ = TTH and math$ = HTT mark$ won 237 times and math$ won 763 times.
For Mark$ = THT and math$ = TTH mark$ won 335 times and math$ won 665 times.
For Mark$ = THH and math$ = TTH mark$ won 333 times and math$ won 667 times.
For Mark$ = HTT and math$ = HHT mark$ won 349 times and math$ won 651 times.
For Mark$ = HTH and math$ = HHT mark$ won 324 times and math$ won 676 times.
For Mark$ = HHT and math$ = THH mark$ won 253 times and math$ won 747 times.
For Mark$ = HHH and math$ = THH mark$ won 135 times and math$ won 865 times.


[B+]

OK so the worse picks are HHH, TTT, 1/8th time
Next worse HHT or TTH, 1/4ths of time
And THH or THT or HTH or HTT all are tied for winning 1/3rd of the time.

[tsh73]

So. "Threes" occur pretty randomly.
dim backet(8)
dim marks$(8)
mark$(1) = "TTT"
mark$(2) = "TTH"
mark$(3) = "THT"
mark$(4) = "THH"
mark$(5) = "HTT"
mark$(6) = "HTH"
mark$(7) = "HHT"
mark$(8) = "HHH"

N=10000
seq$ = ""
for i = 1 to N+2
   if rnd(0) < .5 then L$ = "H" else L$ = "T"
   seq$ = seq$ + L$
next
print len(seq$)
print left$(seq$, 70)+"..."

for i = 1 to N
   s$=mid$(seq$,i,3)
   for j = 1 to 8
       if s$=mark$(j) then backet(j)=backet(j)+1: exit for
   next
next

for i = 1 to 8
   print backet(i)
next

10002
HTHTTHHTHTTHHHTTHTTHTTHHHHHHTTHTHHTHHHHTTTHHHTHTTHTTHHHTHTTTTHTTTHHHHH...
1263
1239
1226
1267
1240
1254
1267
1244

So why that thing wins?

[tsh73]

1/8 is pretty reasonable (?)
To get HHH, one have to pick H 3 times, 1/2*1/2*1/2 makes 1/8
(any other pick gives something else so 1 to 7)

[tsh73]

Searching for first occurrence of pattern
(10000 experiments took quite a while)
dim backet(8)
dim marks$(8)
dim s(8)
mark$(1) = "TTT"
mark$(2) = "TTH"
mark$(3) = "THT"
mark$(4) = "THH"
mark$(5) = "HTT"
mark$(6) = "HTH"
mark$(7) = "HHT"
mark$(8) = "HHH"

K=10000
N=100'00
for k=1 to K
seq$ = ""
for i = 1 to N+2
   if rnd(0) < .5 then L$ = "H" else L$ = "T"
   seq$ = seq$ + L$
next
'print len(seq$)
'print left$(seq$, 70)+"..."

redim backet(8) 'clear array
for i = 1 to N
   s$=mid$(seq$,i,3)
   for j = 1 to 8
       if s$=mark$(j) and backet(j)=0 then backet(j)=i ' first occurence
   next
next

for i = 1 to 8
   s(i)=s(i)+backet(i)
next
next 'k

for i = 1 to 8
   print s(i)/k    'average first occurence
next


11.9867013
5.99070093
8.30776922
5.92120788
6.00869913
8.11418858
5.93240676
11.5667433

Looks similar to win rate.
Not quite, but it shows HHH and TTT bad.

[B+]

If math$ picks randomly, it's pretty equal who wins unless mark$ picks "TTT" or "HHH":

' Heads Tails Sequence RND picks Trials.txt b+ 2019-11-18
' Something I saw on Numberphile, a simple little coding experiment

dim p$(7)
p$(0) = "TTT"
p$(1) = "TTH"
p$(2) = "THT"
p$(3) = "THH"
p$(4) = "HTT"
p$(5) = "HTH"
p$(6) = "HHT"
p$(7) = "HHH"

for m = 0 to 7
   scan
   You = 0 : Math = 0
   mark$ = p$(m)
   for test = 1 to 1000
       math$ = p$(int(rnd(0) * 8))
       while math$ = mark$   ' find a perm not equal to mark$
           math$ = p$(int(rnd(0) * 8))
       wend
       notDone = 1 :seq$ = ""
       while notDone
           scan
           if rnd(0) < .5 then L$ = "H" else L$ = "T"
           seq$ = seq$ + L$
           if mid$(seq$, len(seq$) - 2) = mark$ then
                You = You + 1 : notDone = 0
           end if
           if mid$(seq$, len(seq$) - 2) = math$ then
               Math = Math + 1 : notDone = 0
           end if
       wend
   next
   print "For Mark$ = ";mark$;" and math$ = RND pick, mark$ won ";You;" times and math$ won ";Math;" times."
next




For Mark$ = TTT and math$ = RND pick, mark$ won 380 times and math$ won 620 times.
For Mark$ = TTH and math$ = RND pick, mark$ won 562 times and math$ won 438 times.
For Mark$ = THT and math$ = RND pick, mark$ won 502 times and math$ won 498 times.
For Mark$ = THH and math$ = RND pick, mark$ won 582 times and math$ won 418 times.
For Mark$ = HTT and math$ = RND pick, mark$ won 568 times and math$ won 432 times.
For Mark$ = HTH and math$ = RND pick, mark$ won 477 times and math$ won 523 times.
For Mark$ = HHT and math$ = RND pick, mark$ won 571 times and math$ won 429 times.
For Mark$ = HHH and math$ = RND pick, mark$ won 367 times and math$ won 633 times.


The only way "TTT" or "HHH" can possibly win is if they occur "right off the bat" (from the start), otherwise anything else will come up before TTT or HHH, pure logic of sequence.

Note: With Random picks mark$ can make bad choice of "TTT" but math$ can make equally bad choice of "HHH".

[tsh73]

Ok so I made a matrix like "how much times HTH came before THH in 10000 tries"
Here is it
Does it looks probable?
number of tests where Row came first, when column
        TTT   TTH   THT   THH   HTT   HTH   HHT   HHH
TTT        0  5095  4132  4028  1281  4289  3011  4967
TTH     4905     0  6789  6671  2545  6347  4986  6963
THT     5868  3211     0  4947  4872  5008  3706  5761
THH     5972  3329  5053     0  5056  5095  7501  8733
HTT     8719  7455  5128  4944     0  5070  3259  5934
HTH     5711  3653  4992  4905  4930     0  3291  5999
HHT     6989  5014  6294  2499  6741  6709     0  5014
HHH     5033  3037  4239  1267  4066  4001  4986     0

(code, for reference)
dim backet(8)
dim marks$(8)
dim s(8)
dim ss(8,8)
mark$(1) = "TTT"
mark$(2) = "TTH"
mark$(3) = "THT"
mark$(4) = "THH"
mark$(5) = "HTT"
mark$(6) = "HTH"
mark$(7) = "HHT"
mark$(8) = "HHH"

K=10000
t0=time$("ms")
N=100'0'0
for k=1 to K
seq$ = ""
for i = 1 to N+2
   if rnd(0) < .5 then L$ = "H" else L$ = "T"
   seq$ = seq$ + L$
next
'print len(seq$)
'print left$(seq$, 70)+"..."

redim backet(8) 'clear array
notUsed=8
for i = 1 to N
   s$=mid$(seq$,i,3)
   for j = 1 to 8
       if s$=mark$(j) and backet(j)=0 then backet(j)=i:notUsed=notUsed-1 ' first occurence
   next
   if notUsed=0 then exit for
next

for i = 1 to 8
   s(i)=s(i)+backet(i)
next
for i = 1 to 8
   for j = 1 to 8
       if backet(i)<backet(j) then ss(i, j)=ss(i, j)+1
   next
next

next 'k

t=time$("ms")
print "Time ";t-t0

for i = 1 to 8
   print s(i)/k    'average first occurence
next
print

print "number of tests where Row came first, when column"
print space$(9);
for j = 1 to 8
   print mark$(j);"   ";
next
print

for i = 1 to 8
   print mark$(i);"   ";
   for j = 1 to 8
       print using("######",ss(i, j));
   next
   print
next


[tsh73]

So if I go for max in these columns (I expected it to be symmetrical but I likely broke it somewhere)
I see
1) that for every combination going to be better one
2) and if we peek that better combination we get
8719 7455 6789 6671 6741 6709 7501 8733
actually these are numbers like "computer win" from my first post

Huh.
Does it explains "why"? I still can't quite get it...

[B+]

Nov 18, 2019 22:16:30 GMT tsh73 said:

So if I go for max in these columns (I expected it to be symmetrical but I likely broke it somewhere)
I see
1) that for every combination going to be better one
2) and if we peek that better combination we get
8719 7455 6789 6671 6741 6709 7501 8733
actually these are numbers like "computer win" from my first post

Huh.
Does it explains "why"? I still can't quite get it...

It's like Rock, Paper, Scissors, each combination beats one other but there is always a combination that beats it (check the link) because of the ways things occur in a sequence.

Update: Sorry, these are not Combinations (where order is not important) these are Permutations where the order is important.

[tsh73]

It's like Rock, Paper, Scissors

Yes, that occurred to me. Probabilistical Rock, Paper, Scissors

(check the link)

In a video?

[B+]

www.youtube.com/watch?v=Sa9jLWKrX0c&t=6s