The OEIS is supported by the many generous donors to the OEIS Foundation.

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

0

`%I #24 Jun 23 2024 02:21:35
`

`%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 k-n and k+n are equal.
`

`%C 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.
`

`%e 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;
`

`%e 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).
`

`%p with(numtheory): P:=proc(q) local a,h,n,p; for h from 1 to q do
`

`%p for n from h to q do if not isprime(n-h) and
`

`%p (n-h)*add(op(2,p)/op(1,p),p=ifactors(n-h)[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[k-n] && CompositeQ[k+n]], False, ad[k-n] == 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] (* _Jean-François Alcover_, Dec 20 2017 *)
`

`%Y Cf. A003415, A087711.
`

`%K nonn,easy
`

`%O 1,1
`

`%A _Paolo P. Lava_, Dec 12 2017
`