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

Home > Numbers
Some powers decomposed (Posted on 2015-04-16) Difficulty: 3 of 5
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.

No Solution Yet Submitted by Ady TZIDON    
No Rating

Comments: ( Back to comment list | You must be logged in to post comments.)
Solution computer solution: differently ordered list | Comment 2 of 5 |
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
Please log in:
Login:
Password:
Remember me:
Sign up! | Forgot password


Search:
Search body:
Forums (0)
Newest Problems
Random Problem
FAQ | About This Site
Site Statistics
New Comments (4)
Unsolved Problems
Top Rated Problems
This month's top
Most Commented On

Chatterbox:
Copyright © 2002 - 2017 by Animus Pactum Consulting. All rights reserved. Privacy Information