cp's OEIS Frontend

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.

%I A220093 #29 Apr 29 2021 01:37:59
%S A220093 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,
%T A220093 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,
%U A220093 27,0,3,7,0,0,9,5,7,11,0,9,3,0,11,9,17,3,7,5
%N 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.
%C A220093 Most positive integers are averages of pairs of coprime composite numbers (c1, c2), as of A141097.
%C A220093 For any 2*n=c1+c2, 2*n, c1, and c2 are coprime to each other.
%C A220093 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.
%C A220093 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.
%H A220093 Lei Zhou, <a href="/A220093/b220093.txt">Table of n, a(n) for n = 1..10000</a>
%e A220093 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.
%e A220093 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.
%e A220093 ...
%e A220093 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.
%t A220093 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 *)
%t A220093 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 *)
%t A220093 Table[{f1, f2} = FirstTwoPrimeNofactors[i]; n = 2*i; ans = 0; t1 = f1^2;
%t A220093 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}]
%t A220093 (* Method 1: Scan t1 by the interval of f1 until a candidate is found.*)
%t A220093 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. *)
%t A220093 Table[opf = OddPrimeFactors[i]; {f1, f2} = FirstTwoPrimeNofactors[i];
%t A220093 k1 = k[f1, f2]; r2 = Mod[2*i, f2]; diff = Mod[-r2*k1, f2];
%t A220093 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}]
%t A220093 (* 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.*)
%Y A220093 Cf. A141097, A220291, A005087.
%K A220093 nonn,easy
%O A220093 1,17
%A A220093 _Lei Zhou_, Dec 12 2012