|
%I #15 May 22 2019 21:01:50
%S 8,18,21,160,1590,2420,18620,69229,83790,279964,494520,598810,676450,
%T 1183147,4233720,5600348,14217074,20025836,64278677,425208387,
%U 604048830,750851470,1981942354
%N Consider the arithmetic derivative of a number x. Take the sum of its digits. Repeat the process deleting the first addendum and adding the previous sum. The sequence lists the numbers that after some iterations reach x.
%e 8’ = 12 : 1 + 2 = 3; 2 + 3 = 5; 3 + 5 = 8.
%e 18’ = 21 : 2 + 1 = 3; 1 + 3 = 4; 3 + 4 = 7; 4 + 7 = 11; 7 + 11 = 18.
%p with(numtheory): P:=proc(q,h) local a,b,k,p,t,v; global n; v:=array(1..h);
%p for n from 1 to q do a:=n*add(op(2,p)/op(1,p),p=ifactors(n)[2]); b:=ilog10(a)+1; if b>1 then
%p for k from 1 to b do v[b-k+1]:=(a mod 10); a:=trunc(a/10); od; t:=b+1; v[t]:=add(v[k], k=1..b);
%p while v[t]<n do t:=t+1; v[t]:=add(v[k], k=t-b..t-1); od;
%p if v[t]=n then print(n); fi; fi; od; end: P(10^9, 1000);
%t dn[n_] := If[Abs@n < 2, 0, n Total[#2/#1 & @@@ FactorInteger[Abs@n]]]; (* from _Michael Somos_, Apr 12 2011 *)
%t Select[Range[10^5], dn[#] >= 10 && (d = IntegerDigits[dn[#]]; While[Total[d] < #, d = Join[Rest[d], {Total[d]}]]; Total[d] == #) &] (* _Robert Price_, May 22 2019 *)
%Y Cf. A003415, A007629, A269307, A269308, A269309, A269310, A269312.
%K nonn,base,more
%O 1,1
%A _Paolo P. Lava_, Feb 24 2016
%E a(19)-a(23) from _Lars Blomberg_, Jan 18 2018
|
