%I #20 May 07 2018 03:08:04
%S 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,
%T 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,
%U 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
%N Number of factorizations of n using perfect powers (elements of A001597) other than 1.
%H Robert Israel, <a href="/A294068/b294068.txt">Table of n, a(n) for n = 1..10000</a>
%e 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).
%p ispp:= proc(n) local F;
%p F:= ifactors(n)[2];
%p igcd(op(map(t -> t[2],F)))>1
%p end proc:
%p f:= proc(n) local F, np, Q;
%p F:= map(t -> t[2], ifactors(n)[2]);
%p np:= mul(ithprime(i)^F[i],i=1..nops(F));
%p Q:= select(ispp, numtheory:-divisors(np));
%p G(Q,np)
%p end proc:
%p G:= proc(Q,n) option remember; local q,t,k;
%p if not numtheory:-factorset(n) subset `union`(seq(numtheory:-factorset(q),q=Q)) then return 0 fi;
%p q:= Q[1]; t:= 0;
%p for k from 0 while n mod q^k = 0 do
%p t:= t + procname(Q[2..-1],n/q^k)
%p od;
%p t
%p end proc:
%p G({},1):= 1:
%p map(f, [$1..200]); # _Robert Israel_, May 06 2018
%t ppQ[n_]:=And[n>1,GCD@@FactorInteger[n][[All,2]]>1];
%t facsp[n_]:=If[n<=1,{{}},Join@@Table[Map[Prepend[#,d]&,Select[facsp[n/d],Min@@#>=d&]],{d,Select[Divisors[n],ppQ]}]];
%t Table[Length[facsp[n]],{n,100}]
%Y Positions of zeros are A052485.
%Y Cf. A000961, A001055, A001222, A001597, A001694, A007716, A007916, A045778, A052409, A052410, A052486, A091050, A203025, A303707, A303710.
%K nonn
%O 1,16
%A _Gus Wiseman_, May 05 2018