数学研发论坛

 找回密码
 欢迎注册
楼主: markfang2050

[原创] 六边形上19个黑点上不同数字求所有的解!

[复制链接]
发表于 2019-5-12 20:37:30 | 显示全部楼层
恩恩,很有道理,反正程序就只需改一个数字,,运算时间也只是线性的增加,计算结果刚好也确实是对称的,互相印证~
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2019-5-12 21:37:35 | 显示全部楼层
zeroieme 发表于 2019-5-12 19:16
能直接输出图吗?我想了很久。

先借用前面的代码,算出解
  1. ans=Flatten[Table[Select[Flatten[Table[Table[Table[{tmp={s[[1]],k,S-2MovingAverage[PadRight[k,7,First[k]],2],S-s[[1]]-k};{S,s[[1]],k},Union[Flatten[tmp]]},{k,Flatten[Table[Flatten[{c[[1;;2]],cc,c[[3]]}],{c,Flatten[{First[t],#}]&/@Sort/@Subsets[Rest[t],{2}]},{cc,Permutations[Complement[t,c]]}],1]}],{t,s[[2]]}],{s,Table[{2i,Select[Sort/@IntegerPartitions[6S-Binomial[20,2]/2-5i,{6}],Length[Union[#]]==6 &&Not@MemberQ[#,2i]&&Max[#]<20&]},{i,(6S-Binomial[20,2]/2-Binomial[7,2])/5}]}],2],Length[Last[#]]==19&&Min[Last[#]]==1&][[All,1]],{S,22,31}],1]
复制代码


再画图:
  1. Table[mid=Function[{a,b},{t[[1]]-a[[1]]-b[[1]],Mean[{a[[2]],b[[2]]}]}];
  2. vtx=Table[{If[k==0,t[[3,-1]],t[[3,k]]],{Cos[(2Pi)/6 k],Sin[(2Pi)/6 k]}},{k,0,6}];
  3. origin={t[[2]],{0,0}};
  4. others=Join[Table[mid@@m,{m,Partition[vtx,2,1]}],Table[mid[origin,m],{m,Rest[vtx]}]];
  5. all=Join[Rest[vtx],others,{origin}];
  6. Graphics[{Thickness[0.01],Magenta,Line[vtx[[All,2]]],Line/@(Partition[Rest[vtx[[All,2]]],4,1][[All,{1,4}]]),Blue,PointSize[.1],Point[all[[All,2]]],Yellow,Text[Style[#[[1]],FontSize->20],#[[2]]]&/@all},ImageSize->500,PlotLabel->Style[Framed[t[[1]]],30,Red,Background->Yellow],Background->RGBColor["#eedddd"]],{t,ans}]
复制代码


Screenshot from 2019-05-12 21-41-46.png

点评

谢,已经绘图成功  发表于 2019-5-13 16:39
把MidPoint改成Mean就行,其他都不用动  发表于 2019-5-13 14:45
太美了,教科书般的解答,可惜我使用 Mathematica 11, 请给出 Midpoint 函数 的定义  发表于 2019-5-13 14:05
图看起来不错!  发表于 2019-5-13 11:46

评分

参与人数 2威望 +10 金币 +10 贡献 +10 经验 +10 鲜花 +10 收起 理由
northwolves + 6 + 6 + 6 + 6 + 6 赞一个!
zeroieme + 4 + 4 + 4 + 4 + 4 很给力!

查看全部评分

毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2019-5-12 23:18:53 | 显示全部楼层
Table[mid =
   Function[{a, b}, {t[[1]] - a[[1]] - b[[1]],
     Mean[{a[[2]], b[[2]]}]}];

点评

Midpoint是 Mathematica 12引入的新函数  发表于 2019-5-13 08:12
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2019-5-12 23:19:34 | 显示全部楼层
Table[mid =
   Function[{a, b}, {t[[1]] - a[[1]] - b[[1]],
     Median[{a[[2]], b[[2]]}]}];
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2019-5-13 12:00:42 | 显示全部楼层
Visual C++求解和为20-100的所有解,39-100无解, 微信图片_20190513115807.png 耗时980ms.
微信图片_20190513115757.png
微信图片_20190513115813.png
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2019-5-13 12:13:13 | 显示全部楼层
解的过程

C19.rar

93.78 KB, 下载次数: 2, 下载积分: 金币 -1 枚, 经验 1 点, 下载 1 次

售价: 1 枚金币  [记录]

毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
回复

使用道具 举报

发表于 2019-5-13 13:35:54 | 显示全部楼层
4, 2, 6, 6, 4, 11, 5, 8, 0
我对于和为30的无解表示十分不解,也许存在一个简明的人肉证明。

点评

期待你的妙手解答  发表于 2019-5-13 13:54
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2019-5-13 13:58:01 | 显示全部楼层
hujunhua 发表于 2019-5-13 13:35
4, 2, 6, 6, 4, 11, 5, 8, 0
我对于和为30的无解表示十分不解,也许存在一个简明的人肉证明。

期待大佬证明
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2019-5-13 15:54:00 | 显示全部楼层
hujunhua 发表于 2019-5-13 13:35
4, 2, 6, 6, 4, 11, 5, 8, 0
我对于和为30的无解表示十分不解,也许存在一个简明的人肉证明。

我先说一说,和为 “30” 基本资料。
1个中心数   18,  16,  14,  12,  10,  08,  06,  04,  02,
6个周边角   40,  45,  50,  55,  60,  65,  70,  75,  80,
6个内圈数   32,  39,  46,  53,  60,  67,  74,  81,  88,
6个外圈数 100,  90,  80,  70,  60,  50,  40,  30,  20,
中心数有9种可能,考虑互补,去掉4种,还有5种可能,
观察外圈数:6个数的和不可能是100(20),还有4种可能。
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2019-5-13 16:12:32 | 显示全部楼层
王守恩 发表于 2019-5-13 15:54
我先说一说,和为 “30” 基本资料。
1个中心数   18,  16,  14,  12,  10,  08,  06,  04,  02,
6个周 ...

恩嗯啊,你就不能留个QQ号吗?数学编程交流QQ群:204338349

点评

我是您的吹鼓手!您还不满意?  发表于 2019-5-13 17:15
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
您需要登录后才可以回帖 登录 | 欢迎注册

本版积分规则

小黑屋|手机版|数学研发网 ( 苏ICP备07505100号 )

GMT+8, 2019-5-25 09:14 , Processed in 0.081586 second(s), 25 queries .

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表