%I #36 Jan 10 2024 23:58:59
%S 1,1,1,1,0,1,1,1,0,1,1,1,0,1,1,0,0,1,1,1,0,1,1,1,0,1,0,0,0,1,1,1,0,1,
%T 1,0,0,1,1,0,0,1,1,1,0,0,1,1,0,1,0,0,0,1,0,0,0,1,1,1,0,1,1,0,0,1,1,1,
%U 0,0,1,1,0,1,0,0,0,1,1,1,0,0,1,1,0,1,0,0,0,1,0,0,0,1,1,0,0,1,1,0,0,1,0,1,0,1
%N a(n) = 1 if k-th arithmetic derivative of n is zero for some k, otherwise 0.
%C Question: What is the asymptotic mean of this and related sequences like A368915? Compare also to A341996, A359543 and A359546.
%H Antti Karttunen, <a href="/A328308/b328308.txt">Table of n, a(n) for n = 0..65537</a>
%H Michael De Vlieger, <a href="/A328308/a328308.png">Bitmap of a(n)</a>, n = 0..2^24, 2048 X 2048 pixels, with 0 in white and 1 in black. Furnishes 4260302 terms of A099308.
%H Victor Ufnarovski and Bo Åhlander, <a href="https://cs.uwaterloo.ca/journals/JIS/VOL6/Ufnarovski/ufnarovski.html">How to Differentiate a Number</a>, J. Integer Seq., Vol. 6 (2003), Article 03.3.4.
%H <a href="/index/Ch#char_fns">Index entries for characteristic functions</a>
%F For prime p, a(p) = 1, a(p^p * m) = 0, for all m >= 1. a(4m) = 0 for m > 0. - _Michael De Vlieger_, Jan 04 2023
%F From _Antti Karttunen_, Jan 06 2023: (Start)
%F a(0) = 1; and for n > 0, a(n) = A359550(n) * a(A003415(n)). [Provided that Conjecture 3 given on page 5 of Ufnarovski and Åhlander 2003 paper holds, i.e., that map x -> x' never forms nontrivial loops]
%F a(n) = 1 - A341999(n).
%F a(n) >= A359543(n).
%F (End)
%F For all n > 1, a(n) <= A368915(n) <= A359550(n). - _Antti Karttunen_, Jan 10 2024
%t w = {}; nn = 2^10; k = 1; While[Set[m, #^#] <= nn &[Prime[k]], AppendTo[w, m]; k++]; a3415[n_] := a3415[n] = Which[Abs@ n < 2, 0, PrimeQ[n], 1, True, n Total[#2/#1 & @@@ FactorInteger[Abs@ n]]]{1, 1}~Join~Reap[Do[Which[PrimeQ[n], Sow[1], MemberQ[w, n], Sow[0], True, If[NestWhileList[a3415, n, And[! Divisible[#, 4], FreeQ[w, #]] &, 1][[-1]] == 0, Sow[1], Sow[0]]], {n, 2, nn}]][[-1, -1]] (* _Michael De Vlieger_, Jan 04 2023 *)
%t (* 2nd program: generate m <= 2^24 terms of the sequence from the bitmap above: *)
%t m = 10^3; Flatten[ImageData[Import["https://oeis.org/A328308/a328308.png"], "Bit"]][[1 ;; m]] /. {0 -> 1, 1 -> 0} (* _Michael De Vlieger_, Jan 04 2023 *)
%o (PARI)
%o A003415checked(n) = if(n<=1, 0, my(f=factor(n), s=0); for(i=1, #f~, if(f[i,2]>=f[i,1],return(0), s += f[i, 2]/f[i, 1])); (n*s));
%o A328308(n) = if(!n,1, while(n>1, n = A003415checked(n)); (n));
%Y Characteristic function of A099308.
%Y Cf. A003415, A099309 (positions of zeros), A256750, A328306 [= a(A276086(n))], A328309 (partial sums), A341996, A341999 (one's complement), A342023, A351071, A359541 (inverse Möbius transform), A359543, A359546, A359550, A368915.
%K nonn
%O 0
%A _Antti Karttunen_, Oct 12 2019