A220093 a(n) is the smallest odd positive integer > 1 that makes the composite number 2*n-a(n)*p1 divisible by p2, where p1 and p2 are the smallest and 2nd smallest odd prime numbers that are not factors of n. When no such odd positive integer exists, a(n)=0.

0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 3, 7, 0, 0, 9, 0, 0, 11, 0, 9, 3, 0, 11, 0, 0, 3, 7, 0, 0, 9, 0, 7, 21, 0, 9, 3, 0, 11, 3, 5, 3, 7, 0, 0, 9, 13, 7, 11, 0, 9, 3, 0, 11, 27, 0, 3, 7, 0, 0, 9, 5, 7, 11, 0, 9, 3, 0, 11, 9, 17, 3, 7, 5

Offset: 1

Author

Lei Zhou, Dec 12 2012

Keywords

• nonn
• easy

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.

Examples

			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.
		

Links

• Lei Zhou, Table of n, a(n) for n = 1..10000

Crossrefs

Cf. A141097, A220291, A005087.

Programs

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.*)