%I #17 Apr 09 2021 09:21:45
%S 1,1,1,2,1,2,12,8,1,2,6,4,50,24,16,16,1,2,6,4,126,62,46,26,1486,100,
%T 1142,48,2056,32,342,10,1,2,6,4,94,24,72,18,242,120,1588,54,3408,92,
%U 1740,22,6846,2972,4340,766,5048,1374,652,376,71156,22710,20390,64,738580,4272,568,20,1,2,6,4,264,12,196,8,318
%N a(n) = A342001(A342456(n)); "wild part" of the arithmetic derivative of A342456(n).
%C Like in A342462, also here the subsequences starting at each n = 2^k seem to be slowly converging towards A329886: 1, 2, 6, 4, 30, 12, 36, 8, 210, 60, ...
%H Antti Karttunen, <a href="/A342463/b342463.txt">Table of n, a(n) for n = 0..8192</a>
%H <a href="/index/Bi#binary">Index entries for sequences related to binary expansion of n</a>
%H <a href="/index/Pri#primorialbase">Index entries for sequences related to primorial base</a>
%F a(n) = A342001(A342456(n)) = A342002(A329886(n)) = A342920(A005940(1+n)).
%t Block[{a, f, r = MixedRadix[Reverse@ Prime@ Range@ 24]}, f[n_] := Times @@ MapIndexed[Prime[First[#2]]^#1 &, Reverse@ IntegerDigits[n, r]]; a[0] = 1; a[1] = 2; a[n_] := a[n] = If[EvenQ@ n, (Times @@ Map[Prime[PrimePi@ #1 + 1]^#2 & @@ # &, FactorInteger[#]] - Boole[# == 1])*2^IntegerExponent[#, 2] &[a[n/2]], 2 a[(n - 1)/2]]; Array[#1/#2 & @@ {If[# < 2, 0, # Total[#2/#1 & @@@ FactorInteger[#]]] &@ Abs[#], #/Times @@ FactorInteger[#][[All, 1]]} &@ f@ a[#] &, 73, 0]] (* _Michael De Vlieger_, Mar 17 2021 *)
%o (PARI)
%o \\ Needs also code from A342456.
%o A003415(n) = if(n<=1, 0, my(f=factor(n)); n*sum(i=1, #f~, f[i, 2]/f[i, 1]));
%o A003557(n) = (n/factorback(factorint(n)[, 1]));
%o A342001(n) = (A003415(n) / A003557(n));
%o A342463(n) = A342001(A342456(n));
%Y Cf. A003415, A003557, A005940, A108951, A329886, A342001, A342002, A342456, A342462, A342920.
%K nonn,look
%O 0,4
%A _Antti Karttunen_, Mar 15 2021
|