A276237 - OEIS

%I #28 Oct 06 2020 04:26:46

%S 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,

%T 2,49,4,625,32,729,128,1,3,4,343,6,3125,64,2187,256,1,2,9,8,2401,8,

%U 15625,128,6561,512,1,11,4,27,16,16807,9,78125,256,19683,1024

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

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

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

%H Robert Israel, <a href="/A276237/b276237.txt">Table of n, a(n) for n = 2..10012</a> (first 141 antidiagonals, flattened)

%e Table starts:

%e 1 2  4   8   16    32     64    128     256

%e 1 3  9  27   81   243    729   2187    6561

%e 1 2  4   8   16    32     64    128     256

%e 1 5 25 125  625  3125  15625  78125  390625

%e 1 2  3   4    6     8      9     12      16

%e 1 7 49 343 2401 16807 117649 823543 5764801

%e 1 2  4   8   16    32     64    128     256

%e 1 3  9  27   81   243    729   2187    6561

%e 1 2  4   5    8    10     16     20      25

%p getRow:= proc(S,nk) option remember; local Q,x,count;

%p   if nops(S) = 1 then [seq(S[1]^i,i=0..nk-1)]

%p   elif nops(S) = 2 then

%p     Q:= sort([seq(seq(S[1]^i*S[2]^j,i=0..nk-1),j=0..nk-1)]);

%p     Q[1..nk]

%p   else

%p     Q:= NULL;

%p     count:= 0;

%p     for x from 1 while count < nk do

%p       if numtheory:-factorset(x) subset S then

%p         count:= count+1;

%p         Q:= Q, x

%p       fi

%p     od;

%p     [Q]

%p   fi

%p end proc:

%p N:= 20: # for the first N-2 antidiagonals

%p A:= Matrix(N-1,N-2):

%p for n from 2 to N-1 do

%p    A[n,1..N-n]:= Vector[row](getRow(numtheory:-factorset(n),N-n))

%p od:

%p seq(seq(A[s-m,m],m=1..s-2),s=3..N);

%t 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]]]]]];

%t M = 20;(* for the first M-2 antidiagonals *)

%t A = Array[0, {M - 1, M - 2}];

%t For[n = 2, n <= M - 1, n++, A[[n, 1 ;; M - n]] = getRow[FactorInteger[n][[All, 1]], M - n]];

%t Table[A[[s - m, m]], {s, 3, M}, {m, 1, s - 2}] // Flatten (* _Jean-François Alcover_, Oct 06 2020, after _Robert Israel_ *)

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

%Y Cf.: A020639.

%K nonn,tabl

%O 2,3

%A _Robert Israel_, Dec 12 2016