login
Size of the largest subset of {1,2,3,...,n} whose geometric mean is an integer.
3

%I #18 Jan 03 2018 06:52:13

%S 1,1,1,3,3,3,3,3,4,4,4,5,5,5,5,5,5,7,7,7,7,7,7,8,8,8,10,10,10,10,10,

%T 10,10,10,10,12,12,12,12,12,12,12,12,12,12,12,12,14,14,14,14,14,14,14,

%U 14,14,14,14,14,14,14,14,14,16,16,16,16,16,16,16,16,16,16,16

%N Size of the largest subset of {1,2,3,...,n} whose geometric mean is an integer.

%C a(n-1) <= a(n) <= max(a(n-1), nu_{A006530(n)}(n!)) where nu_p(n!) is the exponent of the largest power of p that divides n!. - _Robert Israel_, Jan 02 2018

%C Let k be the geometric mean of the subset. Then k is in A055932. - _David A. Corneth_, Jan 03 2018

%H David A. Corneth, <a href="/A147752/a147752.gp.txt">Possible subsets of {1,2,3,...,n} giving a(n)</a>

%e For n=4, (1*4)^(1/2)=2 and (1*2*4)^(1/3)=2. No other subset of {1,2,3,4} has integer geometric mean, so a(4)=3.

%p ub:= proc(k,n) local p,i,v,t;

%p p:= max(numtheory:-factorset(k));

%p t:= 0;

%p for i from 1 do

%p v:= floor(n/p^i);

%p if v = 0 then return t fi;

%p t:= t+v;

%p od

%p end proc:

%p f:= proc(n) option remember; local goodk, m,u,s,S;

%p m:= f(n-1);

%p u:= ub(n,n);

%p if u <= m then return m fi;

%p goodk:= {1} union select(t -> ub(t,n) > m, {$2..n-1});

%p S:= combinat:-subsets(goodk);

%p while not S[finished] do

%p s:= S[nextvalue]() union {n};

%p if nops(s) <= m then next fi;

%p if type(simplify(convert(s,`*`)^(1/nops(s))),integer) then m:= nops(s); if m = u then return m fi fi;

%p od:

%p m

%p end proc:

%p f(1):= 1:

%p seq(f(n),n=1..74); # _Robert Israel_, Jan 02 2018

%t Array[Length@ Last@ Select[Subsets@ Range@ #, IntegerQ@ GeometricMean@ # &] &, 20] (* _Michael De Vlieger_, Jan 02 2018 *)

%Y Cf. A006530, A147751, A147753.

%K nonn

%O 1,4

%A _John W. Layman_, Nov 11 2008

%E a(1)-a(3) corrected and a(21)-a(74) from _Robert Israel_, Jan 02 2018