一道二年级数学：填数字

aoe1981

　　题目如下：
　　

　　我的目的：想知道一共有多少种结果？并将问题一般化。

　　目前完成状态：可填数字为等间距连续数字的假定未变；使用递归完成了编程，可得到初步正确的结果，该题得出24个结果，未进行去重处理，算是完成了一半；更一般地情况没有充分测试，不排除潜在错误。

　　结果如下：

100-500-600-400-200-700-300-800
100-600-500-400-300-700-200-900
100-800-300-500-400-600-200-900
100-800-300-700-200-400-600-500
100-900-200-600-400-500-300-800
100-900-200-700-300-400-500-600
200-400-600-500-100-800-300-700
200-600-400-500-300-800-100-900
200-700-300-400-500-600-100-900
200-700-300-800-100-500-600-400
200-900-100-600-500-400-300-700
200-900-100-800-300-500-400-600
300-400-500-600-100-900-200-700
300-500-400-600-200-900-100-800
300-700-200-400-600-500-100-800
300-700-200-900-100-600-500-400
300-800-100-500-600-400-200-700
300-800-100-900-200-600-400-500
400-500-300-800-100-900-200-600
400-600-200-900-100-800-300-500
500-400-300-700-200-900-100-600
500-600-100-900-200-700-300-400
600-400-200-700-300-800-100-500
600-500-100-800-300-700-200-400

　　结果说明：从左上角开始，逆时针旋转一周。

　　附件如下：
　　 填数字.zip (159 KB, 下载次数: 6)

2018-6-4 23:26 上传

点击文件名下载附件

　　包含去重代码的附件已完成：
　　 填数字（增加了去重代码）.zip (120.88 KB, 下载次数: 34)

2018-6-6 11:36 上传

点击文件名下载附件

　　（这是建议下载版本）
　　附件内容如下图：

　　

　　现在算是初步完工了吧。有功夫了研究下各位大侠的代码和思路。

aoe1981

　　程序的初始参数如下：

边数：	4
每边位置数：	3
最小数字：	100
数字递增间隔：	100
每边数字和：	1200
输出结果数：	1000
共有结果数：	24

　　代码如下：

1. Option Explicit
   
2. Dim n&, m&, x_min&, x_jj&, x_sum&
   
3. Dim x_max&, x_pd&, m_sum&, m_sum1&, sz&(), bj() As Boolean, jg&(), jg_ys&(), js&, scjg$(), scjs&
   
4. Public Sub ShuZi()
   
5.     Dim i&, j&, t#
   
6.     t = Timer
   
7.     scjs = Range("b7").Value
   
8.     ReDim scjg(1 To scjs, 1 To 1)
   
9.     Range("h:h").ClearContents
   
10.     n = Range("b1").Value '边数
    
11.     m = Range("b2").Value '每边位置数
    
12.     x_min = Range("b3").Value '最小数字
    
13.     x_jj = Range("b4").Value '数字递增间隔
    
14.     x_sum = Range("b5").Value '每边数字和
    
15.     x_max = x_sum - x_min * (m - 1) - x_jj * (m - 2) '最大数字
    
16.     m_sum = (m - 1) * n '位置总个数
    
17.     x_pd = x_min + x_jj * (m_sum - 1) '最大数字临界值
    
18.     If x_max < x_pd Then MsgBox "最大可填数字：" & x_max & "小于最大数字临界值：" & x_pd & "，请修正初始数据。": End
    
19.     m_sum1 = (x_max - x_min) / x_jj + 1 '可填数字个数
    
20.     ReDim sz&(1 To m_sum1)
    
21.     ReDim bj(1 To m_sum1) As Boolean
    
22.     ReDim jg&(1 To m_sum)
    
23.     ReDim jg_ys&(1 To m_sum)
    
24.     j = 0
    
25.     For i = x_min To x_max Step x_jj '装入可填数字
    
26.         j = j + 1
    
27.         sz(j) = i
    
28.     Next i
    
29.     jg_ys(1) = 0
    
30.     For i = 2 To m_sum '装入结果的控制余数
    
31.         jg_ys(i) = (i - 2) Mod (m - 1) + 1
    
32.     Next i
    
33.     js = 0
    
34.     Call DG(1)
    
35.     Range("h1").Resize(IIf(js < scjs, js, scjs), 1).Value = scjg
    
36.     Range("b8").Value = js
    
37.     MsgBox "用时：" & Timer - t & "秒，共找到：" & js & "个结果（未检测重复结果）。"
    
38.     End '释放模块变量，防止重复记录
    
39. End Sub
    
40. Sub DG(k&)
    
41.     Dim i&, j&, x_xz&
    
42.     If k = m_sum Then '当填最后一个空位时
    
43.         For j = 1 To jg_ys(k)
    
44.             x_xz = x_xz + jg(k - j)
    
45.         Next j
    
46.         x_xz = x_sum - x_xz - jg(1) '最后空位限制值
    
47.         For i = 1 To m_sum1
    
48.             If bj(i) = False Then
    
49.                 If sz(i) = x_xz Then
    
50.                     jg(k) = sz(i) '填入未用数字
    
51.                     js = js + 1 '累计结果数
    
52.                     If js <= scjs Then
    
53.                         For j = 1 To k
    
54.                             scjg(js, 1) = scjg(js, 1) & "-" & jg(j)
    
55.                         Next j
    
56.                         scjg(js, 1) = Mid(scjg(js, 1), 2)
    
57.                     End If
    
58.                 End If
    
59.             End If
    
60.         Next i
    
61.     Else
    
62.         For j = 1 To jg_ys(k)
    
63.             x_xz = x_xz + jg(k - j)
    
64.         Next j
    
65.         If m_sum - k < m - 2 Then '当填最后一边中间空位时
    
66.             x_xz = x_sum - x_xz - jg(1) '最后一边中间空位限制值
    
67.         Else
    
68.             x_xz = x_sum - x_xz '当前空位限制值
    
69.         End If
    
70.         For i = 1 To m_sum1
    
71.             If bj(i) = False Then '填入未用数字
    
72.                 If jg_ys(k) = m - 1 Then '当填入每边最后一个位置时
    
73.                     If sz(i) = x_xz Then
    
74.                         jg(k) = sz(i)
    
75.                         bj(i) = True '标记为已用
    
76.                         Call DG(k + 1) '向下填充
    
77.                         bj(i) = False '本层向下遍历时，恢复本层上一数据为未用
    
78.                     End If
    
79.                 Else
    
80.                     If sz(i) < x_xz Then
    
81.                         jg(k) = sz(i)
    
82.                         bj(i) = True '标记为已用
    
83.                         Call DG(k + 1) '向下填充
    
84.                         bj(i) = False '本层向下遍历时，恢复本层上一数据为未用
    
85.                     End If
    
86.                 End If
    
87.             End If
    
88.         Next i
    
89.     End If
    
90. End Sub

复制代码

　　递归部分自我感觉写得很是啰嗦……

　　过些日子再思考下去重的问题……

Moneky

无脑算法来一个啊

1. Sub 来一个试试()
   
2.     Dim cn As Collection, cnn As Long, _
   
3.         i As Long, nrr(7) As Long, _
   
4.         ret As Long, isShow As Boolean, _
   
5.         isExit As Boolean
   
6.     ret = 1200
   
7.     isShow = False
   
8.     isExit = False
   
9.     Randomize
   
10.    
    
11.     Do Until isExit
    
12.         Set cn = New Collection
    
13.         For i = 1 To 9
    
14.             cn.Add i * 100, CStr(i * 100)
    
15.         Next
    
16.         
    
17.         For i = 0 To 7
    
18.             cnn = Int(Rnd * (9 - i) + 1)
    
19.             nrr(i) = cn(cnn)
    
20.             cn.Remove cnn
    
21.         Next
    
22.         If isShow Then ShowRR nrr
    
23.         DoEvents
    
24.         If nrr(0) + nrr(1) + nrr(2) = ret Then
    
25.             If nrr(2) + nrr(3) + nrr(4) = ret Then
    
26.                 If nrr(4) + nrr(5) + nrr(6) = ret Then
    
27.                     If nrr(6) + nrr(7) + nrr(0) = ret Then
    
28.                         ShowRR nrr
    
29.                         MsgBox "历尽千辛万苦终于找到一个！", vbInformation + vbOKOnly, "Eersoft-提示"
    
30.                         
    
31.                         isExit = True
    
32.                     End If
    
33.                 End If
    
34.             End If
    
35.         End If
    
36.     Loop
    
37. End Sub
    
38. Sub ShowRR(nrr() As Long)
    
39.     With Worksheets("Sheet1")
    
40.         .Cells(2, 2) = nrr(0)
    
41.         .Cells(2, 5) = nrr(1)
    
42.         .Cells(2, 8) = nrr(2)
    
43.         .Cells(5, 2) = nrr(7)
    
44.         .Cells(5, 8) = nrr(3)
    
45.         .Cells(8, 2) = nrr(6)
    
46.         .Cells(8, 5) = nrr(5)
    
47.         .Cells(8, 8) = nrr(4)
    
48.     End With
    
49. End Sub
    

复制代码

Moneky

1. Sub O0OOO_()
   
2.     Dim llll1 As Collection, lllll As Long, O0 As Long, lll11(7) As Long, lll1l As Long, ll11l As Boolean, ll111 As Boolean
   
3.     lll1l = 1200: ll11l = False: ll111 = False: Randomize: Do Until ll111: Set llll1 = New Collection: For O0 = OOO_0OO("000O") To OOO_0OO("O00O"): llll1.Add O0 * 100, CStr(O0 * 100): Next: For O0 = OOO_0OO("0000") To OOO_0OO("0OOO"): lllll = Int(Rnd * (OOO_0OO("O00O") - O0) + OOO_0OO("000O")): lll11(O0) = llll1(lllll): llll1.Remove lllll: Next
   
4.         If ll11l Then l1l1l lll11
   
5.         DoEvents
   
6.         If lll11(OOO_0OO("0000")) + lll11(OOO_0OO("000O")) + lll11(OOO_0OO("00O0")) = lll1l Then
   
7.             If lll11(OOO_0OO("00O0")) + lll11(OOO_0OO("00OO")) + lll11(OOO_0OO("0O00")) = lll1l Then
   
8.                 If lll11(OOO_0OO("0O00")) + lll11(OOO_0OO("0O0O")) + lll11(OOO_0OO("0OO0")) = lll1l Then
   
9.                     If lll11(OOO_0OO("0OO0")) + lll11(OOO_0OO("0OOO")) + lll11(OOO_0OO("0000")) = lll1l Then
   
10.                         l1l1l lll11
    
11.                         MsgBox O0O_0OO("O0000OO00O0O00OO00OOOO0O0O0OOO000O0000OO0O0O00OOO00OO0OOO000OOOO00000OOO0O00OOO0OOO00OO0O00000O0OO00O0000OOOOOO0O000OOO00O00OOO00OOOOOO00OO000O000OO00000O0O00O0O0000OO00O00OOO00000000OOOOOOOOO"), vbInformation + vbOKOnly, "Eersoft-提示"
    
12.                         ll111 = True
    
13.                     End If
    
14.                 End If
    
15.             End If
    
16.         End If
    
17.     Loop
    
18. End Sub
    
19. Sub l1l1l(lll11() As Long)
    
20.     With Worksheets("Sheet1")
    
21.         .Cells(OOO_0OO("00O0"), OOO_0OO("00O0")) = lll11(OOO_0OO("0000"))
    
22.         .Cells(OOO_0OO("00O0"), OOO_0OO("0O0O")) = lll11(OOO_0OO("000O"))
    
23.         .Cells(OOO_0OO("00O0"), OOO_0OO("O000")) = lll11(OOO_0OO("00O0"))
    
24.         .Cells(OOO_0OO("0O0O"), OOO_0OO("00O0")) = lll11(OOO_0OO("0OOO"))
    
25.         .Cells(OOO_0OO("0O0O"), OOO_0OO("O000")) = lll11(OOO_0OO("00OO"))
    
26.         .Cells(OOO_0OO("O000"), OOO_0OO("00O0")) = lll11(OOO_0OO("0OO0"))
    
27.         .Cells(OOO_0OO("O000"), OOO_0OO("0O0O")) = lll11(OOO_0OO("0O0O"))
    
28.         .Cells(OOO_0OO("O000"), OOO_0OO("O000")) = lll11(OOO_0OO("0O00"))
    
29.     End With
    
30. End Sub
    
31. Function O0O_0OO(S As String) As String
    
32.     Dim O0O0_OO() As Byte
    
33.     For O0_O0 = OOO_0OO("000O") To Len(S) Step OOO_0OO("0O00")
    
34.         O_0O0OO = Mid(S, O0_O0, OOO_0OO("0O00"))
    
35.         O_O0 = Hex(IIf(Mid(O_0O0OO, OOO_0OO("000O"), OOO_0OO("000O")) = "O", OOO_0OO("000O"), OOO_0OO("0000")) * OOO_0OO("O000") + IIf(Mid(O_0O0OO, OOO_0OO("00O0"), OOO_0OO("000O")) = "O", OOO_0OO("000O"), OOO_0OO("0000")) * OOO_0OO("0O00") + IIf(Mid(O_0O0OO, OOO_0OO("00OO"), OOO_0OO("000O")) = "O", OOO_0OO("000O"), OOO_0OO("0000")) * OOO_0OO("00O0") + IIf(Mid(O_0O0OO, OOO_0OO("0O00"), OOO_0OO("000O")) = "O", OOO_0OO("000O"), OOO_0OO("0000")))
    
36.         O_O = O_O & O_O0
    
37.     Next
    
38.     ReDim O0O0_OO(OOO_0OO("000O") To Len(O_O) / OOO_0OO("00O0"))
    
39.     For O0_O0 = OOO_0OO("000O") To UBound(O0O0_OO)
    
40.         O0O0_OO(O0_O0) = "&h" & Mid(O_O, (O0_O0 - OOO_0OO("000O")) * OOO_0OO("00O0") + OOO_0OO("000O"), OOO_0OO("00O0"))
    
41.     Next
    
42.     O0O_0OO = O0O0_OO
    
43. End Function
    
44. Function OOO_0OO(S As String) As Long
    
45.     OOO_0OO = IIf(Mid(S, Len("X"), Len("0")) = "O", Len("O"), &HF Mod &H5) * (&HF Mod &H7 + &H7) + IIf(Mid(S, Len("O0"), Len("X")) = "O", Len("X"), &HE Mod &H7) * (&HF Mod &HB) + IIf(Mid(S, &HE / &H7 + Len("X"), &HF Mod &H2) = "O", &H1, 0) * (&HE Mod &H3) + IIf(Mid(S, &HF Mod &HB, Len("HELLO") Mod Len("PASS")) = "O", &H1, False)
    
46. End Function
    

复制代码

一把小刀闯天下

'参与一下。拿随机数凑了一下，3s能凑出24组，镜像、旋转的未去除。

Option Explicit

Sub test()
  Dim i As Long, t As Long, n As Long, dic, dt, s As String
  ReDim arr(1 To 9) As Long
  dt = Timer
  Set dic = CreateObject("scripting.dictionary")
  For i = 1 To 9: arr(i) = i: Next
  Do
    Randomize
    For i = 1 To 9
      n = Int(Rnd * 9) + 1: t = arr(i): arr(i) = arr(n): arr(n) = t
    Next
    If arr(1) + arr(2) + arr(3) = 12 And arr(3) + arr(4) + arr(5) = 12 And _
      arr(5) + arr(6) + arr(7) = 12 And arr(7) + arr(8) + arr(1) = 12 Then
      s = vbNullString
      For i = 1 To 8: s = s & arr(i) & "-": Next
      If Not dic.exists(s) Then dic(s) = vbNullString
      If Timer - dt >= 3 Then
        Debug.Print "组：" & dic.Count
        Debug.Print Join(dic.keys, vbNewLine)
        Exit Do
      End If
    End If
  Loop
End Sub

zopey

先把12 拆成3个数的组合{a,b,c}
    a+b+c =12
     a<b<c

取其中 2个组合 ，{a1,b1,c1} {a2,b2,c2} 6个整数 互不相同
   等价于 两条平行线的六个点

计算 剩余的 2个数

lipton

Moneky 发表于 2018-6-5 04:18

增加难度小写L+ 数字1 混编作为变量名,函数名.

grf1973

用python做了一下，去重及旋转后共15组，不知是否齐全了

1. #考虑四个角数字a,b,c,d，显然max(a,b,c,d)<=7(如果某个数字是8的话，那么它所在的两边另两数和为4，只有1+3和2+2两种可能，显然2+2不符合题意)
   
2. #考虑去重及旋转，abcd只有三种排序方式是不相重的：abcd,abdc,acbd（即对角两数分别是ab,ac,ad三种情况）
   
3. import itertools
   
4. for x in itertools.combinations(range(1,8),4):          #1--7取4数组合
   
5.         for (a,b,c,d) in [(x[0],x[1],x[2],x[3]),(x[0],x[1],x[3],x[2]),(x[0],x[3],x[1],x[2])]:   #每种组合对应三种情况
   
6.                 if len(set([a,12-a-b,b,12-b-c,c,12-c-d,d,12-d-a]))==7 and max([a+b,b+c,c+d,d+a])<12:
   
7.                          print('%d-%d-%d  %d-%d-%d  %d-%d-%d  %d-%d-%d'%(a,12-a-b,b,b,12-b-c,c,c,12-c-d,d,d,12-d-a,a))
   

复制代码

输出结果为：
1-9-2  2-7-3  3-5-4  4-7-1
1-7-4  4-6-2  2-7-3  3-8-1
1-9-2  2-5-5  5-4-3  3-8-1
1-6-5  5-5-2  2-7-3  3-8-1
1-9-2  2-7-3  3-3-6  6-5-1
1-9-2  2-4-6  6-3-3  3-8-1
1-9-2  2-6-4  4-3-5  5-6-1
1-9-2  2-5-5  5-3-4  4-7-1
1-4-7  7-3-2  2-5-5  5-6-1
1-4-7  7-3-2  2-4-6  6-5-1
1-8-3  3-5-4  4-2-6  6-5-1
1-8-3  3-3-6  6-2-4  4-7-1
1-4-7  7-2-3  3-4-5  5-6-1
1-4-7  7-2-3  3-3-6  6-5-1
2-7-3  3-4-5  5-1-6  6-4-2

grf1973

共15组结果：
1-9-2  2-7-3  3-5-4  4-7-1
1-7-4  4-6-2  2-7-3  3-8-1
1-9-2  2-5-5  5-4-3  3-8-1
1-6-5  5-5-2  2-7-3  3-8-1
1-9-2  2-7-3  3-3-6  6-5-1
1-9-2  2-4-6  6-3-3  3-8-1
1-9-2  2-6-4  4-3-5  5-6-1
1-9-2  2-5-5  5-3-4  4-7-1
1-4-7  7-3-2  2-5-5  5-6-1
1-4-7  7-3-2  2-4-6  6-5-1
1-8-3  3-5-4  4-2-6  6-5-1
1-8-3  3-3-6  6-2-4  4-7-1
1-4-7  7-2-3  3-4-5  5-6-1
1-4-7  7-2-3  3-3-6  6-5-1
2-7-3  3-4-5  5-1-6  6-4-2

grf1973

搞错了。。。。只有3组
1-9-2  2-6-4  4-5-3  3-8-1
1-9-2  2-7-3  3-4-5  5-6-1
1-5-6  6-4-2  2-7-3  3-8-1