A200744 Divide integers 1..n into two sets, minimizing the difference of their products. This sequence is the larger product.

1, 2, 3, 6, 12, 30, 72, 210, 630, 1920, 6336, 22176, 79200, 295680, 1146600, 4586400, 18869760, 80061696, 348986880, 1560176640, 7148445696, 33530112000, 160825785120, 787718131200, 3938590656000, 20083261440000, 104351247000000, 552173794099200, 2973528918360000, 16286983961149440

Offset

1,2

Links

Max Alekseyev, Table of n, a(n) for n = 1..140 (terms for n = 1..35 from Michael S. Branicky)

Formula

a(n) = A127180(n) - A200743(n) = A038667(n) + A200743(n) = (A038667(n) + A127180(n)) / 2. - Max Alekseyev, Jun 18 2022

Example

For n=1, we put 1 in one set and the other is empty; with the standard convention for empty products, both products are 1.
For n=13, the central pair of divisors of n! are 78975 and 78848. Since neither is divisible by 10, these values cannot be obtained. The next pair of divisors are 79200 = 12*11*10*6*5*2*1 and 78624 = 13*9*8*7*4*3, so a(13) = 79200.

Maple

a:= proc(n) local l, ll, g, p, i; l:= [i$i=1..n]; ll:= [i!$i=1..n]; g:= proc(m, j, b) local mm, bb, k; if j=1 then m else mm:= m; bb:= b; for k to 2 while (mm<p) do if j=2 or k=2 or k=1 and ll[j-1]*mm>bb then bb:= max(bb, g(mm, j-1, bb)) fi; mm:= mm*l[j] od; bb fi end; Digits:= 700; p:= ceil(sqrt(ll[n])); ll[n]/ g(1, nops(l), 1) end: seq(a(n), n=1..23);  # Alois P. Heinz, Nov 22 2011

Mathematica

a[n_] := a[n] = Module[{s, t}, {s, t} = MinimalBy[{#, Complement[Range[n], #]}& /@ Subsets[Range[n]], Abs[Times @@ #[[1]] - Times @@ #[[2]]]&][[1]]; Max[Times @@ s, Times @@ t]];
Table[Print[n, " ", a[n]];
a[n], {n, 1, 25}] (* Jean-François Alcover, Nov 07 2020 *)

Prog

(Python)
from math import prod, factorial
from itertools import combinations
def A200744(n):
    m = factorial(n)
    return min((abs((p:=prod(d))-m//p), max(p, m//p)) for l in range(n, n//2, -1) for d in combinations(range(1, n+1), l))[1] # Chai Wah Wu, Apr 07 2022

Crossrefs

Cf. A060777, A060796, A038667, A127180, A200743.

Sequence in context: A014278 A061056 A060777 * A089430 A337638 A213242

Adjacent sequences: A200741 A200742 A200743 * A200745 A200746 A200747

Keyword

nonn

Author

Franklin T. Adams-Watters, Nov 21 2011

Extensions

a(24)-a(30) from Alois P. Heinz, Nov 22 2011

Status

approved