关于数的互质

[northwolves]

自然数x,y,x∈(1,m),y∈(1,n)，求m,n互质（即m,n 最大公约数为1）的概率

[northwolves]

得出下面的结果算了5分钟：

x=10000,y=10000 时， m,n互质的概率为：.60794971

[northwolves]

记得m,n驱于无穷大时，此概率的极限为6/π^2，找不见她的证明过程了

[northwolves]

不好意思，写错了：

自然数m,n,m∈(1,x),n∈(1,y)，求m,n互质（即m,n 最大公约数为1）的概率

[northwolves]

m,n在全体自然数中取值时，此概率的极限为6/π^2。

[zhzhq800204]

帮顶.

[bobdog1215]

两个问题
1 互质是指两个质数还是两个数最大公约数为1
比如2 3 和 2 9 前者互质无疑 后者是否也是互质
2 觉得概率的分子不应该是常数啊 应该和N有关

[winehero]

大哥，出个简单的吧，这年头抢分不容易，呵呵。。。
'大致思路，求出M及N中那个大数的公因数（用m_strPrimesM表示，公因数通过*连接）
'对2-M中所有数作统计，得出与M互质的数个数，然后除以M-2就是概率，不知对不对？

Option Explicit

Dim m_strPrimesM As String

Private Sub Command1_Click()
Dim M As Long, i As Long, j As Long

M = IIf(CInt(Text1.Text) <= CInt(Text2.Text), CInt(Text2.Text), CInt(Text1.Text))

If IsPrime(M) Then
MsgBox "Since M is a prime, the result is Zero"
Exit Sub
End If
m_strPrimesM = GetPrimeExp(M)
For i = 2 To M - 1
If IsHuZhi(i) Then j = j + 1
Next i
MsgBox "The result is " & j & "/" & M - 2
End Sub

Private Function GetPrimeExp(ByVal Num1 As Long) As String
Dim Num2 As Long, i As Long
Dim strExp As String

For Num2 = 2 To Num1 - 1
If IsPrime(Num2) = True Then
Do While Num1 / Num2 = Num1 \ Num2
If strExp = "" Then
strExp = Num2
ElseIf InStr("*" & strExp & "*", "*" & Num2 & "*") = 0 Then
strExp = strExp & "*" & Num2
End If
Num1 = Num1 / Num2
Loop
End If
Next Num2
If strExp = "" Then strExp = Num1
GetPrimeExp = strExp
End Function

Private Function IsPrime(X As Long) As Boolean
Dim Y As Long
IsPrime = True
For Y = 2 To Sqr(X)
If X / Y = X \ Y Then
IsPrime = False
Y = X + 1
End If
Next Y
End Function

Private Function IsHuZhi(ByVal Num1 As Long) As Boolean
Dim i As Long
If Num1 = 2 Then Num1 = 3
For i = 2 To Num1 - 1
If IsPrime(i) Then
If Num1 / i = Num1 \ i Then
If InStr("*" & m_strPrimesM & "*", "*" & i & "*") > 0 Then Exit Function
Num1 = Num1 / i
End If
End If
Next i
IsHuZhi = True
End Function

[northwolves]

to bobdog1215(林夕)

两个问题
1 互质是指两个质数还是两个数最大公约数为1
比如2 3 和 2 9 前者互质无疑 后者是否也是互质
2 觉得概率的分子不应该是常数啊 应该和N有关
-----------------------
互质是指两个质数还是两个数最大公约数为1
比如2 3 和 2 9 前者互质无疑 后者也是互质

两个质数肯定互质
-----------------

概率P的分子不应该是常数啊 应该和N有关


P估计与M，N都有关系，

Lim P=6/Pi^2≈0.6 (X-->∞,Y--∞>)

[northwolves]

效率太低.各位兄弟姐妹帮忙解决一下,周四结贴

[chen2831278]

帮顶

[Tiger_Zhao]

逻辑错误，统计怎么正确
?ishuzhi(3,9)
False

[bobdog1215]

辗转相除来求互质应该没什么问题的 谁能想出更简单的办法来估计可以拿**数学奖了
能做的简化也就只有getpmn
对于一个确定的X 假如它是2的倍数
那么对于Y 只有奇数才会是互质 而且肯定互质
对于一个确定的X 假如它是3的倍数
那么对于Y 只要Y Mod 3 And Y Mod 2 都不为0 就与3 互质
等于对Y进行了判断删选 应该可以快一点 如果有必要在加上5 7判断 当然判断多了可能也会增加时间
还有就是假如X,Y 相等的时候 可以再设计一下算法 嵌套循环的长度可以缩短
k = 0
For m = 1 To x
For n = m+1 To y
If ishuzhi(m, n) Then k = k + 1
Next
Next
k=2k+1

提供一些思路 不知道对不对 楼主再去验证一下

[northwolves]

楼上言之有理

[northwolves]

楼上代码也是太慢.找到一种更合理的算法.

1--x 分为n种情况:
2的倍数
3的倍数
5的倍数
7的倍数
11的倍数
...

则m,n都不能被2整除的概率为:P=1-(x\2)*(y\2)/(x*y)
也不能被3整除的概率为P=P*1-(x\3)*(y\3)/(x*y)
也不能被5整除的概率为P=P*1-(x\5)*(y\5)/(x*y)
....
也不能被素数Z整除的概率为P=P*1-(x\z)*(y\z)/(x*y)

所以,列举X,Y中较小者以内的所有素数,就可实现概率的计算.

[northwolves]

Function GETPMN(ByVal X As Long, Y As Long) As Double
Dim a() As Byte, i As Long, temp As Double, p As Long
If X > Y Then
temp = X
X = Y
Y = temp
End If
If X = 1 Then GETPMN = 1: Exit Function
GETPMN = 1 - ((X \ 2) / X) * ((Y \ 2) / Y)
ReDim a(1 To X)
p = 3
Do While p <= X
If p <= Sqr(X) Then
temp = p * p
k = 0
For i = temp To X Step 2 * p 'p的倍数
a(i) = 1 '设为1表示合数
Next
End If
GETPMN = GETPMN * (1 - ((X \ p) / X) * (Y \ p) / Y)
again:
p = p + 2
If p > X Then Exit Do
If a(p) = 1 Then GoTo again
Loop
End Function

Private Sub Command1_Click()
Dim mytime As Double
mytime = Timer
Debug.Print "x=20000000,y=10000000 时， m,n互质的概率为：" & GETPMN(20000000, 10000000); "总计用时 " & Format(Timer - mytime, "0.0000") & " 秒！"

End Sub


返回:

x=20000000,y=10000000 时， m,n互质的概率为：0.607927217465724 总计用时 2.1254 秒！

[northwolves]

以上代码参考http://mathworld.wolfram.com/RelativelyPrime.html 及其页内连接所写,感谢大家的帮助和建议.

[脆皮大雪糕]

//对于一个确定的X 假如它是2的倍数
//那么对于Y 只有奇数才会是互质 而且肯定互质

不对吧，为什么Y是奇数他们肯定互质？18是2的倍数，9是奇数，他们两个不互质

当两个数同为偶数，肯定不互质。增加这个判断以后可以减少25%的计算量
至于判断奇偶用mod的方法偏慢，可以用和1做与运算的结果来判断，与运算的过程在编译后只需要一条CPU指令

另外，当其中一个数为大于2的质数的时候，他跟另外一个数肯定互质。楼主前一段时间已经发过帖子讨论寻找质数的程序了。可以把10000以内的质数可以事先生成一个bool数组如
a(3) = true
a(4) = false
a(5) = true
a(6) = false
a(7) = true
a(8) = false
a(9) = false
…………
getpmn函数中的X循环，每次循环用a(x)判断这个数是不是质数

经过这两个判断以后，10000以内需要进行辗转相除的数对就减少许多了

[脆皮大雪糕]

哦，顺便提一下，判断一个数是否为素数方面，一个印度人已经找到一种相对简易的办法。(他的paper以前我下载过，现在不知道放哪里去了，郁闷！)

[Tiger_Zhao]

∵ m 和 n 互质：m 的质因子{1,m1,m2,...} 和 n 的质因子 {1,n1,n2,...} 除了 1，其他没有一个相同。
∴ m 和 n 不互质：肯定存在一个质数 p (p <> 1)，同时能把 m 和 n 整除。

解题思路
从 http://www.utm.edu/research/primes 可以取得已知质数，用除 1 以外的质数初始化一个数组 aPrime()。
建一个 x * y 的二维 boolean 数组，aFlag(m,n) = True 表示 m 和 n 不互质。
循环 aPrime 中小于 Min(x,y) 的所有质数 p:
对所有为 p 的倍数 m 和 n，设置 aFlag(m,n) = True
统计 aFlag(m,n) = False 的个数 k
概率就为 k / (x * y)

[Tiger_Zhao]

代码如下，计算 x = 10000 y = 10000 只要 10 秒（用 exe 执行）
结果为 0.60794971

Private Sub Command1_Click()
Dim aPrime() As Long
初始化质数数组 aPrime

Dim start As Date, finish As Date
Dim aFlag() As Boolean
Dim x As Long
Dim y As Long
Dim minXY As Long
Dim i As Long
Dim p As Long
Dim m As Long, n As Long
Dim k As Long

x = Val(Text1)
y = Val(Text2)
start = Now
ReDim aFlag(1 To x, 1 To y)
minXY = IIf(x < y, x, y)
k = x * y
For i = 0 To UBound(aPrime)
p = aPrime(i)
If p > minXY Then Exit For

For m = p To x Step p
For n = p To y Step p
If Not aFlag(m, n) Then
k = k - 1
aFlag(m, n) = True
End If
Next
Next
Next
finish = Now
Me.Print x & "," & y, k / (x * y), DateDiff("s", start, finish)
End Sub