我算了一下,得到了12/243的解,如果计算没有问题,貌似没有更好的解了。
计算过程如下:
1、先说明一下“确定性”方案和“概率性”方案的区别。
那5个戴帽子的人中的每一个人都会采取一种方案,这种方案的输入是他旁边的两人帽子上的数,输出是
他猜测的数。如果他在输入确定的情况下,输出的猜测总保持不变,那么方案就是“确定性”的,反之就
是“概率性”的。即如果根据两边帽子上的数完全决定了所猜测的数,那么他采取的就是“确定性”方案
。比如说:他总猜1,就是“确定性”方案;他看到两边的人帽子上的数都是1,那么他通过投币来决定是
猜1还是2,就是“概率性”方案。如果5个人都采用“确定性”方案,那么整个方案就是“确定性”的。
可以看到:“概率性”方案是某几个“确定性”方案的加权平均,所以最优方案一定是“确定性”的。好
了,我们下面只讨论“确定性”方案了,啰嗦了半天,呵呵。
2、节点的相容性
5个人的帽子上的数一共有3^5=243种可能性,我们称为243个节点,为什么叫节点,看了下面可能就会明
白,呵呵。
比如说:5个人帽子上的数依次是{0,1,2,0,0}(为了方便,从现在起帽子上的数是012而非123了),其中
第2个人看到,左右的人的数分别是0和2,那么他要猜1才正确,而另一个节点{0,0,2,0,0}是和节点
{0,1,2,0,0}不相容的。因为对于第2个人来说,他在两个节点上,不能都猜对。而节点{0,1,2,0,0}和节
点{2,2,2,2,2}是相容的。如果243个节点对应0到242的数,那么节点s1和s2的相容性可以由下面的代码确
定。(当s1和s2相容时,返回1。)
- c[s1_,s2_]:= Module[{x},If[s1>=s2,Return[0]];
- x=Map[First[#]==Last[#]&,Transpose[{IntegerDigits[s1,3,5],IntegerDigits[s2,3,5]}]];
- x=Join[x,x];If[Apply[Or,Table[And[x[[i-1]],x[[i+1]],Not[x[[i]]]],{i, 2, 6}]],0,1]];
复制代码 3、寻找某个图的最大完全子图
243个节点根据其相容性构成一个图,对于这个图的某个完全子图,可以找到猜测的策略,使得帽子分布
是这个完全子图的某个节点时,5个人都依据这种策略都猜对。反之,这个243个节点的图的最大完全子图
的节点个数,就是能够猜对的最大状况数。因为更多的节点中存在不相容的节点,不相容的节点意味着会
有人当输入确定时要求输出不同的数。
寻找某个图的最大完全子图是一件麻烦的事情,这是一个NP问题,还好,这个图具有一定的对称性,而且
规模不算太大。算法是这样的:穷举删除所有的节点中的一个,生成一些少一个节点的图,然后合并彼此
同构的图,然后循环,是广度优先搜索的方法。
在图ms中,删除第k个节点实现代码如下:
- delk[ms_,k_]:= Module[{vs1},vs1=Join[Map[First,Select[ms,Last[#]==k&]],
- Map[Last,Select[ms,First[#]==k&]]];Select[ms,Length[Intersection[#,vs1]]==2&]];
复制代码 生成那个243个节点的图的代码如下:
- ms=Rest[Union[Flatten[Table[If[c[i,j]==1,{i,j},0],{i,0,3^5-1},{j,0,3^5-1}],1]]];
- ms//Length
- ss={{ms,{}}};
- f=0;ff=StringJoin["d:\\fan\\f", ToString[f],".txt"];Put[ss,ff];
复制代码 代码生成一个含有20898条边的图,放在一个文件里。
下面是搜索最大完全子图的代码,运算时间较长,每运行一次生成一个文件,要手动循环,其中的判断图
同构的函数IsomorphicGraphQ貌似要M8的版本。
- ss0=Get[ff];ss={};ssg={};
- For[n=1,n<= Length[ss0],
- ms=First[ss0[[n]]];If[ms=={},n++;Continue[]];
- mk=Last[ss0[[n]]];vs=Union[Flatten[ms]];
- For[i=1,i<= Length[vs],
- k=vs[[i]];m=delk[ms,k];If[m=={},i++;Continue[]];v=Union[Flatten[m]];
- g=Graph[v,Map[First[#]\[UndirectedEdge]Last[#]&,m]];
- For[j=1,j<=Length[ss],If[IsomorphicGraphQ[g,ssg[[j]]],Break[]];j++];
- If[j==Length[ss]+1,AppendTo[ss,{m,Append[mk,k]}];AppendTo[ssg, g]];i++];
- If[Mod[n,2]==0,Print["n=",n," s=",Length[ssg]];];n++];
- ss//Length
- f++;ff=StringJoin["d:\\fan\\f",ToString[f],".txt"];Put[ss,ff];
复制代码 循环10次后(循环11次后结果为空),用下面代码输出最大完全子图的节点:
- s={};For[i=1,i<=Length[ss],as=ss[[i,1]];bs=ss[[i,2]];s=Join[s,Map[Join[bs,#]&,as]];i++];
- Union[Map[Sort,s]]
复制代码 可得到15组结果,如下:
{{0, 4, 8, 36, 40, 72, 116, 122, 154, 224, 230, 236},
{0, 4, 8, 36, 40, 72, 116, 148, 154, 224, 230, 236},
{0, 4, 8, 36, 72, 80, 112, 118, 133, 200, 215, 220},
{0, 4, 8, 36, 72, 80, 112, 118, 133, 200, 220, 241},
{0, 4, 8, 36, 72, 112, 118, 133, 200, 215, 220, 224},
{0, 4, 8, 36, 72, 112, 118, 133, 200, 220, 224, 236},
{0, 4, 8, 36, 72, 112, 118, 133, 200, 220, 236, 241},
{0, 4, 15, 45, 86, 98, 153, 161, 193, 208, 215, 229},
{0, 4, 15, 45, 86, 98, 153, 161, 202, 206, 208, 220},
{0, 4, 15, 45, 86, 98, 153, 161, 202, 206, 220, 235},
{0, 4, 15, 45, 86, 98, 153, 161, 202, 208, 215, 220},
{0, 4, 15, 45, 86, 149, 150, 153, 193, 209, 214, 229},
{0, 4, 15, 45, 86, 149, 150, 153, 193, 209, 214, 232},
{0, 4, 15, 45, 86, 149, 150, 155, 193, 209, 214, 229},
{0, 4, 15, 45, 86, 149, 150, 155, 193, 209, 214, 232}}
可以看到它们都对应12/243的几率,更大的貌似就没有了。呵呵。 |