A195061 a(n) is the minimum numbers of ks in the sum of a=b_k+c_k, b_k is positive even number and c_k is odd number greater than or equal to -1, and b and c has only prime factors smaller than sqrt(prime(n)), such that the prime factors of all b_k and c_k contain every primes that is smaller than the square root of n-th prime.
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2
Offset: 2
Examples
for n=2, prime(2)=3, 3=2+1, PP={2}, b=2, c=1, TT={2}=PP, so a(2)=1; for n=3, prime(3)=5, 5=2^2+1, PP={2}, b=2^2, c=1, TT={2}=PP, so a(3)=1; ... for n=37, prime(37)=157, 157=2*5+3*7^2=2*11+3^3*5, PP={2,3,5,7,11}, b1=2*5, c1=3*7^2; b2=2*11, c2=3^3*5; TT={2,3,5,7,11}=PP, so a{37}=2
Crossrefs
Cf. A196526.
Programs
-
Mathematica
AllPrimes[k_] := Module[{p, maxfactor, pset}, p = Prime[k]; maxfactor = NextPrime[IntegerPart[Sqrt[p]] + 1, -1]; If[maxfactor == -2, pset = {2}, p0 = 2; pset = {2}; While[p0 = NextPrime[p0]; p0 <= maxfactor, pset = Union[pset, {p0}]]]; pset]; NextIntegerWithFactor[seed_, fset_] := Module[{m, a, l, i, fset1}, m = seed - 1; While[m++; If[Mod[m, 2] == 1, m++]; a = FactorInteger[m]; l = Length[a]; fset1 = {}; Do[fset1 = Union[fset1, {a[[i]][[1]]}], {i, 1, l}]; Intersection[fset1, fset] != fset1]; m]; FactorSet[seed_] := Module[{fset2, a, l, i}, a = FactorInteger[seed]; l = Length[a]; fset2 = {}; Do[fset2 = Union[fset2, {a[[i]][[1]]}], {i, 1, l}]; fset2]; SplitPrime[n_, q0_] := Module[{p, pset, q, r, rp, fs, rs, qs}, p = Prime[n]; pset = AllPrimes[n]; q = q0; While[q++; q = NextIntegerWithFactor[q, pset]; r = p - q; rp = Abs[r]; fs = FactorSet[rp]; rs = Complement[pset, FactorSet[q]]; qs = Intersection[fs, rs]; (fs != {1}) && (fs != qs) && (q <= (p + 1))]; {p, q, r} ]; AllSplits[n_] := Module[{q, ss, spls}, q = 0; spls = {}; While[ss = SplitPrime[n, q]; q = ss[[2]]; If[q <= (Prime[n] + 1), spls = Union[spls, {ss}]]; q < (Prime[n] + 1)]; spls]; Checkk[k_, n_] := Module[{allp, checkp, fsp, alls, subs, esubs, lsub, found, i, j}, allp = AllPrimes[n]; alls = AllSplits[n]; subs = Subsets[alls, {k}]; lsub = Length[subs]; i = 0; found = 0; While[(found == 0) && (i < lsub), i++; esubs = subs[[i]]; checkp = {}; Do[fsp = FactorSet[esubs[[j]][[2]]]; checkp = Union[checkp, fsp]; If[Abs[esubs[[j]][[3]]] != 1, fsp = FactorSet[esubs[[j]][[3]]]; checkp = Union[checkp, fsp]], {j, 1, k}]; If[Length[checkp] == Length[allp], found = 1]]; found]; Checks[n_] := Module[{found, i}, found = 0; i = 0; While[found == 0, i++; found = Checkk[i, n]]; i]; Table[ Checks[i], {i, 2, 100}]
Comments