OIES sequence A002473 is the sequence of 7-smooth numbers: positive numbers whose prime divisors are all less than or equal to 7.
Let S be the infinite summation of all the reciprocals of the members of A002473. Does the sum converge, and if so then what is the sum?
While the computer calculation of the sum is not a proof that the series converges, it does seem apparent that it does: to 35/8.
I started with a dumb way of getting the sum, and then the smarter way.
First the dumb way: examine all the numbers up to 100 million and add in the reciprocals of only those numbers that have no higher prime factor than 7:
10000000 4.37494579735816
20000000 4.3749699085652
30000000 4.37497872059798
40000000 4.37498334970393
50000000 4.374986284036
60000000 4.37498825720054
70000000 4.37498973931217
80000000 4.37499084676966
90000000 4.37499174203155
100000000 4.37499243708591
It looks like it might be approaching 35/8. But the program wasted a lot of time factoring all the numbers up to 100 million:
DefDbl A-Z
Dim crlf$, fct(20, 1)
Function mform$(x, t$)
a$ = Format$(x, t$)
If Len(a$) < Len(t$) Then a$ = Space$(Len(t$) - Len(a$)) & a$
mform$ = a$
End Function
Private Sub Form_Load()
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
For n = 1 To 100000000
f = factor(n)
If fct(f, 0) <= 7 Then tot = tot + 1 / n
If n Mod 10000000 = 0 Then Text1.Text = Text1.Text & n & Str(tot) & crlf
DoEvents
Next
Text1.Text = Text1.Text & Str(tot2)
End Sub
Function factor(num)
diffCt = 0: good = 1
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
If INKEY$ = Chr$(27) Then s$ = Chr$(27): Exit Function
Loop
If n > 1 Then diffCt = diffCt + 1: fct(diffCt, 0) = n: fct(diffCt, 1) = 1
factor = diffCt
Exit Function
DivideIt:
cnt = 0
Do
q = Int(n / dv)
If q * dv = n And n > 0 Then
n = q: cnt = cnt + 1: If n > 0 Then limit = Sqr(n) Else limit = 0
If limit <> Int(limit) Then limit = Int(limit + 1)
Else
Exit Do
End If
Loop
If cnt > 0 Then
diffCt = diffCt + 1
fct(diffCt, 0) = dv
fct(diffCt, 1) = cnt
End If
Return
End Function
The smarter way is to vary the powers of 2, 3, 5 and 7. Only usable numbers are used, so we can include some numbers much larger than 100 million, but also take less time:
4.37499996661196
It's looking even better for 35/8.
DefDbl A-Z
Dim crlf$, fct(20, 1)
Function mform$(x, t$)
a$ = Format$(x, t$)
If Len(a$) < Len(t$) Then a$ = Space$(Len(t$) - Len(a$)) & a$
mform$ = a$
End Function
Private Sub Form_Load()
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
pwr2 = 1
For p2 = 0 To 27
pwr3 = 1
For p3 = 0 To 17
pwr5 = 1
For p5 = 0 To 12
pwr7 = 1
For p7 = 0 To 10
tot = tot + 1 / (pwr2 * pwr3 * pwr5 * pwr7)
pwr7 = pwr7 * 7
Next
pwr5 = pwr5 * 5
Next
pwr3 = pwr3 * 3
Next
pwr2 = pwr2 * 2
Next
Text1.Text = Text1.Text & Str(tot)
End Sub
Further modification:
4.37499999751474
better still for 35/8, using these limits on the powers:
For p2 = 0 To 30
pwr3 = 1
For p3 = 0 To 20
pwr5 = 1
For p5 = 0 To 15
pwr7 = 1
For p7 = 0 To 15
But why not go as high as will affect the total? In fact, if the powers are allowed to go so high as to have no effect on the total we get 4.37499999999873.
code fragment:
pwr2 = 1
For p2 = 0 To 300
pwr3 = 1
For p3 = 0 To 300
pwr5 = 1
For p5 = 0 To 300
pwr7 = 1
For p7 = 0 To 300
tot = tot + 1 / (pwr2 * pwr3 * pwr5 * pwr7)
pwr7 = pwr7 * 7
If pwr7 > 100000000000000# Then Exit For
Next
pwr5 = pwr5 * 5
If pwr5 > 100000000000000# Then Exit For
Next
pwr3 = pwr3 * 3
If pwr3 > 100000000000000# Then Exit For
Next
pwr2 = pwr2 * 2
If pwr2 > 100000000000000# Then Exit For
Next
Text1.Text = Text1.Text & Str(tot)
|
|
Posted by Charlie
on 2019-01-23 15:42:55 |
computer sum; dumb way and smarter way
