All about flooble | fun stuff | Get a free chatterbox | Free JavaScript | Avatars
 perplexus dot info

 Double perfection (Posted on 2018-12-28)
Find the smallest integer for which both the number of its divisors and the sum of its prime factors are perfect numbers.

Rem: Duplicate primes are summed up: e.g. 12 = 2*2*3, - so the sum of 12's prime factors is 2+2+3=7.

Bonus question: Any others?

 See The Solution Submitted by Ady TZIDON No Rating

Comments: ( Back to comment list | You must be logged in to post comments.)
 computer solution Comment 1 of 1
338 has 6 divisors (1, 2, 13, 26, 169 and 338) and the sum of its prime factors is 28 (2+13+13).

Two other such numbers are 2496 and 3520.

338  6 28
2496 28 28
3520 28 28

DefDbl A-Z
Dim crlf\$
Dim fct(20, 1), perfect As Variant
t = Timer
Text1.Text = ""
crlf\$ = Chr(13) + Chr(10)
Form1.Visible = True

perfect = Array(0, 6, 28, 496, 8128, 33550336, 8589869056#, 137438691328#)

For n = 2 To 50000
f = factor(n)
totpf = 0
For i = 1 To f
totpf = totpf + fct(i, 0) * fct(i, 1)
Next i
good = 0
For i = 1 To 7
If totpf = perfect(i) Then good = 1: Exit For
Next i
If good Then
numdiv = 1
For i = 1 To f
numdiv = numdiv * (fct(i, 1) + 1)
Next i
good = 0
For i = 1 To 7
If numdiv = perfect(i) Then
good = 1: Exit For
End If
Next i
If good Then
Text1.Text = Text1.Text & n & Str(numdiv) & Str(totpf) & crlf
End If
End If
DoEvents
Next n

Text1.Text = Text1.Text & " end"

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

 Posted by Charlie on 2018-12-28 15:26:08

 Search: Search body:
Forums (0)