|
%I #20 Aug 12 2023 04:39:48
%S 1,1,1,1,1,2,1,1,1,1,1,2,1,3,2,4,5,5,1,1,2,1,1,1,1,1,1,1,1,1,2,1,1,1,
%T 2,1,1,1,1,2,1,1,1,1,1,1,1,1,2,1,1,2,2,2,3,1,1,1,2,1,1,1,1,1,1,1,1,1,
%U 1,1,1,1,2,1,1,2,1,1,1,1,1,1,2,2,1,2,2,3,1,2,1,1,1,1,1
%N The length of the initial uninterrupted number of tau numbers in the chain defined by repeated subtraction of the number of divisors, starting with the n-th tau number.
%C This is the persistence of the n-th tau number staying a tau number under the map x->A049820(x).
%C Records: 1, 2,...,8 occur at n=1, 6, 14, 16, 17, 7393, 7394, 8064,...
%H C. Meller, <a href="http://numbersandmath.blogspot.de/2016/06/tau-numbers.html">Tau numbers</a>, June 2016.
%e a(196)=4 because the 196th tau number is 2016. Subtracting tau(2016)=36 gives 1980, which is a tau number. Subtracting tau(1980)=36 gives 1944, which is a tau number. Subtracting tau(1944)=24 gives 1920, which is a tau number. Subtracting tau(1920)=32 gives 1888 which is not a tau number. The length of the chain 2016->1980->1944->1920 is 4.
%p isA033950 := proc(n)
%p if n <= 0 then
%p false;
%p elif n = 1 then
%p true;
%p else
%p modp(n, numtheory[tau](n)) = 0 ;
%p end if;
%p end proc:
%p A274468 := proc(n)
%p option remember;
%p local a, t ;
%p t := A033950(n) ;
%p a := 1 ;
%p while true do
%p t := A049820(t) ;
%p if isA033950(t) then
%p a := a+1 ;
%p else
%p break;
%p end if;
%p end do:
%p a ;
%p end proc:
%t isA033950[n_] := Which[n <= 0, False, n == 1, True, True, IntegerQ[ n/DivisorSigma[0, n]]];
%t A033950[n_] := A033950[n] = Module[{k}, If[n == 1, 1, For[k = A033950[n-1] + 1, True, k++, If[IntegerQ[k/DivisorSigma[0, k]], Return[k]]]]];
%t A274468[n_] := A274468[n] = Module[{a, t}, t = A033950[n]; a = 1; While[ True, t = t-DivisorSigma[0, t]; If[isA033950[t], a++, Break[]]]; a];
%t Table[A274468[n], {n, 1, 100}] (* _Jean-François Alcover_, Aug 11 2023, after _R. J. Mathar_ *)
%Y Cf. A033950, A049820.
%K nonn
%O 1,6
%A _R. J. Mathar_, Jun 24 2016
|
