|
%I #25 Oct 04 2018 19:37:56
%S 1,1,2,1,3,4,1,3,4,1,5,10,12,1,3,4,1,7,18,26,28,1,5,11,15,16,1,7,19,
%T 29,32,1,5,10,12,1,11,42,84,110,116,1,5,11,15,16,1,13,58,137,209,242,
%U 248,1,7,21,37,46,48,1,9,30,55,69,72,1,9,33,69,98,110,112
%N Irregular triangle T(n,k), n>=1, 1<=k<=A186971(n), read by rows: T(n,k) is the number of subsets of {1, 2, ..., n} containing n and having <=k pairwise coprime elements.
%C T(n,k) = T(n,k-1) for k>A186971(n). The triangle contains all values of T up to the last element of each row that is different from its predecessor.
%H Alois P. Heinz, <a href="/A186975/b186975.txt">Rows n = 1..200, flattened</a>
%F T(n,k) = Sum_{i=1..k} A186972(n,i).
%e T(5,3) = 10 because there are 10 subsets of {1,2,3,4,5} containing n and having <=3 pairwise coprime elements: {5}, {1,5}, {2,5}, {3,5}, {4,5}, {1,2,5}, {1,3,5}, {1,4,5}, {2,3,5}, {3,4,5}.
%e Triangle T(n,k) begins:
%e 1;
%e 1, 2;
%e 1, 3, 4;
%e 1, 3, 4;
%e 1, 5, 10, 12;
%e 1, 3, 4;
%e 1, 7, 18, 26, 28;
%p with(numtheory):
%p s:= proc(m,r) option remember; mul(`if`(i<r, i, 1), i=factorset(m)) end:
%p a:= proc(n) option remember; `if`(n<4, n, pi(n)-nops(factorset(n))+2) end:
%p b:= proc(t, n, k) option remember; local c, d, h;
%p if k=0 or k>n then 0
%p elif k=1 then 1
%p elif k=2 and t=n then `if`(n<2, 0, phi(n))
%p else c:= 0;
%p d:= 2-irem(t, 2);
%p for h from 1 to n-1 by d do
%p if igcd(t, h)=1 then c:= c +b(s(t*h, h), h, k-1) fi
%p od; c
%p fi
%p end:
%p T:= proc(n, k) option remember;
%p b(s(n, n), n, k) +`if`(k=0, 0, T(n, k-1))
%p end:
%p seq(seq(T(n, k), k=1..a(n)), n=1..20);
%t s[m_, r_] := s[m, r] = Product[If[i < r, i, 1], {i, FactorInteger[m][[All, 1]]}]; a[n_] := a[n] = If[n < 4, n, PrimePi[n]-Length[FactorInteger[n]]+2]; b[t_, n_, k_] := b[t, n, k] = Module[{c, d, h}, Which[k == 0 || k > n, 0, k == 1, 1, k == 2 && t == n, If[n < 2, 0, EulerPhi[n]], True, c = 0; d = 2-Mod[t, 2]; For[h = 1, h <= n-1, h = h+d, If[GCD[t, h] == 1, c = c+b[s[t*h, h], h, k-1] ] ]; c ] ]; t[n_, k_] := t[n, k] = b[s[n, n], n, k]+If[k == 0, 0, t[n, k-1]]; Table[Table[t[n, k], {k, 1, a[n]}], {n, 1, 20}] // Flatten (* _Jean-François Alcover_, Dec 19 2013, translated from Maple *)
%Y Columns k=1-9 give: A000012, A039649 for n>1, A186987, A186988, A186989, A186990, A186991, A186992, A186993.
%Y Rightmost elements of rows give A186973.
%Y Cf. A186971, A186972.
%K nonn,look,tabf
%O 1,3
%A _Alois P. Heinz_, Mar 02 2011
|
