每周一题“如图”

FreddyMusic

“如图”所示，是个玩具。

请用Mathematica 代码找出答案。

游客，如果您要查看本帖隐藏内容请回复

lin2009

15     1     2    12
     4    10     9     7
     8     6     5    11
     3    13    14     0

chungyuandye

1. 
   
2. 
   
3. myrule1=x[i_,j_]:>ToExpression[ToString[x]<>If[i<=9,ToString[0]<>ToString[i],ToString[i]]<>If[j<=9,ToString[0]<>ToString[j],ToString[j]]];
   
4. myrule2=x_[i_]:>ToExpression[ToString[x]<>If[i<=9,ToString[0]<>ToString[i],ToString[i]]];
   
5. y[i_]:=Total@Table[j*x[i,j],{j,0,15}]/.myrule1;
   
6. cond1=Flatten[{Thread[Flatten@{Total@Partition[Table[y[i],{i,0,15}],4],Total@Transpose@Partition[Table[y[i],{i,0,15}],4],y[0]+y[5]+y[10]+y[15],y[3]+y[6]+y[9]+y[12]}==Table[30,{10}]],Thread[Flatten@{Total@Table[x[i,j],{i,0,15},{j,0,15}],Total@Transpose@Table[x[i,j],{i,0,15},{j,0,15}]}==
   
7. Table[1,{32}]]/.myrule1}];
   
8. var=Flatten@Table[Table[x[i,j],{j,0,15}],{i,0,15}]/.myrule1;
   
9. {b,m}=Normal[CoefficientArrays[cond1,var]];
   
10. ans=LinearProgramming[Range[0,255],m,Table[{-b[[i]],0},{i,Length@b}],Table[0,{i,256}],Integers]
    
11. Grid@Partition[Partition[ans,16].Range[0,15],4]
    
12. 
    

复制代码

{{12, 7, 8, 3}, {2, 13, 6, 9}, {5, 10, 1, 14}, {11, 0, 15, 4}}

ggggwhw

代码我先想着,先附上史上最优秀的四阶幻方,各项减去一即可满足上面的要求.

wushixlm

哇塞  太神了  15     1     2    12
     4    10     9     7
     8     6     5    11
     3    13    14     0

FreddyMusic

chungyuandye ,

方法不错，你的代码我看了，稍微改了改。

1. 
   
2. myrule1=x[i_,j_]:>ToExpression[ToString[x]<>If[i<=9,ToString[0]<>ToString[i],ToString[i]]<>If[j<=9,ToString[0]<>ToString[j],ToString[j]]];
   
3. y[i_]:=Total@Table[j*x[i,j],{j,0,15}]/.myrule1;
   
4. cond1=Flatten[{Thread[Flatten@{Total@Partition[Table[y[i],{i,0,15}],4],Total@Transpose@Partition[Table[y[i],{i,0,15}],4],y[0]+y[5]+y[10]+y[15],y[3]+y[6]+y[9]+y[12]}==Table[30,{10}]],Thread[Flatten@{Total@Table[x[i,j],{i,0,15},{j,0,15}],Total@Transpose@Table[x[i,j],{i,0,15},{j,0,15}]}==Table[1,{32}]]/.myrule1}];
   
5. var=Flatten@Table[Table[x[i,j],{j,0,15}],{i,0,15}]/.myrule1;
   
6. {b,m}=Normal[CoefficientArrays[cond1,var]];
   
7. ans=Quiet@LinearProgramming[Range[0,255],m,Table[{-b[[i]],0},{i,Length@b}],Table[0,{i,256}],Integers];
   
8. Grid@Partition[Partition[ans,16].Range[0,15],4]
   

复制代码

能否把所有的 Zero - Start Magic Square 都找出来 ？

FreddyMusic

我想了想，Zero - Start Magic Square 就是 One-Start Magic Square (Standard),
区别仅在于 每个数字都减去 1 ，而它们每行每列的和任然相等。

换言之，知道如何生成所有的Magic Square 那就可以生成 Zero - Start Magic Square ，
它们的方法是一样的。那么剩下的问题就是幻方 Magic Square 应该如何生成。

顶楼照片上积木从0开始，可能是玩具公司对经典数学游戏了解有限，想当然地从0开始了。
如果他们也能多懂点数学娱乐，我想他们也会选择从1 开始的。