login
A weighted crossed binomial Hodge diamond triangle from coefficients of Hodge polynomials as monomials.
0

%I #3 Oct 13 2012 14:47:50

%S 1,2,2,2,20,2,2,72,72,2,2,96,108,96,2,2,100,380,380,100,2,2,96,510,

%T 520,510,96,2,2,84,546,1820,1820,546,84,2,2,80,560,2464,2380,2464,560,

%U 80,2,2,72,504,2856,8316,8316,2856,504,72,2,2,60,450,2880,11340,10584,11340

%N A weighted crossed binomial Hodge diamond triangle from coefficients of Hodge polynomials as monomials.

%C The matrices are:

%C {1}}.

%C {{1, 1},

%C {1, 1}},

%C {{1, 0, 1},

%C {0, 20, 0},

%C {1, 0, 1}},

%C {{1,0, 0, 1},

%C {0, 36, 36, 0},

%C {0, 36, 36, 0},

%C {1, 0, 0, 1}},

%C {{1, 0, 0, 0, 1},

%C {0, 48, 0, 48, 0},

%C {0, 0, 108, 0, 0},

%C {0, 48, 0, 48, 0},

%C {1, 0, 0,0, 1}}, ...

%C Row sums are:

%C {1, 4, 24, 148, 304, 964, 1736, 4904, 8592, 23500, 40048};

%C These matrices were designed from the K3 like Hodge diamond:

%C A={{1,0,1},

%C {0,20,0],

%C {1,0,1]};

%C such that weights gave this matrix in a 'smooth' functional pattern.

%F Weight Function; f(n.d) = Floor[2 + 4*d*Sech[d/2 - n]] Matrix: T(n,m,d)= If[(n == d && m == 0) || (n == 0 && m == d) || (n == 0 && m == 0) || n*m == d^2, 1, If[n - m == 0, f[n, d]* Binomial[d, n], If[d -n - m == 0, f[m, d]*Binomial[d, m], 0]]] Binomial polynomial function: p(x,y,d) := Sum[Sum[M[d][[k, m]]*x^(k - 1)*y^(m - 1), {m, 1, d + 1}], {k, 1, d + 1}] Out_n,m=Coefficients(p(x,1,d)).

%e {{1},

%e {2, 2},

%e {2, 20, 2},

%e {2, 72, 72, 2},

%e {2, 96, 108, 96, 2},

%e {2, 100, 380, 380, 100,2},

%e {2, 96, 510, 520, 510, 96, 2},

%e {2, 84, 546, 1820, 1820, 546, 84, 2},

%e {2, 80, 560,2464, 2380, 2464, 560, 80, 2},

%e {2, 72, 504, 2856, 8316, 8316,2856, 504, 72, 2},

%e {2, 60, 450, 2880, 11340, 10584, 11340, 2880, 450,60, 2}}

%t Clear[T, M, p, a, g, f]; f[n_, d_] = Floor[2 + 4*d*Sech[d/2 - n]]; T[n_, m_, d_] := If[(n == d && m == 0) || (n == 0 && m == d) || (n == 0 && m == 0) || n*m == d^2, 1, If[n - m == 0, f[n, d]* Binomial[d, n], If[d - n - m == 0, f[m, d]*Binomial[d, m], 0]]]; M[d_] := Table[T[n, m, d], {n, 0, d}, {m, 0, d}]; TableForm[Table[M[d], {d, 1, 10}]]; p[x_, y_, d_] := Sum[Sum[M[d][[k, m]]*x^(k - 1)*y^(m - 1), {m, 1, d + 1}], {k, 1, d + 1}]; g = Table[ExpandAll[p[x, 1, d]], {d, 1, 10}]; a = Join[{{1}}, Table[CoefficientList[p[x, 1, w], x], {w, 1, 10}]]; Flatten[a] Join[{1}, Table[Apply[Plus, CoefficientList[p[x, 1, w], x]], {w, 1, 10}]]

%K nonn,uned,tabl

%O 1,2

%A _Roger L. Bagula_ and _Gary W. Adamson_, May 23 2008