手串上穿有六颗珠子，求各珠子上的数字。

TSC999

上图表示一个穿有五颗珠子的手串。每颗珠子上刻着一个数字，它们从小到大依次是 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），并且满足上述特性，那么这些数字是什么？
它们在手串上是如何排列的？

对于六颗珠子的手串，本问题有解吗？

TSC999

五颗珠子的情况是一道日本题目，由 ccmmjj 网友发布在【数学中国】网站，由 fungarwai 网友用 matlab 编程给出了正确解答。
我不知道对于六颗珠子的情况是否有解？（有解，并且有 5 个解）
另外，如何用 mathematica 编程呢？

mathe

穷举还是比较容易的，六个数肯定包括1,2,如果这两数相邻，那么六个数里面没有3,但是肯定有4;反之6个数里还必须有3.再加上六个数和为31,余下种类已经不多了，计算机穷举吧

TSC999

我用 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

VB6 写的程序如下：

1. 
   
2.      ' 一条手串由六颗珠子穿成。每颗珠子上刻有一个数字。数字总和为31。其中一个珠子上的数字是 1。各颗珠子上的数字集合记为{A1}={1，……}。
   
3.      ' 相邻两颗珠子上的数字和记为集合{A2}，相邻三颗珠子上的数字和记为集合{A3}，相邻四颗珠子上的数字和记为集合{A4}，
   
4.      ' 相邻五颗珠子上的数字和记为集合{A5}，全部六颗珠子上的数字和记为集合{A6}={31}。
   
5.      ' 若{A}={A1}+{A2}+{A3}+{A4}+{A5}+{A6}={1，2，3，4，5，…，30，31}，求每颗珠子上的数字是什么。
   
6.      ' 从刻有 1 的珠子开始逆时针向转一周，设各珠子上的数字是 1，x，y，z，u，v，那么 v=31-1-x-y-z-u。
   
7.      ' {x}、{y}、{z}、{u}、{v}都应小于{2，3，4，…，25}。
   
8.      ' 用穷举法寻求 x、y、z、u、v 的值。
   
9.      
   
10.      Private Sub form_Click()
    
11.      Open "六颗珠子 1.txt" For Output As #1
    
12.      
    
13.      Dim a(31)   '{A}={A1}+{A2}+{A3}+{A4}+{A5}+{A6}={1，2，3，4，5，…，30，31} 集合的元素个数
    
14.      n = 31
    
15.      For x = 2 To 25    ' 25 估计得肯定大了，但为了防止漏掉解，取得大些保险。虽然运行时间多了一点，不影响结果。
    
16.       For y = 2 To 25
    
17.        For z = 2 To 25
    
18.         For u = 2 To 25
    
19.         v = 30 - x - y - z - u
    
20.         a(1) = 1: a(2) = x: a(3) = y: a(4) = z: a(5) = u: a(6) = v
    
21.         a(7) = 1 + x: a(8) = x + y: a(9) = y + z: a(10) = z + u: a(11) = u + v: a(12) = v + 1
    
22.         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
    
23.         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
    
24.         a(25) = 31 - 1: a(26) = 31 - x: a(27) = 31 - y: a(28) = 31 - z: a(29) = 31 - u: a(30) = 31 - v
    
25.         a(31) = 31
    
26.      For i = 1 To n - 1   '从小到大排序
    
27.           Min = i
    
28.         For j = i + 1 To n
    
29.          If a(j) < a(Min) Then Min = j
    
30.         Next j
    
31.         t = a(i)
    
32.        a(i) = a(Min)
    
33.        a(Min) = t
    
34.      Next i               '排序结束
    
35.      
    
36.      For i = 1 To n - 1  '从小到大的排序结果中去掉有相同数字的
    
37.        If a(i) <= 0 Then GoTo 111      ' 由于前面循环次数多了，会出现零和负数情况。将其去掉不用。
    
38.        If a(i) = a(i + 1) Then GoTo 111    ' 两数相同，不符合要求，去掉。
    
39.      Next i
    
40.        If a(31) = a(1) Then GoTo 111     ' 首、末数相同的，去掉。
    
41.     ' 以下输出符合要求的解答     
    
42.      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))
    
43.      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))
    
44.      
    
45. 111: Next u
    
46.      Next z
    
47.      Next y
    
48.      Next x
    
49.    
    
50.       Close
    
51.       End Sub   
    

复制代码

程序运行时间约 9 秒。

白新岭

用手串的n个珠子上的数字最多表示连续 的数字个数为n（n-1）+1个，大于此值时无解，小于此值时有解。

TSC999

期待用 mathematica 编写的程序。

wayne

确实只有五组解，锁定第一个数$1$,以及必定含有一个数字$2$,这样穷举的就少多了。继续考虑$n$个数之和是$n(n-1)+1$，quick and dirty，$n=6$运行不到1秒钟

1. {{3,4,7,14},{{7,3,2,4,14},{14,4,2,3,7}}}
   
2. {{3,5,6,14},{{3,6,2,5,14},{14,5,2,6,3}}}
   
3. {{3,7,8,10},{{3,2,7,8,10},{10,8,7,2,3}}}
   
4. {{4,5,6,13},{{2,5,4,6,13},{13,6,4,5,2}}}
   
5. {{4,5,7,12},{{2,7,4,12,5},{5,12,4,7,2}}}
   

复制代码

1. n = 6;
   
2. arr = a /@ Range[n];
   
3. target = Flatten[{Total[arr],  Table[Total[RotateLeft[arr, i][[1 ;; k]]], {i, 0, n - 1}, {k, 1, n - 1}]}];
   
4. data = Select[IntegerPartitions[(-1 + n) n - 2, {n - 2}],  Length[Union[#]] == n - 2 && Min[#] > 2 &];
   
5. Select[Table[{d, Select[Permutations[Join[{2}, d]], Length[Tally[ Differences[Sort[target /. Thread[arr -> Join[{1}, #]]]]]] == 1 &]}, {d, data}], Length[#[[2]]] > 0 &]

复制代码

wayne

最后一步改成 Reap/Sow +Do过程式的风格，可以省去最后还要Select整个表格的时间,以及内存占用。

1. n = 6;
   
2. arr = a /@ Range[n];
   
3. target = Flatten[{Total[arr], Table[Total[RotateLeft[arr, i][[1 ;; k]]], {i, 0, n - 1}, {k, 1, n - 1}]}];
   
4. data = Subsets[Range[n (n - 1)] + 2, {n - 2}];
   
5. Reap[Timing[Do[tmp = Select[Permutations[Join[{2}, d]], Length[Tally[ Differences[Sort[target /. Thread[arr -> Join[{1}, #]]]]]] ==  1 &]; If[Length[tmp] > 0, Sow[tmp]], {d, data}]]]

复制代码

再稍微改改，显示计算的进度

1. n=6;
   
2. arr=a/@Range[n];
   
3. target=Flatten[{Total[arr],Table[Total[RotateLeft[arr,i][[1;;k]]],{i,0,n-1},{k,1,n-1}]}];
   
4. data=Subsets[Range[n (n-1)]+2,{n-2}];
   
5. Monitor[Reap[Timing[Do[tmp=Select[Permutations[Join[{2},data[[i]]]],Length[Tally[Differences[Sort[target/.Thread[arr->Join[{1},#]]]]]]==1&];If[Length[tmp]>0,Sow[tmp]],{i,Length[data]}]]],{i,Length[data]}]

复制代码

真正节省时间的做法 应该是 在过程式 枚举计算的时候 发现有重复元素的时候就 该跳过所有这种case。只是 那样就会有更多的控制逻辑，代码的可读性也差了，略了。

TSC999

n = 7 时无解！