%I
%S 138004,23,2012,136,72708,22,1449858,41,264,28,1116,107,112,44,11752,
%T 292,1047798,68,88212,71,2478418,54,452,119,220,92,582,592,40284,191,
%U 329958,89,1600550,602,516798,151,2952,140,11434,298,125714,212,39654,896,822,126
%N Least number k such that the arithmetic derivatives of the composite numbers kn and k+n are equal.
%C If the limitation of searching only for composite numbers kn and k+n is removed, the terms we get are the average of two primes.
%e a(1) = 138004 because it is the least number k such that the composites k1 and k+1 have arithmetic derivatives (k1)' = (k+1)'. We see that (138004  1)' = (138004 + 1)' = 47351;
%e a(2) = 23 because it is the least number k such that the composites k  2 and k+2 have arithmetic derivatives (k2)' = (k+2)'. We see that (23  1)' = (23 + 1).
%p with(numtheory): P:=proc(q) local a,h,n,p; for h from 2 to q do
%p for n from h to q do if not isprime(nh) and
%p (nh)*add(op(2,p)/op(1,p),p=ifactors(nh)[2])=
%p (n+h)*add(op(2,p)/op(1,p),p=ifactors(n+h)[2])
%p then print(n); break; fi; od; od; end: P(10^9);
%t ad[n_] := With[{f = FactorInteger[n]}, n*Total[f[[All, 2]]/f[[All, 1]]]];
%t okQ[n_, k_] := If[Not[CompositeQ[kn] && CompositeQ[k+n]], False, ad[kn] == ad[k+n]];
%t a[n_] := For[k = 1, True, k++, If[okQ[n, k], Print["a(", n, ") = ", k]; Return[k]]];
%t Array[a, 46] (* _JeanFrançois Alcover_, Dec 20 2017 *)
%Y Cf. A003415, A087711.
%K nonn,easy
%O 1,1
%A _Paolo P. Lava_, Dec 12 2017
