本帖最后由 王守恩 于 2019-5-12 18:37 编辑
wayne 发表于 2019-5-12 14:19
受到mathe的手工求解的启发。我也写了一个程序, 耗时的地方主要是整数的拆分，代码暂时不能上传，被论坛的 ...
谢谢wayne！ 可以改一下吗？改成这样：
六个顶点按从小到大排列：1号位是最小的，最小数的两边总有一个数是比较小的，摆2号位。或
六个顶点按从大到小排列：1号位是最大的，最大数的两边总有一个数是比较大的，摆2号位。
3,4,5,6号位随着1,2号位的方向走，这样就不存在 “逆(顺)时针”问题，答案就是唯一的了。
恩，稍微改改，六个顶点的最小数排在1号位，与之相邻的两个数中最小的排在2号位，最大的排在末位。
ans=Flatten],k,S-2MovingAverage],2],S-s[]-k};{S,s[],k},Union]},{k,Flatten],cc,c[]}],{c,Flatten[{First,#}]&/@Sort/@Subsets,{2}]},{cc,Permutations]}],1]}],{t,s[]}],{s,Table[{2i,Select/2-5i,{6}],Length]==6 &&Not@MemberQ[#,2i]&&Max[#]<20&]},{i,(6S-Binomial/2-Binomial)/5}]}],2],Length]==19&&Min]==1&][],{S,22,31}],1]
{22,4}
{23,2}
{24,6}
{25,6}
{26,4}
{27,11}
{28,5}
{29,8}
{31,8}
{32,5}
{33,11}
{34,4}
{35,6}
{36,6}
{37,2}
{38,4}
{22,2,{1,3,5,7,4,12}}
{22,2,{1,3,5,11,4,8}}
{22,2,{1,3,4,8,9,7}}
{22,4,{1,2,6,5,10,3}}
{23,6,{1,3,8,10,2,4}}
{23,6,{1,3,2,4,8,10}}
{24,2,{3,5,9,4,8,15}}
{24,4,{2,3,11,12,5,6}}
{24,4,{2,3,5,6,11,12}}
{24,6,{1,4,2,13,3,11}}
{24,6,{1,11,4,2,3,13}}
{24,8,{1,5,12,3,2,6}}
{25,2,{4,8,7,17,5,9}}
{25,2,{4,8,16,6,5,11}}
{25,4,{2,6,10,3,8,16}}
{25,4,{2,5,8,14,10,6}}
{25,8,{1,5,7,14,2,6}}
{25,8,{1,6,2,4,12,10}}
{26,4,{3,5,10,9,16,8}}
{26,8,{1,6,2,13,4,15}}
{26,8,{2,5,11,14,3,6}}
{26,8,{2,5,3,6,11,14}}
{27,2,{6,7,17,9,13,10}}
{27,6,{3,8,4,11,7,19}}
{27,6,{3,9,10,4,7,19}}
{27,6,{4,5,19,7,9,8}}
{27,8,{2,6,18,5,7,9}}
{27,8,{3,5,7,9,17,6}}
{27,8,{1,7,6,16,2,15}}
{27,8,{1,15,7,6,2,16}}
{27,8,{1,14,6,2,9,15}}
{27,14,{1,7,4,10,2,8}}
{27,14,{1,7,2,8,4,10}}
{28,4,{5,6,15,10,16,11}}
{28,4,{5,6,10,15,11,16}}
{28,8,{1,14,4,17,2,15}}
{28,8,{1,14,2,15,4,17}}
{28,10,{2,7,3,17,5,14}}
{29,2,{8,14,11,17,9,15}}
{29,2,{8,14,9,15,11,17}}
{29,4,{6,10,18,8,16,11}}
{29,10,{2,13,11,3,7,18}}
{29,10,{1,12,14,6,4,17}}
{29,12,{3,7,4,8,16,11}}
{29,16,{2,10,5,6,4,12}}
{29,16,{1,9,7,8,3,11}}
{31,4,{9,17,12,13,11,19}}
{31,4,{8,16,14,15,10,18}}
{31,8,{4,9,17,13,16,12}}
{31,10,{3,16,14,6,8,19}}
{31,10,{2,13,17,9,7,18}}
{31,16,{2,10,14,9,4,12}}
{31,18,{3,9,6,12,5,11}}
{31,18,{3,9,5,11,6,12}}
{32,10,{3,15,6,18,13,17}}
{32,12,{3,16,6,19,5,18}}
{32,12,{3,16,5,18,6,19}}
{32,16,{4,9,15,14,5,10}}
{32,16,{4,9,5,10,14,15}}
{33,6,{10,16,13,19,12,18}}
{33,6,{10,16,12,18,13,19}}
{33,12,{4,14,13,19,5,18}}
{33,12,{4,18,14,13,5,19}}
{33,12,{5,11,18,14,6,19}}
{33,12,{2,14,18,11,13,15}}
{33,12,{3,11,13,15,17,14}}
{33,14,{1,13,9,16,12,17}}
{33,14,{1,13,16,10,11,17}}
{33,14,{1,13,11,12,16,15}}
{33,18,{3,11,7,10,14,13}}
{34,12,{5,16,7,18,14,19}}
{34,12,{6,9,15,18,14,17}}
{34,12,{6,9,14,17,15,18}}
{34,16,{4,11,10,15,17,12}}
{35,12,{8,10,19,14,18,16}}
{35,12,{6,13,15,19,14,18}}
{35,16,{4,12,17,10,14,18}}
{35,16,{6,10,14,18,15,12}}
{35,18,{4,12,16,9,15,14}}
{35,18,{3,13,12,16,11,15}}
{36,12,{8,15,19,14,18,17}}
{36,14,{7,17,9,19,16,18}}
{36,14,{7,17,18,16,9,19}}
{36,16,{8,9,17,18,14,15}}
{36,16,{8,9,14,15,17,18}}
{36,18,{5,12,16,11,15,17}}
{37,14,{10,12,17,19,16,18}}
{37,14,{10,12,16,18,17,19}}
{38,16,{10,15,14,18,19,17}}
{38,18,{8,16,13,15,17,19}}
{38,18,{9,15,17,19,12,16}}
{38,18,{11,12,16,17,19,13}}
northwolves 发表于 2019-5-12 11:00
sum=有解
:lol大佬！这个比较漂亮！何种语言写的？
期待C或python写的代码
markfang2050 发表于 2019-5-12 18:35
期待C或python写的代码
:lol:lol
wayne 发表于 2019-5-12 18:04
恩，稍微改改，六个顶点的最小数排在1号位，与之相邻的两个数中最小的排在2号位，最大的排在末位。
能直接输出图吗？我想了很久。
如果两数之和等于20，就称为彼此的互补数。
显然，互补替换保持这种异形幻六方的等和性，只是定和（幻方数）有变化，前后幻方数之和等于60。
可见幻方数之和为60的幻方是一一对应的，故实际上只需要搜索幻方数在30以内的幻方。
恩恩，很有道理，反正程序就只需改一个数字，:lol，运算时间也只是线性的增加，计算结果刚好也确实是对称的，互相印证～
zeroieme 发表于 2019-5-12 19:16
能直接输出图吗？我想了很久。
先借用前面的代码，算出解
ans=Flatten],k,S-2MovingAverage],2],S-s[]-k};{S,s[],k},Union]},{k,Flatten],cc,c[]}],{c,Flatten[{First,#}]&/@Sort/@Subsets,{2}]},{cc,Permutations]}],1]}],{t,s[]}],{s,Table[{2i,Select/2-5i,{6}],Length]==6 &&Not@MemberQ[#,2i]&&Max[#]<20&]},{i,(6S-Binomial/2-Binomial)/5}]}],2],Length]==19&&Min]==1&][],{S,22,31}],1]
再画图：
Table]-a[]-b[],Mean[{a[],b[]}]}];
vtx=Table[{If],t[]],{Cos[(2Pi)/6 k],Sin[(2Pi)/6 k]}},{k,0,6}];
origin={t[],{0,0}};
others=Join}],Table,{m,Rest}]];
all=Join,others,{origin}];
Graphics[{Thickness,Magenta,Line]],Line/@(Partition]],4,1][]),Blue,PointSize[.1],Point]],Yellow,Text],FontSize->20],#[]]&/@all},ImageSize->500,PlotLabel->Style]],30,Red,Background->Yellow],Background->RGBColor["#eedddd"]],{t,ans}]
Table[mid =
Function[{a, b}, {t[] - a[] - b[],
Mean[{a[], b[]}]}];