What is the fastest way to make this table?

Question

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.$

Answer 1

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]]]
    }]