A276237 Table read by antidiagonals: row n consists of k>=1 such that all primes dividing k divide n.

1, 1, 2, 1, 3, 4, 1, 2, 9, 8, 1, 5, 4, 27, 16, 1, 2, 25, 8, 81, 32, 1, 7, 3, 125, 16, 243, 64, 1, 2, 49, 4, 625, 32, 729, 128, 1, 3, 4, 343, 6, 3125, 64, 2187, 256, 1, 2, 9, 8, 2401, 8, 15625, 128, 6561, 512, 1, 11, 4, 27, 16, 16807, 9, 78125, 256, 19683, 1024

Offset

2,3

Comments

If n is a power of prime p, row p consists of all powers of p.

Column 2 is A020639 (for n>=2).

Links

Robert Israel, Table of n, a(n) for n = 2..10012 (first 141 antidiagonals, flattened)

Example

Table starts:
1 2  4   8   16    32     64    128     256
1 3  9  27   81   243    729   2187    6561
1 2  4   8   16    32     64    128     256
1 5 25 125  625  3125  15625  78125  390625
1 2  3   4    6     8      9     12      16
1 7 49 343 2401 16807 117649 823543 5764801
1 2  4   8   16    32     64    128     256
1 3  9  27   81   243    729   2187    6561
1 2  4   5    8    10     16     20      25

Maple

getRow:= proc(S, nk) option remember; local Q, x, count;
  if nops(S) = 1 then [seq(S[1]^i, i=0..nk-1)]
  elif nops(S) = 2 then
    Q:= sort([seq(seq(S[1]^i*S[2]^j, i=0..nk-1), j=0..nk-1)]);
    Q[1..nk]
  else
    Q:= NULL;
    count:= 0;
    for x from 1 while count < nk do
      if numtheory:-factorset(x) subset S then
        count:= count+1;
        Q:= Q, x
      fi
    od;
    [Q]
  fi
end proc:
N:= 20: # for the first N-2 antidiagonals
A:= Matrix(N-1, N-2):
for n from 2 to N-1 do
   A[n, 1..N-n]:= Vector[row](getRow(numtheory:-factorset(n), N-n))
od:
seq(seq(A[s-m, m], m=1..s-2), s=3..N);

Mathematica

getRow[S_, nk_] := getRow[S, nk] = Module[{Q, x, count}, If[Length[S] == 1, Table[S[[1]]^i, {i, 0, nk - 1}], If[Length[S] == 2, Q = Sort[Flatten[ Table[Table[S[[1]]^i S[[2]]^j, {i, 0, nk - 1}], {j, 0, nk - 1}]]]; Q[[1 ;; nk]], Q = Nothing; count = 0; For[x = 1, count < nk, x++, If[ FactorInteger[x][[All, 1]] ~Subset~ S, count++; AppendTo[Q, x]]]]]];
M = 20; (* for the first M-2 antidiagonals *)
A = Array[0, {M - 1, M - 2}];
For[n = 2, n <= M - 1, n++, A[[n, 1 ;; M - n]] = getRow[FactorInteger[n][[All, 1]], M - n]];
Table[A[[s - m, m]], {s, 3, M}, {m, 1, s - 2}] // Flatten (* Jean-François Alcover, Oct 06 2020, after Robert Israel *)

Crossrefs

Cf.: A003586 (row 6), A003592 (row 10).

Cf.: A020639.

Sequence in context: A345290 A330669 A084579 * A059663 A338367 A186975

Adjacent sequences: A276234 A276235 A276236 * A276238 A276239 A276240

Keyword

nonn,tabl

Author

Robert Israel, Dec 12 2016

Status

approved