program optstop(input,output);
{
An optimal stopping card game
Posted on December 7, 2013 by possiblywrong.wordpress.com
Let's play the following simple game: I will shuffle a standard
52-card deck, and deal one card at a time face up onto the table
between us. You can say "Stop" at any time, at which point I will pay
you an amount equal to the fraction of cards dealt so far that are red.
For example, if you stop after seeing a single card, you win 1 if it
is red, 0 if it is black, with expected return 1/2. Of course,
you can wait until the entire deck is dealt, also with a guaranteed
return of 1/2.
The problem is: can you do better than this?
What is the optimal strategy for playing this game,
and what is the corresponding expected return?
}
const
RED=26;
BLACK=26;
type
tBlack = 0..BLACK;
tRed = 0..RED;
tMatrix = array[tRed, tBlack] of Double;
tDraw = array[tRed, tBlack] of Boolean;
var
r: tRed;
b: tBlack;
avg: Double; { average }
q: Double; { quotient = current return = r/(r+b) }
Matrix: tMatrix; { value of hand }
Draw: tDraw; { draw another? yes=true }
begin
{ right column }
for b:=0 to BLACK do
begin
Matrix[RED,b]:=RED/(RED+b);
Draw[RED,b]:=false;
end;
{ bottom row }
for r:=0 to RED-1 do
begin
Matrix[r, BLACK]:=RED/(RED+BLACK);
Draw[r, BLACK]:=true;
end;
{ the center }
for r := RED-1 downto 0 do
for b:= BLACK-1 downto 1 do
begin
q := r/(r+b);
avg:= (RED-r)/(RED+BLACK-r-b)*Matrix[r+1,b]
+(BLACK-b)/(RED+BLACK-r-b)*Matrix[r,b+1];
if q > avg then { best strategy }
{ if r > b then } { simple strategy }
begin
Matrix[r,b]:=q;
Draw[r,b]:=false;
end
else
begin
Matrix[r,b]:=avg;
Draw[r,b]:=true;
end;
end;
{ top row }
for r:= RED downto 1 do
begin
Matrix[r,0]:=1;
Draw[r,0]:=false;
end;
{ top left corner, avoiding division by zero }
Matrix[0,0]:= RED/(RED+BLACK)*Matrix[1,0]
+BLACK/(RED+BLACK)*Matrix[0,1];
Draw[0,0]:=true;
{ OUTPUT }
{ top row }
for r:= 0 to RED do
write(r:7);
writeln;
{ data }
for b:= 0 to BLACK do
begin
write(b:2,' ');
for r:= 0 to RED do
if Draw[r,b] then
write(Matrix[r,b]:4:3,' ')
else
write(Matrix[r,b]:4:3,'* ');
writeln;
end;
end.
cHJvZ3JhbSBvcHRzdG9wKGlucHV0LG91dHB1dCk7CnsKICAgQW4gb3B0aW1hbCBzdG9wcGluZyBjYXJkIGdhbWUKICAgUG9zdGVkIG9uIERlY2VtYmVyIDcsIDIwMTMgYnkgcG9zc2libHl3cm9uZy53b3JkcHJlc3MuY29tCgogICBMZXQncyBwbGF5IHRoZSBmb2xsb3dpbmcgc2ltcGxlIGdhbWU6IEkgd2lsbCBzaHVmZmxlIGEgc3RhbmRhcmQKICAgNTItY2FyZCBkZWNrLCBhbmQgZGVhbCBvbmUgY2FyZCBhdCBhIHRpbWUgZmFjZSB1cCBvbnRvIHRoZSB0YWJsZQogICBiZXR3ZWVuIHVzLiAgWW91IGNhbiBzYXkgIlN0b3AiIGF0IGFueSB0aW1lLCBhdCB3aGljaCBwb2ludCBJIHdpbGwgcGF5CiAgIHlvdSBhbiBhbW91bnQgZXF1YWwgdG8gdGhlIGZyYWN0aW9uIG9mIGNhcmRzIGRlYWx0IHNvIGZhciB0aGF0IGFyZSByZWQuCiAgIEZvciBleGFtcGxlLCBpZiB5b3Ugc3RvcCBhZnRlciBzZWVpbmcgYSBzaW5nbGUgY2FyZCwgeW91IHdpbiAxIGlmIGl0CiAgIGlzIHJlZCwgMCBpZiBpdCBpcyBibGFjaywgd2l0aCBleHBlY3RlZCByZXR1cm4gMS8yLiAgT2YgY291cnNlLAogICB5b3UgY2FuIHdhaXQgdW50aWwgdGhlIGVudGlyZSBkZWNrIGlzIGRlYWx0LCBhbHNvIHdpdGggYSBndWFyYW50ZWVkCiAgIHJldHVybiBvZiAxLzIuCgogICBUaGUgcHJvYmxlbSBpczogY2FuIHlvdSBkbyBiZXR0ZXIgdGhhbiB0aGlzPwogICBXaGF0IGlzIHRoZSBvcHRpbWFsIHN0cmF0ZWd5IGZvciBwbGF5aW5nIHRoaXMgZ2FtZSwKICAgYW5kIHdoYXQgaXMgdGhlIGNvcnJlc3BvbmRpbmcgZXhwZWN0ZWQgcmV0dXJuPwp9Cgpjb25zdAogIFJFRD0yNjsKICBCTEFDSz0yNjsKCnR5cGUKICB0QmxhY2sgPSAwLi5CTEFDSzsKICB0UmVkID0gMC4uUkVEOwogIHRNYXRyaXggPSBhcnJheVt0UmVkLCB0QmxhY2tdIG9mIERvdWJsZTsKICB0RHJhdyA9IGFycmF5W3RSZWQsIHRCbGFja10gb2YgQm9vbGVhbjsKCnZhcgogIHI6IHRSZWQ7CiAgYjogdEJsYWNrOwogIGF2ZzogRG91YmxlOyB7IGF2ZXJhZ2UgfQogIHE6IERvdWJsZTsgeyBxdW90aWVudCA9IGN1cnJlbnQgcmV0dXJuID0gci8ocitiKSB9CiAgTWF0cml4OiB0TWF0cml4OyB7IHZhbHVlIG9mIGhhbmQgfQogIERyYXc6IHREcmF3OyB7IGRyYXcgYW5vdGhlcj8geWVzPXRydWUgfQoKYmVnaW4KICB7IHJpZ2h0IGNvbHVtbiB9CiAgZm9yIGI6PTAgdG8gQkxBQ0sgZG8KICBiZWdpbgogICAgTWF0cml4W1JFRCxiXTo9UkVELyhSRUQrYik7CiAgICBEcmF3W1JFRCxiXTo9ZmFsc2U7CiAgZW5kOwoKICB7IGJvdHRvbSByb3cgfQogIGZvciByOj0wIHRvIFJFRC0xIGRvCiAgYmVnaW4KICAgIE1hdHJpeFtyLCBCTEFDS106PVJFRC8oUkVEK0JMQUNLKTsKICAgIERyYXdbciwgQkxBQ0tdOj10cnVlOwogIGVuZDsKCiAgeyB0aGUgY2VudGVyIH0KICBmb3IgciA6PSBSRUQtMSBkb3dudG8gMCBkbwogICAgZm9yIGI6PSBCTEFDSy0xIGRvd250byAxIGRvCiAgICBiZWdpbgogICAgICBxIDo9IHIvKHIrYik7CiAgICAgIGF2Zzo9ICAoUkVELXIpLyhSRUQrQkxBQ0stci1iKSpNYXRyaXhbcisxLGJdCiAgICAgICAgICArKEJMQUNLLWIpLyhSRUQrQkxBQ0stci1iKSpNYXRyaXhbcixiKzFdOwogICAgICBpZiBxID4gYXZnIHRoZW4gIHsgYmVzdCBzdHJhdGVneSB9CnsgICAgIGlmIHIgPiBiIHRoZW4gfSB7IHNpbXBsZSBzdHJhdGVneSB9CiAgICAgIGJlZ2luCiAgICAgICAgTWF0cml4W3IsYl06PXE7CiAgICAgICAgRHJhd1tyLGJdOj1mYWxzZTsKICAgICAgZW5kCiAgICAgIGVsc2UKICAgICAgYmVnaW4KICAgICAgICBNYXRyaXhbcixiXTo9YXZnOwogICAgICAgIERyYXdbcixiXTo9dHJ1ZTsKICAgICAgZW5kOwogICAgZW5kOwoKCiAgeyB0b3Agcm93IH0KICBmb3Igcjo9IFJFRCBkb3dudG8gMSBkbwogIGJlZ2luCiAgICBNYXRyaXhbciwwXTo9MTsKICAgIERyYXdbciwwXTo9ZmFsc2U7CiAgZW5kOwogIHsgdG9wIGxlZnQgY29ybmVyLCBhdm9pZGluZyBkaXZpc2lvbiBieSB6ZXJvIH0KICBNYXRyaXhbMCwwXTo9ICBSRUQvKFJFRCtCTEFDSykqTWF0cml4WzEsMF0KICAgICAgICAgICAgICArQkxBQ0svKFJFRCtCTEFDSykqTWF0cml4WzAsMV07CiAgRHJhd1swLDBdOj10cnVlOwoKCiAgeyBPVVRQVVQgfQogIHsgdG9wIHJvdyB9CiAgZm9yIHI6PSAwIHRvIFJFRCBkbwogICAgd3JpdGUocjo3KTsKICB3cml0ZWxuOwoKICB7IGRhdGEgfQogIGZvciBiOj0gMCB0byBCTEFDSyBkbwogIGJlZ2luCiAgICB3cml0ZShiOjIsJyAgJyk7CiAgICBmb3Igcjo9IDAgdG8gUkVEIGRvCiAgICAgIGlmIERyYXdbcixiXSB0aGVuCiAgICAgICAgd3JpdGUoTWF0cml4W3IsYl06NDozLCcgICcpCiAgICAgIGVsc2UKICAgICAgICB3cml0ZShNYXRyaXhbcixiXTo0OjMsJyogJyk7CiAgICB3cml0ZWxuOwogIGVuZDsKCmVuZC4KCgo=