Problem of the Week 1153

Computing Factorials

MacPOW Home || Math Forum POWs || Search MacPOW

Solution Notes

The problem posed was solved by Joseph DiVincentis, Jacques Vernin, and John Guilford. Here is what I know. Let T(n) be the integers obtainable by an n-step program. Then the size of T(n), starting from 0 and going to 8, is:

1, 3, 6, 13, 38, 153, 867, 6930, 75986.

For the factorials, here are the shortest programs I know. Minimality is known for all of them up to and including 12!

1!  0 steps  {1}
2!  1 steps  {1, 2}
3!  3 steps  {1, 2, 3, 3!}             (no subtraction)
4!  4 steps  {1, 2, 4, 6, 4!}          (no subtraction)
5!  6 steps  {1, 2, 3, 5, 8, 15, 5!}   (no subtraction, cute Fibonacci start)
6!  6 steps  {1, 2, 3, 9, 27, 729, 6!}
             {1, 2, 4, 6, 24, 30, 6!}  (no subtraction)
             {1, 2, 4, 16, 20, 36, 6!} (no subtraction; these 3 are complete list) 
7!  7 steps  {1, 2, 3, 9, 8, 72, 70, 7!} (subtraction is essential)
8!  8 steps  {1, 2, 4, 16, 20, 36, 56, 720, 8!} (no subtraction)
9!  8 steps  {1, 2, 3, 9, 8, 72, 70, 7!, 9!}    (subtraction is essential)
10! 9 steps  {1, 2, 3, 5, 7, 12, 144, 720, 5040, 10!} (no subtraction, by John Guilford)
             {1, 2, 4, 16, 15, 240, 960, 945, 907200, 10!} (the one I found)
             {1, 2, 3, 9, 7, 81, 80, 6400, 567, 10!} (found by Jacques Vernin). 
             John Guilford found over 500 9-step representations of 10!
11! 9 steps  {1, 2, 4, 16, 20, 320, 324, 6480,  6160,  11!}

Also: 
12! 10 steps {1, 2, 4, 6, 24, 30, 720, 900, 924, 518400, 12!}    
                 (no subtraction; proved optimal by John Guilford)  
20! 17 steps {1, 2, 4, 16, 15, 240, 960, 945, 907200, 10!, 10!^2, 11, 17, 28, 
                 4 13 19, 4 13 19 11, 4 13 19 11 17, 20!}  (not optimal)

For more information on this problem, see the results of Al Zimmerman's contest or the update on OEIS. The true optimum for n! is now known up to 19!. And the contest results show that there is a 14-step solution for 20!:

       {1, 2, 4, 6, 36, 144, 140, 176, 25344, 25200, 25194, 638516736,
        16090621747200, 405483668029440000, 2432902008176640000}

My method:

Let P(n) be all the n-step SLPs. Thus P(1) = {{1, 0}, {1, 2}}. But repetition of entries is excluded, so

P(2) = {{1, 0, -1}, {1, 0, 2}, {1, 2, -1}, {1, 2, 3}, {1, 2, 4}}.

Let S(n) be all the entries of any program in P(n). These are the numbers computable in n steps.

The size of P(n), as n runs from 0 through 7, is

{1, 2, 5, 20, 149, 1852, 34354, 873386}.

The size of S(n), as n runs from 0 through 8, is

{1, 3, 6, 13, 38, 153, 867, 6930, 75986}.

Having the sets S(n) in hand up to S(8) completely determines the optimal sequences for n! up to 7!.

Then 8! is settled by multiplying 7! by 8 and observing that 8! is not in S(7).

And 9! is settled by multiplying 7! by 72 and observing that 9! is not in S(7).

To go further, we cannot compute the full set in P(8). But we can extend each of the 873386 entries in P(7), keeping track only of the new numbers that show up, and so obtaining S(8), with its 75986 entries. This takes a couple hours. Since 10! is not in S(8), the best we can hope for is that 10! is in S(9). I discovered that it is by checking which divisors of 10! were in S(8) and finding that 10!/4 lived there. Then a second searched revealed that 4 was in the program for 10!/4, and this gave the program for 10! shown above. Similar work found the program for 11!

The program for 20! was found manually by the trick of squaring 10! in the short program for 10!, and then seeing manually how to add in what remained in 20! / (10!)², a trick being the observation that 4 13 19 could be obtained from 960 and 28. The short one for 12! was found by searching P(7) for programs ending in, say, 518400 (there are 12) and then extending twice and searching for 924, which showed up in one of the 12.

Here is Mathematica code to compute P(n) and S(n) (P is called progs below; values are cached) and S.

extend[pp_] :=Module[{tt= Tuples[pp, {2}],new},new=Flatten[Table[{Total@t, Subtract@@t,Times@@t}, {t,tt}]];Union[ Sort/@ DeleteCases[Table[If[!MemberQ[pp,n], Append[pp,n]], {n, new}], Null]]]
progs[0]={{1}};
progs[n_]:=progs[n] =DeleteDuplicates[
Flatten[Table[extend[progs[n-1][[i]]], {i,1,Length@ progs[n-1]}],1]];
S[n_]:=DeleteDuplicates@Flatten[progs[n]]

[Back to Problem 1153]

© Copyright 2012 Stan Wagon. Reproduced with permission.