OFFSET
1,17
COMMENTS
Most positive integers are averages of pairs of coprime composite numbers (c1, c2), as of A141097.
For any 2*n=c1+c2, 2*n, c1, and c2 are coprime to each other.
Suppose c1=a*p1, c2=b*p2, where p1 and p2 are the smallest and second smallest prime numbers that are not factors of n; this sequence lists the smallest possible a value for any positive integer n.
The first Mathematica program checks through all number pairs to obtain this sequence. The second analytically calculates it. The results of the two programs are consistent up to n=100000.
LINKS
Lei Zhou, Table of n, a(n) for n = 1..10000
EXAMPLE
When n <= 16, 2*n cannot be written as the sum of a pair of coprime composites, so a(n)=0 for n=1..16.
When n=17, 3 and 5 are the smallest primes that are not factors of 17, 2*n=34=3*3+5*5, 9 and 25 are coprime composites, so a(17)=9/3=3.
...
When n=31, 3 and 5 are the smallest primes that are not factors of 31, 2*n=62=3*9+5*7, 27 and 35 are coprime composites, so a(31)=27/3=9.
MATHEMATICA
OddPrimeFactors[n_] := Block[{nn = Round[Abs[n]], ans = {}}, If[nn > 1, ans = Transpose[FactorInteger[nn]][[1]]; If[EvenQ[nn], ans = Delete[ans, 1]]]; ans]; (* Subroutine for listing the odd prime factors of n *)
FirstTwoPrimeNofactors[n_] := Block[{opf = OddPrimeFactors[n], tdo = 2, p = 2, ftpp = {}}, While[tdo > 0, p = NextPrime[p]; If[! MemberQ[opf, p], ftpp = Append[ftpp, p]; tdo--]]; ftpp]; (* Subroutine for finding the first two prime non-factors *)
Table[{f1, f2} = FirstTwoPrimeNofactors[i]; n = 2*i; ans = 0; t1 = f1^2;
While[t2 = n - t1; (Mod[t2, f2] != 0) || (! CoprimeQ[t1, t2]), t1 = t1 + f1]; If[(t1 < n) && (t2 >= (f1*f2)), ans = t1/f1]; ans, {i, 84}]
(* Method 1: Scan t1 by the interval of f1 until a candidate is found.*)
k[p1_, p2_] := Block[{r, pb = p1, s0, s = 1, ans}, While[r = Ceiling[p2/pb]*pb - p2; If[Abs[r] > (Abs[pb]/2), If[r > 0, r = r - Abs[pb], r = r + Abs[pb]]]; s0 = (p2 + r)/pb; s = Mod[s*s0, p2]; Abs[r] != 1, pb = r]; If[r == 1, ans = Mod[s*(p2 - 1), p2], ans = Mod[s, p2]]; ans]; (* Subroutine for function k in Method 2. *)
Table[opf = OddPrimeFactors[i]; {f1, f2} = FirstTwoPrimeNofactors[i];
k1 = k[f1, f2]; r2 = Mod[2*i, f2]; diff = Mod[-r2*k1, f2];
If[EvenQ[diff], diff = diff + f2]; While[(diff < f1) || (Intersection[Transpose[FactorInteger[diff]][[1]], opf] != {}), diff = diff + 2*f2]; If[((diff*f1) + (f2)^2) > (2*i), diff = 0]; diff, {i, 84}]
(* Method 2: Calculate minimum diff regardless if it has co-factor with i first, then scan diff by interval of 2*f2 until diff and i are coprime pair.*)
CROSSREFS
KEYWORD
nonn,easy
AUTHOR
Lei Zhou, Dec 12 2012
STATUS
approved