A294068 Number of factorizations of n using perfect powers (elements of A001597) other than 1.

1, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2

Offset: 1

Author

Gus Wiseman, May 05 2018

Keywords

• nonn

Examples

			The a(1152) = 7 factorizations are (4*4*8*9), (4*8*36), (4*9*32), (8*9*16), (8*144), (9*128), (32*36).
		

Links

• Robert Israel, Table of n, a(n) for n = 1..10000

Crossrefs

Positions of zeros are A052485.

Cf. A000961, A001055, A001222, A001597, A001694, A007716, A007916, A045778, A052409, A052410, A052486, A091050, A203025, A303707, A303710.

Programs

Maple

ispp:= proc(n) local F;
  F:= ifactors(n)[2];
  igcd(op(map(t -> t[2],F)))>1
end proc:
f:= proc(n) local F, np, Q;
  F:= map(t -> t[2], ifactors(n)[2]);
  np:= mul(ithprime(i)^F[i],i=1..nops(F));
  Q:= select(ispp, numtheory:-divisors(np));
  G(Q,np)
end proc:
G:= proc(Q,n) option remember; local q,t,k;
    if not numtheory:-factorset(n) subset `union`(seq(numtheory:-factorset(q),q=Q)) then return 0 fi;
    q:= Q[1]; t:= 0;
    for k from 0 while n mod q^k = 0 do
      t:= t + procname(Q[2..-1],n/q^k)
    od;
    t
end proc:
G({},1):= 1:
map(f, [$1..200]); # Robert Israel, May 06 2018

Mathematica

ppQ[n_]:=And[n>1,GCD@@FactorInteger[n][[All,2]]>1];
facsp[n_]:=If[n<=1,{{}},Join@@Table[Map[Prepend[#,d]&,Select[facsp[n/d],Min@@#>=d&]],{d,Select[Divisors[n],ppQ]}]];
Table[Length[facsp[n]],{n,100}]