|
%I #8 Mar 17 2016 04:22:41
%S 3,4,5,7,142,581,6127,8549,12643,16999,51703,57121,86833,89195,92029,
%T 103039,104647,112093,137317,149851,218269,261883,266923,323723,
%U 336273,449881,505891,524371,610171,617569,907873,999643,1119253,1134227,1728787,1900523,2045171
%N Numbers whose arithmetic derivative is equal to the sum of some fixed power of their digits.
%H Paolo P. Lava, <a href="/A269719/a269719_1.txt">Terms of the sequence and their fixed power</a>
%e 3^0 = 1 and 3' = 1;
%e 4^1 = 4 and 4' = 4;
%e 1^3 + 4^3 + 2^3 = 73 and 143' = 73.
%p with(numtheory): P:= proc(q) local a, b, c, d,j, k, n, ok; for n from 3 to q do a:=[]; b:=n; ok:=0;
%p d:=n*add(op(2,p)/op(1,p),p=ifactors(n)[2]); a:=[]; b:=n; ok:=0;
%p for k from 1 to ilog10(n)+1 do if (b mod 10)>1 then ok:=1; fi; a:=[(b mod 10), op(a)]; b:=trunc(b/10); od; b:=-1; c:=0;
%p if ok=1 then while c<d do b:=b+1;
%p if b>0 then c:=add(a[k]^b, k=1..nops(a)); else for k from 1 to nops(a) do if a[k]=0 then c:=0; break;
%p else c:=c+1; fi; od; fi; od; if c=d then lprint(n,b); fi; fi; od; end: P(10^9);
%t f[n_] := If[Abs@ n < 2, 0, n Total[#2/#1 & @@@ FactorInteger@ Abs@ n]]; Select[Range[3, 10^5], Function[k, IntegerQ@ SelectFirst[Range[0, 10], Function[d, If[MemberQ[d, 0] && # == 0, Total@ Power[d /. 0 -> Nothing, #] == f@ k, Total@ Power[d, #] == f@ k]]@ IntegerDigits@ k &]]] (* _Michael De Vlieger_, Mar 04 2016, Version 10, f(n) after _Michael Somos_ at A003415 *)
%Y Cf. A003415.
%K nonn,easy
%O 1,1
%A _Paolo P. Lava_, Mar 04 2016
|
