一道二年级数学：填数字

grf1973

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

一把小刀闯天下

去重后留下3组，左上角开始，左旋、右旋都可以

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

grf1973

用VBA也方便

1. Sub main()
   
2.     For a = 1 To 4: For b = a + 1 To 5: For c = b + 1 To 6: For d = c + 1 To 7
   
3.         Call check(a, b, c, d)
   
4.         Call check(a, b, d, c)
   
5.         Call check(a, c, b, d)
   
6.     Next: Next: Next: Next
   
7. End Sub
   
8. Sub check(a, b, c, d)   '判断abcd是否符合条件
   
9.     If Application.Max(a + b, b + c, c + d, d + a) >= 12 Then Exit Sub
   
10.     Dim arr(1 To 12)
    
11.     For Each n In Array(a, 12 - a - b, b, 12 - b - c, c, 12 - c - d, d, 12 - d - a)
    
12.         arr(n) = 1
    
13.     Next
    
14.     If Application.Sum(arr) < 8 Then Exit Sub
    
15.     Debug.Print a; 12 - a - b; b; 12 - b - c; c; 12 - c - d; d; 12 - d - a; a
    
16. End Sub

复制代码

运行结果是3组：
1  9  2  6  4  5  3  8  1
1  9  2  7  3  4  5  6  1
1  8  3  7  2  4  6  5  1

lujkhua

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

牛，用HEX来掩盖字符！

香川群子

zopey 发表于 2018-6-5 09:34
先把12 拆成3个数的组合{a,b,c}
    a+b+c =12
     a

3个不同数相加=12的一共只有7个组合:
+9+2+1
+8+3+1
+7+4+1
+7+3+2
+6+5+1
+6+4+2
+5+4+3

它们任取2个组合=Combin(7,2)=21种可能，排除含相同数的，只剩下3个组合：
9+2+1|5+4+3|6、7、8?
8+3+1|6+4+2|5、7、9?
7+3+2|6+5+1|4、8、9?
（注意单数最大不超过9，因为12-1-2=9）

这样一来，仅需检查前面2个3数组合的全排列，在对剩余3个数进行3选2排列即可。
还需检查次数=6*6*6=216次

真的很简化了。

香川群子

grf1973 发表于 2018-6-5 13:33
用python做的。
#考虑四个角数字a,b,c,d，显然max(a,b,c,d)

假设a<b<c<d
则a=1
因为，3数和=12的7个组合中，不含1的组和只有3个，无法组成满足4组的组合。

而第2个数b范围=2 To 3
因为，如果b=4，则最小组合=1,4,5,6 那么5+6=11 而11+最小2=13>12

第3个数c范围= b+1 To 4
因为，如果c=5，则最小组合=1,2,5,6 那么5+6=11 而11+最小3=14>12

第4个数d范围=c+1 To 6
因为，如果d=7，则7能组成=12的2个组合为7+1+4和7+2+3
则剩余对角的最小值=5而之前已经证明b和c都不能>4=5

所以，你的循环可以大大缩小范围：

1. Sub main() '修改 by kagawa
   
2.     a = 1
   
3.     For b = 2 To 3
   
4.     For c = b + 1 To 4
   
5.     For d = c + 1 To 6
   
6.         Call Chk(a, b, c, d)
   
7.         Call Chk(a, b, d, c)
   
8.         Call Chk(a, c, b, d)
   
9.     Next d, c, b
   
10. End Sub
    
11. Function Chk(a, b, c, d)   '判断abcd是否符合条件
    
12.     Dim ar(2 To 9)
    
13.     If b + c = a + d Then Exit Function
    
14.     ar(b) = 1: ar(c) = 1: ar(d) = 1
    
15.     If ar(12 - a - b) + ar(12 - b - c) + ar(12 - c - d) + ar(12 - d - a) Then Exit Function
    
16.     Debug.Print a; 12 - a - b; b; 12 - b - c; c; 12 - c - d; d; 12 - d - a
    
17. End Function

复制代码

香川群子

grf1973 发表于 2018-6-5 15:54
用VBA也方便

中间判断函数也大大简化了。

首先，缩小范围之后，a+b、b+c、c+d、d+a就不可能>12，无需再检查了。

其次，先判断一下b+c、d+a是否可能相同进行排除（a+b<c+d无需检查）

最后，先把a/b/c/d赋值，然后就可以一次性检查12-a-b、12-b-c、12-c-d、12-d-a是否重复即可。

aoe1981

　　实现了去重的代码如下：

1. Option Explicit
   
2. Dim jg(), bj() As Boolean, k&, js&, scjg$()
   
3. Public Sub QuChong()
   
4.     Dim m&, m_sum&, i&, j&, ii&, gd, s$
   
5.     Range("j1:j" & Rows.Count).ClearContents
   
6.     m = Range("b2").Value - 1 '每边位置数-1
   
7.     m_sum = Range("b11").Value - 1 '位置总个数-1
   
8.     k = Cells(Rows.Count, "h").End(xlUp).Row '结果数
   
9.     If m = 0 Or m_sum = 0 Or k = 0 Then MsgBox "请先生成结果。": Exit Sub
   
10.     jg = Range("h1:h" & k).Value
    
11.     ReDim bj(1 To k) As Boolean
    
12.     js = 0
    
13.     For i = 1 To k
    
14.         gd = Split(jg(i, 1), "-")
    
15.         For j = 0 To m_sum Step m
    
16.             s = ""
    
17.             For ii = 0 To m_sum '向右连
    
18.                 s = s & "-" & gd((j + ii) Mod (m_sum + 1))
    
19.             Next ii
    
20.             s = Mid(s, 2)
    
21.             Call DuiBi(s, i)
    
22.             s = ""
    
23.             For ii = 0 To m_sum '向左连
    
24.                 s = s & "-" & gd((j - ii + m_sum + 1) Mod (m_sum + 1))
    
25.             Next ii
    
26.             s = Mid(s, 2)
    
27.             Call DuiBi(s, i)
    
28.         Next j
    
29.     Next i
    
30.     ReDim scjg$(1 To k - js, 1 To 1)
    
31.     j = 0
    
32.     For i = 1 To k
    
33.         If bj(i) = False Then j = j + 1: scjg(j, 1) = jg(i, 1)
    
34.     Next i
    
35.     Range("j1").Resize(k - js, 1).Value = scjg
    
36. End Sub
    
37. Sub DuiBi(ss$, jj&)
    
38.     Dim i&
    
39.     For i = jj + 1 To k '标记重复
    
40.         If ss = jg(i, 1) And bj(i) = False Then bj(i) = True: js = js + 1: Exit For
    
41.     Next i
    
42. End Sub

复制代码

　　基本思路是：从每个顶点出发，向左连接生成一个新的结果字符串，对比标记去重；向右连接生成一个新的结果字符串，对比标记去重。

aoe1981

一把小刀闯天下 发表于 2018-6-5 13:48
去重后留下3组，左上角开始，左旋、右旋都可以

去重后的结果确实是3组，我的结果如下：

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

本质上结果是相同的。

aoe1981

　　本打算用我在下帖中的工具进行去重：

发几个小工具_完全展开图论中环形顶点染色问题
http://club.excelhome.net/thread-1392513-1-1.html
(出处: ExcelHome技术论坛)


　　但是发现本例与“环形顶点染色”中的旋转与对称变换还有不同，原因在于环形中每个点都是顶点，如果有8个顶点的话，旋转变换共有8个。但本例中有些点并不是顶点，旋转变换的数量较少一些。

　　……

　　后来发现了，纯字符串结果形式下实现更为简洁……

　　不深究了……



　　哦，我的新附件更新在了一楼……