Re: задачка по теории вероятности

From

Serg Belyaev (2:5015/166.7)

To

Igor Tolstoy

Date

2002-10-13T17:42:24Z

Area

RU.ALGORITHMS

Привет, Igor.

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х оставшихся.
>> Начинается игра, каждый игрок бросает свой кубик.
>> Выигрывает тот у кого больше очков выпало.
>>
>> Вопрос: Как игрок 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
...
Приведены не все решения. Например я не увидел набора
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)