# What is the fastest way to make this table?

Context:

As a possible approach to Goldbach's Conjecture, we create two lists of least/greatest prime factors of the odd numbers. The lists are A090368 lpf and A076565 gpf. We get symmetric triangles, which contain all even numbers as sums of two odd primes.

m = 13;
lpf[n_] := FactorInteger[2 n + 1][[1, 1]];
gpf[n_] := FactorInteger[2 n + 1][[-1, 1]];
A090368 = Array[lpf, m];
A076565 = Array[gpf, m];
Table[A090368[[1 ;; -n]] + Reverse[A090368[[1 ;; -n]]],
{n, Length[A090368], 1, -1}];
Table[A076565[[1 ;; -n]] + Reverse[A076565[[1 ;; -n]]],
{n, Length[A076565], 1, -1}];
{%% // MatrixForm, % // MatrixForm}


Question:

Is there a faster method to reverse and add the sublists? Perhaps through indexing?

Note: I have verified to $m=200$K by wrapping a Max around the table, taking the differences and then a union to find that all differences are $2.$

• ...so... what is your question? Why should we care about this completely ad-hoc algorithm? And what, if anything, does it have to do with Goldbach? – David G. Stork Jul 13 '18 at 22:05
• @DavidG.Stork, I stated why there is no question. This is intended for those who like experimental mathematics. I have asked to have it made community wiki. – Fred Kline Jul 13 '18 at 22:42
• From the tour(): "Mathematica® Stack Exchange is a question and answer site" and "This site is all about getting answers. It's not a discussion forum." Your post is on-topic the same as would be a pizza recipe - i.e., completely off-topic. – corey979 Jul 13 '18 at 23:00
• Yeah, we do not want to be amused! If your question had the phrase “What is the fastest way to make this table with MMA?” then it would have had at least 10 different answers with timings, graphs, heated discussion … the works. – Hector Jul 13 '18 at 23:04
• @Hector you can edit the question too if you find the topic interesting :) Fred Klein, they are right but it is also true that it is not hard to rephrase it to fit SE format. – Kuba Jul 14 '18 at 5:46

I don't understand what you try to do, but the tables can be generated faster as follows.

cf = Compile[{{a, _Integer}, {b, _Integer, 1}},
a + b,
CompilationTarget -> "WVM",
RuntimeAttributes -> {Listable},
Parallelization -> True,
RuntimeOptions -> "Speed"
];

m = 2000;
pf[n_] := FactorInteger[2 n + 1][[{1, -1}, 1]];
{a, b} = Transpose[Array[pf, m]]; // AbsoluteTiming // First
A = cf[a, a]; // AbsoluteTiming // First
B = cf[b, b]; // AbsoluteTiming // First


0.006257

0.008116

0.003796

Compare the antidiagonals of A and B to the rows of A090368 and A076565, respectively.

m1 = 13;
tab = Grid[
A[[1 ;; m1, 1 ;; m1]],
Frame -> All,
Background -> {
None, None,
Flatten[
Outer[{##} -> ColorData[97][Plus[##] - 1] &, Range[m1],
Range[m1]]]
}]