Starting with a probability of 1, keep multiplying by 1 minus the square of the reciprocal of the next prime until the value levels off to an acceptable degree of accuracy. The program starts off with the probability reduced to the probability that the two numbers are not both even.

DefDbl A-Z

Dim crlf$

Private Sub Form_Load()

Text1.Text = ""

crlf$ = Chr(13) + Chr(10)

Form1.Visible = True

p = 3 / 4: prime = 2

Do

prev = p

prime = nxtprm(prime)

p = p * (1 - 1 / prime ^ 2)

If p = prev Then Exit Do

DoEvents

Loop Until prev - p < 0.00000000000001

Text1.Text = Text1.Text & p & Str(prev) & " done"

End Sub

Function prmdiv(num)

Dim n, dv, q

If num = 1 Then prmdiv = 1: Exit Function

n = Abs(num): If n > 0 Then limit = Sqr(n) Else limit = 0

If limit <> Int(limit) Then limit = Int(limit + 1)

dv = 2: GoSub DivideIt

dv = 3: GoSub DivideIt

dv = 5: GoSub DivideIt

dv = 7

Do Until dv > limit

GoSub DivideIt: dv = dv + 4 '11

GoSub DivideIt: dv = dv + 2 '13

GoSub DivideIt: dv = dv + 4 '17

GoSub DivideIt: dv = dv + 2 '19

GoSub DivideIt: dv = dv + 4 '23

GoSub DivideIt: dv = dv + 6 '29

GoSub DivideIt: dv = dv + 2 '31

GoSub DivideIt: dv = dv + 6 '37

Loop

If n > 1 Then prmdiv = n

Exit Function

DivideIt:

Do

q = Int(n / dv)

If q * dv = n And n > 0 Then

prmdiv = dv: Exit Function

Else

Exit Do

End If

Loop

Return

End Function

Function nxtprm(x)

Dim n

n = x + 1

While prmdiv(n) < n Or n < 2

n = n + 1

Wend

nxtprm = n

End Function

finds

0.607927106501875 .607927106501885

the first being the latest iteration and the second being the preceding iteration. Let's say 0.6079271065018 or 0.6079271065019 is a safe bet, or certainly 0.607927106502 with their implied degrees of precision.