N=sum of primes between smallest and largest prime factor of N (inclusive).
Find all possible values for the composite number N below 300.
It's interesting that the cutoff was made at 300, when going just a bit farther, to 371, gives the last example at least as far out as 30,000. I don't know if 371 is the last in a finite set or just that beyond this number the examples are extremely rarified. I haven't found a trend toward either the total or the number itself as being the larger, so that we could say that beyond a certain point one is always larger than the other.
10 2-5
2 * 5
2 + 3 + 5
39 3-13
3 * 13
3 + 5 + 7 + 11 + 13
155 5-31
5 * 31
5 + 7 + 11 + 13 + 17 + 19 + 23 + 29 + 31
371 7-53
7 * 53
7 + 11 + 13 + 17 + 19 + 23 + 29 + 31 + 37 + 41 + 43 + 47 + 53
After finding these, a search in the OEIS finds
A055233, where the next two are given as
2935561623745 (5 through 9557887) and
454539357304421 (3536123 through 128541727). This is not to be confused with the basis for A055514, which does not require that the sequence start with the lowest prime factor of n (nor necessarily end with the highest, for that matter).
DefDbl A-Z
Dim crlf$, fct(20, 1)
Private Sub Form_Load()
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
For n = 6 To 30000
tot = 0: lim = Sqr(n): n1 = n
firstPrime = 0
st = 0
pNo = 0
Do
pNo = pNo + 1: p = prm(pNo)
If p > lim Then Exit Do
q = Int(n1 / p): r = n1 - q * p
If r = 0 Then st = 1: If firstPrime = 0 Then firstPrime = p
If st Then tot = tot + p
While r = 0
n1 = n1 / p
q = Int(n1 / p): r = n1 - q * p
Wend
lim = Sqr(n1)
DoEvents
Loop
If n1 > 0 And firstPrime > 0 Then
For p1 = pNo To 10000
If prm(p1) > n1 Then Exit For
tot = tot + prm(p1)
Next
End If
If tot = n Then
Text1.Text = Text1.Text & n & " " & firstPrime & "-" & prm(p1 - 1) & crlf
f = factor(n)
For i = 1 To f
Text1.Text = Text1.Text & fct(i, 0)
If fct(i, 1) > 1 Then Text1.Text = Text1.Text & "^" & fct(i, 1)
If i < f Then Text1.Text = Text1.Text & " * "
Next
Text1.Text = Text1.Text & crlf
p = firstPrime
Do
Text1.Text = Text1.Text & p
If p = prm(p1 - 1) Then Exit Do
Text1.Text = Text1.Text & " + "
p = nxtprm(p)
Loop
Text1.Text = Text1.Text & crlf & crlf
End If
DoEvents
Next n
Text1.Text = Text1.Text & crlf & "done"
End Sub
Function prm(i)
Dim p As Long
Open "17-bit primes.bin" For Random As #111 Len = 4
Get #111, i, p
prm = p
Close 111
End Function
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
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
|
|
Posted by Charlie
on 2018-10-19 11:53:38 |
computer solution
