|
ru.algorithms
- RU.ALGORITHMS ----------------------------------------------------------------
From : Serg Belyaev 2:5015/166.7 13 Oct 2002 17:42:24
To : Igor Tolstoy
Subject : Re: задачка по теории вероятности
--------------------------------------------------------------------------------
02-Oct-02 03:10:29, Igor Tolstoy wrote to dmitry chernokozov
Subject: Re: задачка по теории вероятности
>> === Cut ===
>> Дано 3 6-ти гранных кубика и 18 наклеек с цифрами от 1 до 18
>> соответственно.
>> Дано 2 игрока, A и B.
>> Игрок A наклеивает все наклейки на грани кубиков.
>> Игрок B смотрит и выбирает один кубик.
>> Игрок A выбирает один кубик из 2х оставшихся.
>> Hачинается игра, каждый игрок бросает свой кубик.
>> Выигрывает тот у кого больше очков выпало.
>>
>> Вопрос: Как игрок A должен наклеить наклейки на кубики чтобы
>> математическое ожидание его выигрыша было максимально ?
>> === Cut ===
>>
>> PS: По секрету узнал что ответ 21/36 у A и 15/36 у B, но не совсем понятен
>> алгоритм решения, и как его реализовать на каком-нибудь языке, например на
IT> 1 2 9 14 15 16
IT> 6 7 8 11 12 13
IT> 3 4 5 10 17 18
...
Приведены не все решения. Hапример я не увидел набора
0) 1 10 11 12 13 14
1) 2 3 4 15 16 17
2) 5 6 7 8 9 18
p10=21 p21=21 p02=25 (/36)
где pIJ - мат.ожидание выигрыша I-ого кубика против J-ого.
Кстати, это единственный набор, у которого для одной из
пар p=25/36.
Всего имеется 15 решений (с точностью до переименования кубиков)
с выигрышами 1>0, 2>1, 0>2.
Достаточно быстрый алгоритм следующий:
-----------------------cut------------------------------
const s0:string='0000000000000000';
s1:string='1111111111111111';
s2:string='2222222222222222';
c:longint=0;
n=6;
var ur:word;
procedure act(s:string);
var cub:array[0..2,1..n] of byte;
i,i0,i1,i2:byte;
begin
i0:=0;i1:=0;i2:=0;
for i:=1 to 3*n do
case s[i] of
'0':begin inc(i0);cub[0,i0]:=i end;
'1':begin inc(i1);cub[1,i1]:=i end;
'2':begin inc(i2);cub[2,i2]:=i end;
end;
for i:=1 to n do write(' ',cub[0,i]:2);writeln;
for i:=1 to n do write(' ',cub[1,i]:2);writeln;
for i:=1 to n do write(' ',cub[2,i]:2);writeln;
end;
procedure F(s:string;p10,p21,p02,x,y,z:byte);
begin
if (x=0)and(y=0)and(z=0) then begin
inc(c);
if (p10>=ur)and(p21>=ur)and(p02>=ur) then begin
ur:=p10;
if p21<ur then ur:=p21;
if p02<ur then ur:=p02;
writeln('ur=',ur,' p10=',p10,' p21=',p21,' p02=',p02);
act(s);
end;
exit
end;
if (y=0)and(z=0) then begin
F(s+copy(s0,1,x),p10,p21,p02+n*x,0,0,0);exit end;
if (x=0)and(z=0) then begin
F(s+copy(s1,1,y),p10+n*y,p21,p02,0,0,0);exit end;
if (x=0)and(y=0) then begin
F(s+copy(s2,1,z),p10,p21+n*z,p02,0,0,0);exit end;
if (p02+x*n>=ur)and(p10+y*n>=ur)and(p21+z*n>=ur) then begin
if (x>0) then F(s+'0',p10,p21,p02+n-z,x-1,y,z);
if (y>0) then F(s+'1',p10+n-x,p21,p02,x,y-1,z);
if (z>0) then F(s+'2',p10,p21+n-y,p02,x,y,z-1);
end;
end;
begin
writeln('n=',n);
ur:=trunc((sqrt(5)-1)*n/2);
if n*ur>n*n-(ur+1)*(ur+1) then ur:=n*ur else ur:=n*n-(ur+1)*(ur+1);
F('0',0,0,0,n-1,n,n);
writeln('c_all=',c);
end.
-----------------------cut------------------------------
Для n=12 на PC частотой 375 этот алгоритм находит все
решения примерно за 2 минуты.
Всего доброго,
<SVB> (Serg Belyaev)
--- Terminate 5.00/Pro
* Origin: (svb@sandy.ru) or (2:5015/166.7)
Вернуться к списку тем, сортированных по: возрастание даты уменьшение даты тема автор
|
