VBA语言编写自然数排成一圈后为素数

vbyou126

VBA语言编写自然数排成一圈后为素数


将1,2,3,...,20这20个连续的自然数排成一圈，使任意两个相邻的自然数之和均为素数

microyip

你不如告诉大家，用什么思路来排，然后大师们就会给你写了，否则，你觉得有人闲没事给你算一下他们之和是不是素数？

香川群子

满足条件的解有很多啊。

第1组：
1        2        3        4        7        6        5        8        9        10        13        16        15        14        17        20        11        12        19        18

香川群子

1. Dim a&(3, 9), b(19), c(3 To 39) As Boolean, k&
   
2. Sub 排列组合检查圆圈相邻数相加为素数()
   
3.     tms = Timer
   
4.     sr = [{3,5,7,11,13,17,19,23,29,31,37}] '1-20个数相加为素数的集合
   
5.     For i = 1 To 10
   
6.         a(2, i - 1) = i * 2: a(3, i - 1) = i * 2 - 1 '数据填充
   
7.         c(sr(i)) = True '2个数相加为素数的标记数组
   
8.     Next
   
9.     a(1, 0) = 1: b(0) = 1: c(37) = True '起始数为=1
   
10.    
    
11.     k = 0: Call dgPL(0, 1) '递归检查排列组合
    
12.     MsgBox Format(Timer - tms, "0.000s ") & k
    
13. End Sub
    
14. 
    
15. Sub dgPL(i&, t&)
    
16.     Dim j&
    
17.     If t = 20 Then If c(b(19) + 1) Then k = k + 1: Cells(k, 1).Resize(, 20) = b: If k > 100 Then End
    
18.     '满足20个排列组合数以后检查最后1个数 符合则输出结果。 满100就退出。
    
19. 
    
20.     For j = 0 To 9 '遍历奇数或偶数
    
21.         If a(i, j) = 0 Then '如该数未使用
    
22.             If c(b(t - 1) + a(i + 2, j)) Then '且相邻数相加为素数
    
23.                 a(i, j) = 1: b(t) = a(i + 2, j)  '则记录有效
    
24.                 Call dgPL(IIf(i, 0, 1), t + 1)   '递归继续
    
25.                 a(i, j) = 0: b(t) = "" '深入递归无效时递归返回并清空
    
26.             End If
    
27.         End If
    
28.     Next
    
29. End Sub
    

复制代码

香川群子

经过计算验证，1-20共有6,309,300种排列组合满足要求。

1. 
   
2. Dim a&(), b(), c() As Boolean, k&, n&, cnt&
   
3. Sub 圆圈相邻数相加为素数的排列计算()
   
4.     Dim i&, tms#
   
5.     [a1].CurrentRegion = ""
   
6.     tms = Timer
   
7.     n = 10 '此处n为数字范围的一半即奇偶个数 n=10的实际范围为1-20
   
8.     ReDim a(3, n - 1), b(2 * n - 1)
   
9.     For i = 1 To n
   
10.         a(2, i - 1) = i * 2: a(3, i - 1) = i * 2 - 1
    
11.     Next
    
12.     a(1, 0) = 1: b(0) = 1: c = GetPrime(4 * n - 1)
    
13.    
    
14.     k = 0: cnt = 0: Call dgPL(0, 1)
    
15.     Cells(n, 27) = 2 * n: Cells(n, 28) = k: Cells(n, 29) = cnt: Cells(n, 30) = Format(Timer - tms, "0.000s")
    
16.     MsgBox Format(Timer - tms, "0.000s ") & k & "/" & cnt
    
17. End Sub
    
18. Sub dgPL(i&, t&)
    
19.     Dim j&
    
20.     cnt = cnt + 1
    
21.     If t = 2 * n Then If c(b(2 * n - 1) + 1) Then k = k + 1: If k < 11 Then Cells(k, 1).Resize(, 2 * n) = b
    
22.     For j = 0 To n - 1
    
23.         If a(i, j) = 0 Then
    
24.             If c(b(t - 1) + a(i + 2, j)) Then
    
25.                 a(i, j) = 1: b(t) = a(i + 2, j)
    
26.                 Call dgPL(IIf(i, 0, 1), t + 1)
    
27.                 a(i, j) = 0: b(t) = ""
    
28.             End If
    
29.         End If
    
30.     Next
    
31. End Sub
    
32. Function GetPrime(n&) '计算素数数列
    
33.     Dim a&(), b() As Boolean, i&, j&, k&, m&, s&
    
34.     m = n \ 2: ReDim a&(m), b(3 To n) As Boolean
    
35.     For i = 1 To Sqr(n) \ 2
    
36.         If a(i) = 0 Then
    
37.             s = i * 2 + 1: b(s) = True: k = k + 1: a(k) = s
    
38.             For j = (i * 3 + 1) To m Step s
    
39.                 a(j) = 1
    
40.             Next
    
41.         End If
    
42.     Next
    
43.     For i = (a(k) + 1) / 2 To m
    
44.         If a(i) = 0 Then s = i * 2 + 1: b(s) = True ': k = k + 1: a(k) = s
    
45.     Next
    
46.     GetPrime = b
    
47. End Function
    

复制代码

香川群子

经确认，直接对1-n进行排列计算，反而比楼上区分奇偶性的算法更快！

代码也简单：

1. Dim a() As Boolean, b%(), c() As Boolean, k&, n%, cnt&
   
2. Sub prime排列1() ' m*m prime
   
3.     Dim tms#
   
4. '    [a:z] = ""
   
5.     tms = Timer
   
6.    
   
7.     n = 16
   
8.     ReDim a(1 To n), b(n - 1)
   
9.     a(1) = True: b(0) = 1
   
10.     c = GetPrime(2 * n - 1)
    
11.    
    
12.     k = 0: cnt = 0: Call dgPL1(1)
    
13.     MsgBox Format(Timer - tms, "0.000s ") & k & "/" & cnt
    
14. End Sub
    
15. Sub dgPL1(t%)
    
16.     Dim i%, i1%, j1%, f As Boolean
    
17.     cnt = cnt + 1
    
18. '    If t = n Then If c(b(t - 1) + 1) Then k = k + 1: Cells(k, 1).Resize(, n) = b: Stop
    
19.     If t = n Then If c(b(t - 1) + 1) Then k = k + 1: Exit Sub
    
20.    
    
21.     For i = 1 To n
    
22.         If Not a(i) Then If c(b(t - 1) + i) Then a(i) = True: b(t) = i: Call dgPL1(t + 1): a(i) = False
    
23.     Next
    
24. End Sub
    
25. Function GetPrime(n&)
    
26.     Dim a&(), b() As Boolean, i&, j&, k&, m&, s&
    
27.     m = n \ 2: ReDim a&(m), b(3 To n) As Boolean
    
28.     For i = 1 To Sqr(n) \ 2
    
29.         If a(i) = 0 Then
    
30.             s = i * 2 + 1: b(s) = True: k = k + 1: a(k) = s
    
31.             For j = s + i To m Step s
    
32.                 a(j) = 1
    
33.             Next
    
34.         End If
    
35.     Next
    
36.     For i = (a(k) + 1) / 2 To m
    
37.         If a(i) = 0 Then s = i * 2 + 1: b(s) = True ': k = k + 1: a(k) = s
    
38.     Next
    
39.     GetPrime = b
    
40. End Function

复制代码

vbyou126

香川群子 发表于 2016-4-25 12:47
经确认，直接对1-n进行排列计算，反而比楼上区分奇偶性的算法更快！

代码也简单：

高手中的高手