Consider
S1=9 = 1! + 2! + 3!
S2=27 = 1! + 2! + 4!
S3=32 = 2! + 3! + 4!
The S1, S2, S3 represent the values of integer powers that can be represented as a sum of exactly three distinct factorials (0! excluded)
Find S4, S5, S6.
A friendly tip: STOP after S6.
a b c sum as power
1 2 3 9 3^2
1 2 4 27 3^3
1 5 6 841 29^2
2 3 4 32 2^5
2 3 5 128 2^7
4 5 7 5184 72^2
from (using factorials up to 17!):
DefDbl A-Z
Dim fct(20, 1), crlf$
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 a = 1 To 15
f1 = fact(a)
For b = a + 1 To 16
f2 = fact(b) + f1
For c = b + 1 To 17
f3 = f2 + fact(c)
f = factor(f3)
firstOcc = fct(1, 1)
good = 1
For i = 2 To f
firstOcc = gcd(firstOcc, fct(i, 1))
Next i
If firstOcc = 1 Then good = 0
If good Then
Text1.Text = Text1.Text & a & Str(b) & Str(c) & mform(f3, "###0")
Text1.Text = Text1.Text & " " & mform(f3 ^ (1 / firstOcc), "###0") & "^" & firstOcc & crlf
DoEvents
End If
Next
Next
Next
Text1.Text = Text1.Text & "done"
DoEvents
End Sub
Function gcd(a, b)
x = a: y = b
Do
q = Int(x / y)
z = x - q * y
x = y: y = z
Loop Until z = 0
gcd = x
End Function
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
n = n + 1
Wend
nxtprm = n
End Function
Function factor(num)
diffCt = 0: good = 1
nm1 = Abs(num): If nm1 > 0 Then limit = Sqr(nm1) 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 nm1 > 1 Then diffCt = diffCt + 1: fct(diffCt, 0) = nm1: fct(diffCt, 1) = 1
factor = diffCt
Exit Function
DivideIt:
cnt = 0
Do
q = Int(nm1 / dv)
If q * dv = nm1 And nm1 > 0 Then
nm1 = q: cnt = cnt + 1: If nm1 > 0 Then limit = Sqr(nm1) 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
Function fact(x)
f = 1
For i = 2 To x
f = f * i
Next i
fact = f
End Function
|
|
Posted by Charlie
on 2015-04-17 07:59:36 |
computer solution: differently ordered list
