关于数的互质

不好意思，写错了：自然数m,n,m∈(1,x),n∈(1,y)，求m,n互质（即m,n 最大公约数为1）的概率

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

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--∞>)

琢磨出一个解法，就是太慢：Option ExplicitPrivate Sub Command1_Click()
Dim i As Integer
For i = 1000 To 3000 Step 100
Debug.Print "x=" & i; ",y=1000 时， m,n互质的概率为：" & getpmn(i, 1000)
Next
End SubFunction ishuzhi(ByVal m As Long, ByVal n As Long) As Boolean
ishuzhi = False
Dim temp As Long
Do While n > 0
temp = m Mod n
m = n
n = temp
Loop
If m = 1 Then ishuzhi = True
End FunctionFunction getpmn(ByVal x As Long, ByVal y As Long)
Dim m As Long, n As Long, k As Long
k = 0
For m = 1 To x
For n = 1 To y
If ishuzhi(m, n) Then k = k + 1
Next
Next
getpmn = k / (x * y)
End Function返回：x=1000,y=1000 时， m,n互质的概率为：.608383
x=1100,y=1000 时， m,n互质的概率为：.608422727272727
x=1200,y=1000 时， m,n互质的概率为：.608209166666667
x=1300,y=1000 时， m,n互质的概率为：.608240769230769
x=1400,y=1000 时， m,n互质的概率为：.608317142857143
x=1500,y=1000 时， m,n互质的概率为：.608272666666667
x=1600,y=1000 时， m,n互质的概率为：.60818875
x=1700,y=1000 时， m,n互质的概率为：.608374705882353
x=1800,y=1000 时， m,n互质的概率为：.608220555555556
x=1900,y=1000 时， m,n互质的概率为：.608196842105263
x=2000,y=1000 时， m,n互质的概率为：.6083385
x=2100,y=1000 时， m,n互质的概率为：.608233333333333
x=2200,y=1000 时， m,n互质的概率为：.608168181818182
x=2300,y=1000 时， m,n互质的概率为：.608270434782609
x=2400,y=1000 时， m,n互质的概率为：.608242083333333
x=2500,y=1000 时， m,n互质的概率为：.6081728
x=2600,y=1000 时， m,n互质的概率为：.608246153846154
x=2700,y=1000 时， m,n互质的概率为：.608211111111111
x=2800,y=1000 时， m,n互质的概率为：.608182857142857
x=2900,y=1000 时， m,n互质的概率为：.608245172413793
x=3000,y=1000 时， m,n互质的概率为：.608212666666667
而6/pi^2=0.607927101854027

得出下面的结果算了5分钟：x=10000,y=10000 时， m,n互质的概率为：.60794971

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

辗转相除来求互质应该没什么问题的谁能想出更简单的办法来估计可以拿**数学奖了
能做的简化也就只有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提供一些思路不知道对不对楼主再去验证一下

//对于一个确定的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以前我下载过，现在不知道放哪里去了，郁闷！)

∵ 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)

代码如下，计算 x = 10000 y = 10000 只要 10 秒（用 exe 执行）
结果为 0.60794971Private 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

楼上代码也是太慢.找到一种更合理的算法.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中较小者以内的所有素数,就可实现概率的计算.

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 FunctionPrivate 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 秒！

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

调试易

关于数的互质

解决方案 »