手串上穿有六颗珠子，求各珠子上的数字。
本帖最后由 TSC999 于 2019-2-7 20:52 编辑上图表示一个穿有五颗珠子的手串。每颗珠子上刻着一个数字，它们从小到大依次是 1、2、3、5、10。
两颗相邻珠子上的数字之和是 4、6、7、12、13。
三颗相邻珠子上的数字之和是 8、9、14、15、17。
四颗相邻珠子上的数字之和是 11、16、18、19、20。
五颗珠子上的数字之和是 21。
以上五组数字从小到大排列起来，是：1、2、3、4、5、6、7、8、9、10、11、12、13、14、15、16、17、18、19、20、21。
从 1 到 21，不重复也不遗漏！
问题来了： 如果手串是由六颗珠子穿成的，每颗珠子上也都刻有数字（其中一颗上刻的是 1），并且满足上述特性，那么这些数字是什么？
它们在手串上是如何排列的？
对于六颗珠子的手串，本问题有解吗？
五颗珠子的情况是一道日本题目，由 ccmmjj 网友发布在【数学中国】网站，由 fungarwai 网友用 matlab 编程给出了正确解答。
我不知道对于六颗珠子的情况是否有解？（有解，并且有 5 个解）
另外，如何用 mathematica 编程呢？ 穷举还是比较容易的，六个数肯定包括1,2,如果这两数相邻，那么六个数里面没有3,但是肯定有4;反之6个数里还必须有3.再加上六个数和为31,余下种类已经不多了，计算机穷举吧 本帖最后由 TSC999 于 2019-2-8 20:01 编辑
我用 VB6 编程（穷举法），只考虑其中一颗珠子上是数字 1，不考虑别的。其余珠子上的数字假定是 x，y，z，u，v。
程序运行结果是：
k=1,x=2,y=5,z=4,u=6,v=13
k=1,x=2,y=7,z=4,u=12,v=5
k=1,x=3,y=2,z=7,u=8,v=10
k=1,x=3,y=6,z=2,u=5,v=14
k=1,x=5,y=12,z=4,u=7,v=2
k=1,x=7,y=3,z=2,u=4,v=14
k=1,x=10,y=8,z=7,u=2,v=3
k=1,x=13,y=6,z=4,u=5,v=2
k=1,x=14,y=4,z=2,u=3,v=7
k=1,x=14,y=5,z=2,u=6,v=3
【说明】程序给出了 10 个解答，但是其中 5 个是从手串背面观察的，手串翻转过来将与另 5 个解答相同。
因此真正的解答只有 5 组，见下图： 本帖最后由 TSC999 于 2019-2-8 19:59 编辑
VB6 写的程序如下：
' 一条手串由六颗珠子穿成。每颗珠子上刻有一个数字。数字总和为31。其中一个珠子上的数字是 1。各颗珠子上的数字集合记为{A1}={1，……}。
' 相邻两颗珠子上的数字和记为集合{A2}，相邻三颗珠子上的数字和记为集合{A3}，相邻四颗珠子上的数字和记为集合{A4}，
' 相邻五颗珠子上的数字和记为集合{A5}，全部六颗珠子上的数字和记为集合{A6}={31}。
' 若{A}={A1}+{A2}+{A3}+{A4}+{A5}+{A6}={1，2，3，4，5，…，30，31}，求每颗珠子上的数字是什么。
' 从刻有 1 的珠子开始逆时针向转一周，设各珠子上的数字是 1，x，y，z，u，v，那么 v=31-1-x-y-z-u。
' {x}、{y}、{z}、{u}、{v}都应小于{2，3，4，…，25}。
' 用穷举法寻求 x、y、z、u、v 的值。
Private Sub form_Click()
Open "六颗珠子 1.txt" For Output As #1
Dim a(31) '{A}={A1}+{A2}+{A3}+{A4}+{A5}+{A6}={1，2，3，4，5，…，30，31} 集合的元素个数
n = 31
For x = 2 To 25 ' 25 估计得肯定大了，但为了防止漏掉解，取得大些保险。虽然运行时间多了一点，不影响结果。
For y = 2 To 25
For z = 2 To 25
For u = 2 To 25
v = 30 - x - y - z - u
a(1) = 1: a(2) = x: a(3) = y: a(4) = z: a(5) = u: a(6) = v
a(7) = 1 + x: a(8) = x + y: a(9) = y + z: a(10) = z + u: a(11) = u + v: a(12) = v + 1
a(13) = 1 + x + y: a(14) = x + y + z: a(15) = y + z + u: a(16) = z + u + v: a(17) = u + v + 1: a(18) = v + 1 + x
a(19) = 1 + x + y + z: a(20) = x + y + z + u: a(21) = y + z + u + v: a(22) = z + u + v + 1: a(23) = u + v + 1 + x: a(24) = v + 1 + x + y
a(25) = 31 - 1: a(26) = 31 - x: a(27) = 31 - y: a(28) = 31 - z: a(29) = 31 - u: a(30) = 31 - v
a(31) = 31
For i = 1 To n - 1 '从小到大排序
Min = i
For j = i + 1 To n
If a(j) < a(Min) Then Min = j
Next j
t = a(i)
a(i) = a(Min)
a(Min) = t
Next i '排序结束
For i = 1 To n - 1'从小到大的排序结果中去掉有相同数字的
If a(i) <= 0 Then GoTo 111 ' 由于前面循环次数多了，会出现零和负数情况。将其去掉不用。
If a(i) = a(i + 1) Then GoTo 111 ' 两数相同，不符合要求，去掉。
Next i
If a(31) = a(1) Then GoTo 111 ' 首、末数相同的，去掉。
' 以下输出符合要求的解答
Print "k="; Trim(Str(1)); ",x="; Trim(Str(x)); ",y="; Trim(Str(y)); ",z="; Trim(Str(z)); ",u="; Trim(Str(u)); ",v="; Trim(Str(v))
Print #1, "k="; Trim(Str(1)); ",x="; Trim(Str(x)); ",y="; Trim(Str(y)); ",z="; Trim(Str(z)); ",u="; Trim(Str(u)); ",v="; Trim(Str(v))
111: Next u
Next z
Next y
Next x
Close
End Sub
程序运行时间约 9 秒。 用手串的n个珠子上的数字最多表示连续 的数字个数为n（n-1）+1个，大于此值时无解，小于此值时有解。 期待用 mathematica 编写的程序。 确实只有五组解，锁定第一个数$1$,以及必定含有一个数字$2$,这样穷举的就少多了。继续考虑$n$个数之和是$n(n-1)+1$，quick and dirty，$n=6$运行不到1秒钟
{{3,4,7,14},{{7,3,2,4,14},{14,4,2,3,7}}}
{{3,5,6,14},{{3,6,2,5,14},{14,5,2,6,3}}}
{{3,7,8,10},{{3,2,7,8,10},{10,8,7,2,3}}}
{{4,5,6,13},{{2,5,4,6,13},{13,6,4,5,2}}}
{{4,5,7,12},{{2,7,4,12,5},{5,12,4,7,2}}}
n = 6;
arr = a /@ Range;
target = Flatten[{Total,Table[]], {i, 0, n - 1}, {k, 1, n - 1}]}];
data = Select,Length] == n - 2 && Min[#] > 2 &];
Select], Length]]]]] == 1 &]}, {d, data}], Length[#[]] > 0 &] 最后一步改成 Reap/Sow +Do过程式的风格，可以省去最后还要Select整个表格的时间,以及内存占用。
n = 6;
arr = a /@ Range;
target = Flatten[{Total, Table[]], {i, 0, n - 1}, {k, 1, n - 1}]}];
data = Subsets + 2, {n - 2}];
Reap], Length]]]]] ==1 &]; If > 0, Sow], {d, data}]]]
再稍微改改，显示计算的进度
n=6;
arr=a/@Range;
target=Flatten[{Total,Table[]],{i,0,n-1},{k,1,n-1}]}];
data=Subsets+2,{n-2}];
Monitor]]],Length]]]]]==1&];If>0,Sow],{i,Length}]]],{i,Length}]
真正节省时间的做法 应该是 在过程式 枚举计算的时候 发现有重复元素的时候就 该跳过所有这种case。只是 那样就会有更多的控制逻辑，代码的可读性也差了，略了。
n = 7 时无解！