六边形幻方

chyanog

如图所示， 填入1-19（不重不漏）的数字，使得图中所有连成直线的圆圈之和相等

KeyTo9_Fans

http://kyzx.dgjy.net/sx/Print.asp?ArticleID=32961 里面的图$12$，不是很清晰，将就着看吧～

2. 15 13 10
3. 14 8 4 12
4. 9 6 5 2 16
5. 11 1 7 19
6. 18 17 3

复制代码

hujunhua

在主贴的“相关贴子”列表中，左列第5条“本来想发个幻方的贴子的，……”， 其4#的跟贴中给出了上述六角形幻方。

其中还讨论了更大的六角形幻方的一个必要条件，被郭老板化简为(2n-1)|(n²+1). 这个条件可以进一步化简：

n²+1≡0（mod 2n-1）←→4n²+4≡0（mod 2n-1）←→(2n+1)(2n-1)+5≡0（mod 2n-1）←→5≡0（mod 2n-1）→n=1, 3

gxqcn

五阶亚当斯六角幻方，已被证明是唯一； 加之上面的推导，更是唯一中的唯一！（n=1情形没有实际价值）

hujunhua

19个变量，13个独立约束，可以得到一个6维的参数解： x_i=x_i（x₁,x₂,x₃,x₄,x₅,x₆）,（i=7~19） （x₁,x₂,x₃,x₄,x₅,x₆）,（i=7~19）取自6个无约束关系的格。 于是可以如下编程（穷举）： m=Range[19]={1,2,3,...,19} table=Subsets[m,{6}]（19个数取6个的排列表） 依次取table中的每个排列，赋予（x₁,x₂,x₃,x₄,x₅,x₆）来计算x_i（i=7~19），然后检查所得是否为Range[19]。 我的电脑运行不了这样的程序，因为表table的长度超过我安装的Mathematica9的机器数。 上述6参数解我以前曾得到过优化解，但没记录下来。

chyanog

5# hujunhua 我解出来的包含7个参数，

2. Block[{var = Table[Symbol["x" <> ToString@i], {i, 19}]},
3. Solve[{x1 + x2 + x3 == k,
4. x4 + x5 + x6 + x7 == k,
5. x8 + x9 + x10 + x11 + x12 == k,
6. x13 + x14 + x15 + x16 == k,
7. x17 + x18 + x19 == k,
9. x1 + x4 + x8 == k,
10. x2 + x5 + x9 + x13 == k,
11. x3 + x6 + x10 + x14 + x17 == k,
12. x7 + x11 + x15 + x18 == k,
13. x12 + x16 + x19 == k,
15. x3 + x7 + x12 == k,
16. x2 + x6 + x11 + x16 == k,
17. x1 + x5 + x10 + x15 + x19 == k,
18. x4 + x9 + x14 + x18 == k,
19. x8 + x13 + x17 == k,
20. Total[var] == (1/2 n (n + 1) /. n -> 19)
21. }, var~Join~{k}, Integers,
22. GeneratedParameters -> (Symbol@
23. FromCharacterCode[96 + #] &)]][[All, All, 2, 1]][[1]]

复制代码

hujunhua

你的k也是变量？

hujunhua

亚当斯的这个六角幻方确实让我很惊奇，所以以前研究幻方时也拆过它。我曾将填入数变成 {-9, -8, -7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9} 使幻方变成零和幻方。为了简化推导，我令中心数为0，对称于中心的格取相反数，结果很容易得到了 8 3 5 9 7 4 6 1 2 0 2 1 6 4 7 9 5 3 8 其中红色表负数。

hujunhua

但是我没有试过中心非零、不对称的解，我猜想应该不存在。 这种零和幻方的好处在于突破了3#的限制，可以编制更大的六角幻方。不过我并没有试图编排出来一个，也没估计过计算量，4阶应该还可以计算的。

hujunhua

与亚当斯的独生子不同，负对称零和幻方有多解（貌似共12个本原解）。 4 1 3 5 7 8 6 9 2 0 2 9 6 8 7 5 3 1 4