A280163 - OEIS

%I #14 Jan 03 2017 12:07:53

%S 4,9,32,25,12,49,48,54,20,121,96,169,28,45,144,289,162,361,160,63,44,

%T 529,-1,250,52,-1,224,841,60,961,320,99,68,175,180,1369,76,117,240,

%U 1681,84,1849,352,270,92,2209,-1,686,-1,153,416,2809,-1,275,336,171,116

%N Least number k such that sopfr(k) - sopf(k) = k/n, -1 if such a number does not exist.

%C a(n) = n^2 for n prime.

%C Values equal to -1 are hypothetical (tested up to 2*10^10 by _Giovanni Resta_).

%e a(6) = 12 because 12 is the least number such that sopfr(12) - sopf(12) = 7 - 5 = 2 = 12/6.

%p with(numtheory): P:=proc(q) local a, j, k, n;

%p for n from 2 to q do for j from n by n to q do

%p a:=ifactors(j)[2]; if add(a[k][1]*a[k][2],k=1..nops(a))-add(a[k][1],k=1..nops(a))=j/n then

%p lprint(n,j); break; fi; od; od; end: P(10^6);

%t Table[SelectFirst[Range[n^3], Function[k, Total@ # - Total@ Union@ # == k/n &@ Flatten@ Map[ConstantArray[#1, #2] & @@ # &, #] &@ FactorInteger@ k]] /. k_ /; MissingQ@ k -> -1, {n, 2, 58}] (* Version 10.2, or *)

%t Table[k = 1; While[And[Total@ # - Total@ Union@ # != k/n, k <= n^3] &@ Flatten@ Map[ConstantArray[#1, #2] & @@ # &, #] &@ FactorInteger@ k, k++]; If[k > n^3, -1, k], {n, 2, 58}] (* _Michael De Vlieger_, Dec 28 2016 *)

%Y Cf. A007947, A008472.

%K sign

%O 2,1

%A _Paolo P. Lava_, Dec 27 2016