A296341 Least number k such that the arithmetic derivatives of the composite numbers k-n and k+n are equal.

138004, 23, 2012, 136, 72708, 22, 1449858, 41, 264, 28, 1116, 107, 112, 44, 11752, 292, 1047798, 68, 88212, 71, 2478418, 54, 452, 119, 220, 92, 582, 592, 40284, 191, 329958, 89, 1600550, 602, 516798, 151, 2952, 140, 11434, 298, 125714, 212, 39654, 896, 822, 126

Offset: 1

Author

Paolo P. Lava, Dec 12 2017

Keywords

• nonn
• easy

Comments

If the limitation of searching only for composite numbers k-n and k+n is removed, the terms we get are the average of two primes.

Examples

			a(1) = 138004 because it is the least number k such that the composites k-1 and k+1 have arithmetic derivatives (k-1)' = (k+1)'. We see that (138004 - 1)' = (138004 + 1)' = 47351;
a(2) = 23 because it is the least number k such that the composites k - 2 and k+2 have arithmetic derivatives (k-2)' = (k+2)'. We see that (23 - 1)' = (23 + 1).
		

Crossrefs

Cf. A003415, A087711.

Programs

Maple

with(numtheory): P:=proc(q) local a,h,n,p; for h from 1 to q do
for n from h to q do if not isprime(n-h) and
(n-h)*add(op(2,p)/op(1,p),p=ifactors(n-h)[2])=
(n+h)*add(op(2,p)/op(1,p),p=ifactors(n+h)[2])
then print(n); break; fi; od; od; end: P(10^9);

Mathematica

ad[n_] := With[{f = FactorInteger[n]}, n*Total[f[[All, 2]]/f[[All, 1]]]];
okQ[n_, k_] := If[Not[CompositeQ[k-n] && CompositeQ[k+n]], False, ad[k-n] == ad[k+n]];
a[n_] := For[k = 1, True, k++, If[okQ[n, k], Print["a(", n, ") = ", k]; Return[k]]];
Array[a, 46] (* Jean-François Alcover, Dec 20 2017 *)