On seqfans we have been calculating like crazy, trying to figure out the logic behind sequence A269254, Original Post, Proof Example.
After much discussion, we suggest the following unproven but probable premises:
- All composite sequences correspond to non-prime values $n = 2 T_m(k/2), k > 2, m > 1 \in $ primes, where $T_n$ is ChebyshevT, From Andrew Hone.
- The composite sequence $s_k$ defined by A269254 admits an m-section $XY_{k}=s_{m*k+o}$ into $m$ subsequences indexed by $o$.
- Each of the $m$ subsequences admits factorization $XY_{k} = X_{k}*Y_{k}$.
- $XY$, $X$, and $Y$ satisfy the same linear recurrences regardless of $o$ .
- The linear recurrences for $XY$ and $X$ both involve three terms, while the linear recurrence for $Y$ involves $m+1$ terms.
- The signature of the $X$ recurrence is $(n,-1)$.
If we accept these premises as true, then we can write an algorithm for proving a sequence $s_k$ entirely composite on a case-by-case basis, and look through all cases beneath a certain cutoff, say $N=10,000$. The proof algorithm is a generalization of: Case 110.
Proof Algorithm
Input: Indexes $n$ and $m$ for a sequence satisfying the above criteria.
Output: A list of proof results: True if the initial conditions of XY contain no primes, True if X strictly increases over initial conditions, True if condition four above is met, signatures of the linear recurrences, a sum which equals zero when the induction base case is satisfied, a zero-sum that indicates the induction hypothesis admits recursion.
Recurrence[n_, m_] :=
LinearRecurrence[{n, -1}, {1, n + 1}, m*(2 m + 1)]
RecurrenceFactorsX[n_, m_, rec_] := Map[Function[{o}, Select[
Flatten[
Outer[LinearRecurrence[{n, -1}, {#1, #2}, 2 m + 1] &,
Sequence @@ (Divisors /@ rec[[m*Range[2] - o]]), 1], 1],
And @@ Map[IntegerQ, rec[[m*Range[2 m + 1] - o]]/#] &][[1]]],
Range[0, m - 1]]
RecurrenceFactorsY[n_, m_, rec_, recX_] := MapThread[
Divide,
{rec[[m*Range[2 m + 1] - #]] & /@ Range[0, m - 1], recX}]
FactorMap[m_, recX_, recY_] := {
X[k] -> Total[
MapThread[Times, {Part[FindLinearRecurrence /@ recX, 1],
X[k - #] & /@ Range[2]}]],
Y[k] -> Total[
MapThread[Times, {Part[FindLinearRecurrence /@ recY, 1],
Y[k - #] & /@ Range[m]}]]}
ZeroSum[n_, 0, map_, recXY_] :=
Expand[s[k] - FindLinearRecurrence[recXY[[1]]][[1]] s[k - 1] +
s[k - 2] /. {s[z_] :> X[z] Y[z]} /. map]
ZeroSum[n_, r_, map_, recXY_] :=
Expand[ZeroSum[n, r - 1, map, recXY] /. k -> k + 1 /. map]
BasisVectors[m_] :=
Flatten@Outer[Times, X[k - #] & /@ Range[2], Y[k - #] & /@ Range[m]]
InductionBaseCase[n_, m_, recX_, recY_, recXY_] :=
Total[Total[Abs[ReplaceAll[ZeroSum[
n, #, FactorMap[m, recX, recY], recXY] & /@
Range[0, m - 1], {
X[z_] :> recX[[#, z /. k -> m + 1]],
Y[z_] :> recY[[#, z /. k -> m + 1]]
}] & /@ Range[m]]]]
InductionZeroSum[n_, m_, recX_, recY_, recXY_] := ReplaceAll[
0 == Dot[v /@ Range[0, m - 1], c /@ Range[0, m - 1] /. c[0] -> 1],
Solve[Dot[
ReplaceAll[c /@ Range[0, m - 1], c[0] -> 1],
Outer[Coefficient,
ZeroSum[n, #, FactorMap[m, recX, recY], recXY] & /@
Range[0, m - 1],
BasisVectors[m]
]] == 0, c /@ Range[m - 1]][[1]]]
A269254CompositeQ[n_, m_] := Module[
{rec, recX, recY, recXY, signatures},
rec = Recurrence[n, m];
recX = RecurrenceFactorsX[n, m, rec];
recY = RecurrenceFactorsY[n, m, rec, recX];
recXY = MapThread[Times, {recX, recY}];
signatures = MapThread[Rule,
{{XY, X, Y},
FindLinearRecurrence /@ {recXY[[1]], recX[[1]], recY[[1]]}}];
Flatten@{
And @@ (! PrimeQ[#] & /@ rec),
And @@ Map[And @@ (Less @@ # & /@ Partition[#, 2, 1]) &, recX],
And[SameQ[FindLinearRecurrence /@ recX],
SameQ[FindLinearRecurrence /@ recY],
SameQ[FindLinearRecurrence /@ recXY]],
signatures,
InductionBaseCase[n, m, recX, recY, recXY],
InductionZeroSum[n, m, recX, recY, recXY]}
]
Return
TwoList = Select[Expand[2 ChebyshevT[2, k/2]] /. k -> Range[2, 100],
2 < # < 10000 &]
ThreeList = Select[Expand[2 ChebyshevT[3, k/2]] /. k -> Range[2, 50],
2 < # < 10000 &]
FiveList = Select[Expand[2 ChebyshevT[5, k/2]] /. k -> Range[1, 25],
2 < # < 10000 &]
SevenList = Select[Expand[2 ChebyshevT[7, k/2]] /. k -> Range[1, 20],
2 < # < 10000 &]
2 ChebyshevT[11, 3/2]
Out[] = 39603
AbsoluteTiming[ Tab2 = A269254CompositeQ[#, 2] & /@ TwoList // TableForm;]
AbsoluteTiming[Tab3 = A269254CompositeQ[#, 3] & /@ ThreeList // TableForm;]
AbsoluteTiming[Tab5 = A269254CompositeQ[#, 5] & /@ FiveList // TableForm;]
AbsoluteTiming[Tab7 = A269254CompositeQ[#, 7] & /@ SevenList // TableForm;]
On my personal machine, this code evaluates in total time $t<15s$, returning the following: Proof Tables. The table essentially tells when we can expect to find a value a(n)=-1 in sequence A269254. This should be the case for any element with row starting True, True, True.