您所在位置：主题：回答“谁来救救我”--1到20围成圆圈，使相邻差为质数
moz
[专家分：37620] 发布于 2010-11-13 01:12:00
VBA for EXCEL 代码：
[quote]DefInt A-Z
Sub moz()
s1$ = "ABCDEFGHIJKLMNOPQRST" '代表从1到20
s2$ = " BC E G K M Q S " '代表20以内的质数
l20 = Len(s1$)
Do
s3$ = s1$ + Left$(s1$, 1)
For i = 2 To 21
If InStr(s2$,Chr$(64+Abs(Asc(Mid$(s3$,i,1))-Asc(Mid$(s3$,i-1,1)))))=0 Then Exit For
Next
If i > 21 Then
For i = 1 To 20
Debug.Print Asc(Mid$(s3$, i, 1)) - 64;
Next
Exit Sub
End If
Do
i = i - 1
l$ = Mid$(s1$, i, 1)
r$ = Mid$(s1$, i + 1, 1)
For j = i + 2 To l20
p$ = Mid$(s1$, j, 1)
For k = i + 1 To j - 1
If p$ < Mid$(a$, k, 1) Then
Mid$(s1$, k, j - k + 1) = p$ + Mid$(s1$, k)
Exit For
End If
Next
Next
For j = i + 1 To l20
p$ = Mid$(s1$, j, 1)
If p$ > r$ And InStr(s2$, Chr$(64 + Abs(Asc(p$) - Asc(l$)))) > 0 Then
Mid$(s1$, i + 1, j - i) = p$ + Mid$(s1$, i + 1)
Exit For
End If
Next
Loop While j > l20 And i > 1
DoEvents
Loop While i > 0
Debug.Print "无解"
End Sub[/quote]
QB代码：
[quote]DefInt A-Z
s1$ = "ABCDEFGHIJKLMNOPQRST" '代表从1到20
s2$ = " BC E G K M Q S " '代表20以内的质数
l20 = Len(s1$)
Do
s3$ = s1$ + Left$(s1$, 1)
For i = 2 To 21
If InStr(s2$,Chr$(64+Abs(Asc(Mid$(s3$,i,1))-Asc(Mid$(s3$,i-1,1)))))=0 Then Exit For
Next
If i > 21 Then
For i = 1 To 20
Print Asc(Mid$(s3$, i, 1)) - 64;
Next
End
End If
Do
i = i - 1
l$ = Mid$(s1$, i, 1)
r$ = Mid$(s1$, i + 1, 1)
For j = i + 2 To l20
p$ = Mid$(s1$, j, 1)
For k = i + 1 To j - 1
If p$ < Mid$(a$, k, 1) Then
Mid$(s1$, k, j - k + 1) = p$ + Mid$(s1$, k)
Exit For
End If
Next
Next
For j = i + 1 To l20
p$ = Mid$(s1$, j, 1)
If p$ > r$ And InStr(s2$, Chr$(64 + Abs(Asc(p$) - Asc(l$)))) > 0 Then
Mid$(s1$, i + 1, j - i) = p$ + Mid$(s1$, i + 1)
Exit For
End If
Next
Loop While j > l20 And i > 1
Loop While i > 0
Print "无解"
[/quote]
得出的结果是：
1 3 5 2 4 6 8 10 7 9 11 13 15 12 19 17 20 18 16 14
[quote]DefInt A-Z
Sub moz()
s1$ = "ABCDEFGHIJKLMNOPQRST" '代表从1到20
s2$ = " BC E G K M Q S " '代表20以内的质数
l20 = Len(s1$)
Do
s3$ = s1$ + Left$(s1$, 1)
For i = 2 To 21
If InStr(s2$,Chr$(64+Abs(Asc(Mid$(s3$,i,1))-Asc(Mid$(s3$,i-1,1)))))=0 Then Exit For
Next
If i > 21 Then
For i = 1 To 20
Debug.Print Asc(Mid$(s3$, i, 1)) - 64;
Next
Exit Sub
End If
Do
i = i - 1
l$ = Mid$(s1$, i, 1)
r$ = Mid$(s1$, i + 1, 1)
For j = i + 2 To l20
p$ = Mid$(s1$, j, 1)
For k = i + 1 To j - 1
If p$ < Mid$(a$, k, 1) Then
Mid$(s1$, k, j - k + 1) = p$ + Mid$(s1$, k)
Exit For
End If
Next
Next
For j = i + 1 To l20
p$ = Mid$(s1$, j, 1)
If p$ > r$ And InStr(s2$, Chr$(64 + Abs(Asc(p$) - Asc(l$)))) > 0 Then
Mid$(s1$, i + 1, j - i) = p$ + Mid$(s1$, i + 1)
Exit For
End If
Next
Loop While j > l20 And i > 1
DoEvents
Loop While i > 0
Debug.Print "无解"
End Sub[/quote]
QB代码：
[quote]DefInt A-Z
s1$ = "ABCDEFGHIJKLMNOPQRST" '代表从1到20
s2$ = " BC E G K M Q S " '代表20以内的质数
l20 = Len(s1$)
Do
s3$ = s1$ + Left$(s1$, 1)
For i = 2 To 21
If InStr(s2$,Chr$(64+Abs(Asc(Mid$(s3$,i,1))-Asc(Mid$(s3$,i-1,1)))))=0 Then Exit For
Next
If i > 21 Then
For i = 1 To 20
Print Asc(Mid$(s3$, i, 1)) - 64;
Next
End
End If
Do
i = i - 1
l$ = Mid$(s1$, i, 1)
r$ = Mid$(s1$, i + 1, 1)
For j = i + 2 To l20
p$ = Mid$(s1$, j, 1)
For k = i + 1 To j - 1
If p$ < Mid$(a$, k, 1) Then
Mid$(s1$, k, j - k + 1) = p$ + Mid$(s1$, k)
Exit For
End If
Next
Next
For j = i + 1 To l20
p$ = Mid$(s1$, j, 1)
If p$ > r$ And InStr(s2$, Chr$(64 + Abs(Asc(p$) - Asc(l$)))) > 0 Then
Mid$(s1$, i + 1, j - i) = p$ + Mid$(s1$, i + 1)
Exit For
End If
Next
Loop While j > l20 And i > 1
Loop While i > 0
Print "无解"
[/quote]
得出的结果是：
1 3 5 2 4 6 8 10 7 9 11 13 15 12 19 17 20 18 16 14