cp's OEIS Frontend

This is a front-end for the Online Encyclopedia of Integer Sequences, made by Christian Perfect. The idea is to provide OEIS entries in non-ancient HTML, and then to think about how they're presented visually. The source code is on GitHub.

Showing 1-7 of 7 results.

A325014 Array read by descending antidiagonals: A(n,k) is the number of chiral pairs of colorings of the facets of a regular n-dimensional orthoplex using up to k colors.

Original entry on oeis.org

0, 1, 0, 3, 0, 0, 6, 3, 1, 0, 10, 15, 66, 94, 0, 15, 45, 920, 97974, 1047816, 0, 21, 105, 6350, 10700090, 481141220994, 400140831558512, 0, 28, 210, 29505, 390081800, 4802390808840576, 74515656021475803734579625, 527471421741473576372948457251328, 0
Offset: 1

Views

Author

Robert A. Russell, May 27 2019

Keywords

Comments

Also called cross polytope and hyperoctahedron. For n=1, the figure is a line segment with two vertices. For n=2 the figure is a square with four edges. For n=3 the figure is an octahedron with eight triangular faces. For n=4, the figure is a 16-cell with sixteen tetrahedral facets. The Schläfli symbol, {3,...,3,4}, of the regular n-dimensional orthoplex (n>1) consists of n-2 threes followed by a four. Each of its 2^n facets is an (n-1)-dimensional simplex. The chiral colorings of its facets come in pairs, each the reflection of the other.
Also the number of chiral pairs of colorings of the vertices of a regular n-dimensional orthotope (cube) using up to k colors.

Examples

			Array begins with A(1,1):
0  1     3        6        10         15          21           28 ...
0  0     3       15        45        105         210          378 ...
0  1    66      920      6350      29505      106036       317856 ...
0 94 97974 10700090 390081800 7280687610 86121007714 730895668104 ...
For A(2,3)=3, each square has one of the three colors on two adjacent edges.
		

Crossrefs

Cf. A325012 (oriented), A325013 (unoriented), A325015 (achiral), A325018 (exactly k colors).
Other n-dimensional polytopes: A007318(k,n+1) (simplex), A325006 (orthotope).
Rows 1-2 are A161680, A050534.

Programs

  • Mathematica
    a48[n_] := a48[n] = DivisorSum[NestWhile[#/2&, n, EvenQ], MoebiusMu[#]2^(n/#)&]/(2n); (* A000048 *)
    a37[n_] := a37[n] = DivisorSum[n, MoebiusMu[n/#]2^#&]/n; (* A001037 *)
    CI0[{n_Integer}] := CI0[{n}] = CI[Transpose[If[EvenQ[n], p2 = IntegerExponent[n, 2]; sub = Divisors[n/2^p2]; {2^(p2+1) sub, a48 /@ (2^p2 sub) }, sub = Divisors[n]; {sub, a37 /@ sub}]]] 2^(n-1); (* even perm. *)
    CI1[{n_Integer}] := CI1[{n}] = CI[sub = Divisors[n]; Transpose[If[EvenQ[n], {sub, a37 /@ sub}, {2 sub, a48 /@ sub}]]] 2^(n-1); (* odd perm. *)
    compress[x : {{, } ...}] := (s = Sort[x]; For[i = Length[s], i > 1, i -= 1, If[s[[i, 1]]==s[[i-1, 1]], s[[i-1, 2]] += s[[i, 2]]; s = Delete[s, i], Null]]; s)
    cix[{a_, b_}, {c_, d_}] := {LCM[a, c], (a b c d)/LCM[a, c]};
    Unprotect[Times]; Times[CI[a_List], CI[b_List]] :=  (* combine *) CI[compress[Flatten[Outer[cix, a, b, 1], 1]]]; Protect[Times];
    CI0[p_List] := CI0[p] = Expand[CI0[Drop[p, -1]] CI0[{Last[p]}] + CI1[Drop[p, -1]] CI1[{Last[p]}]]
    CI1[p_List] := CI1[p] = Expand[CI0[Drop[p, -1]] CI1[{Last[p]}] + CI1[Drop[p, -1]] CI0[{Last[p]}]]
    pc[p_List] := Module[{ci,mb},mb = DeleteDuplicates[p]; ci = Count[p, #] & /@ mb; n!/(Times @@ (ci!) Times @@ (mb^ci))] (* partition count *)
    row[n_Integer] := row[n] = Factor[(Total[((CI0[#] - CI1[#]) pc[#]) & /@ IntegerPartitions[n]])/(n! 2^n)] /. CI[l_List] :> j^(Total[l][[2]])
    array[n_, k_] := row[n] /. j -> k
    Table[array[n, d-n+1], {d, 1, 10}, {n, 1, d}] // Flatten

Formula

The algorithm used in the Mathematica program below assigns each permutation of the axes to a partition of n. It then determines the number of permutations for each partition and the cycle index for each partition.
A(k,n) = A325012(n,k) - A325013(n,k) = (A325012(n,k) - A325015(n,k)) / 2 = A325013(n,k) - A325015(n,k).
A(n,k) = Sum_{j=2..2^n} A325018(n,j) * binomial(k,j).

A325016 Triangle read by rows: T(n,k) is the number of oriented colorings of the facets of a regular n-dimensional orthoplex using exactly k colors. Row n has 2^n columns.

Original entry on oeis.org

1, 2, 1, 4, 9, 6, 1, 21, 267, 1718, 5250, 7980, 5880, 1680, 1, 494, 228591, 21539424, 685479375, 10257064650, 86151316860, 449772354360, 1551283253100, 3661969537800, 6015983173200, 6878457986400, 5371454088000, 2733402672000, 817296480000, 108972864000
Offset: 1

Views

Author

Robert A. Russell, May 28 2019

Keywords

Comments

Also called cross polytope and hyperoctahedron. For n=1, the figure is a line segment with two vertices. For n=2 the figure is a square with four edges. For n=3 the figure is an octahedron with eight triangular faces. For n=4, the figure is a 16-cell with sixteen tetrahedral facets. The Schläfli symbol, {3,...,3,4}, of the regular n-dimensional orthoplex (n>1) consists of n-2 threes followed by a four. Each of its 2^n facets is an (n-1)-dimensional simplex. Two oriented colorings are the same if one is a rotation of the other; chiral pairs are counted as two.
Also the number of oriented colorings of the vertices of a regular n-dimensional orthotope (cube) using exactly k colors.

Examples

			Triangle begins with T(1,1):
  1  2
  1  4   9    6
  1 21 267 1718 5250 7980 5880 1680
For T(2,2)=4, two squares have three edges the same color, one has opposite edges the same color, and one has opposite edges different colors.
		

Crossrefs

Cf. A325017 (unoriented), A325018 (chiral), A325019 (achiral), A325012 (up to k colors).
Other n-dimensional polytopes: A325002 (simplex), A325008 (orthotope).

Programs

  • Mathematica
    a48[n_] := a48[n] = DivisorSum[NestWhile[#/2&, n, EvenQ], MoebiusMu[#]2^(n/#)&]/(2n); (* A000048 *)
    a37[n_] := a37[n] = DivisorSum[n, MoebiusMu[n/#]2^#&]/n; (* A001037 *)
    CI0[{n_Integer}] := CI0[{n}] = CI[Transpose[If[EvenQ[n], p2 = IntegerExponent[n, 2]; sub = Divisors[n/2^p2]; {2^(p2+1) sub, a48 /@ (2^p2 sub) }, sub = Divisors[n]; {sub, a37 /@ sub}]]] 2^(n-1); (* even perm. *)
    CI1[{n_Integer}] := CI1[{n}] = CI[sub = Divisors[n]; Transpose[If[EvenQ[n], {sub, a37 /@ sub}, {2 sub, (a37 /@ sub)/2}]]] 2^(n-1); (* odd perm. *)
    compress[x : {{, } ...}] := (s = Sort[x]; For[i = Length[s], i > 1, i -= 1, If[s[[i, 1]]==s[[i-1, 1]], s[[i-1, 2]] += s[[i, 2]]; s = Delete[s, i], Null]]; s)
    cix[{a_, b_}, {c_, d_}] := {LCM[a, c], (a b c d)/LCM[a, c]};
    Unprotect[Times]; Times[CI[a_List], CI[b_List]] :=  (* combine *) CI[compress[Flatten[Outer[cix, a, b, 1], 1]]]; Protect[Times];
    CI0[p_List] := CI0[p] = Expand[CI0[Drop[p, -1]] CI0[{Last[p]}] + CI1[Drop[p, -1]] CI1[{Last[p]}]]
    CI1[p_List] := CI1[p] = Expand[CI0[Drop[p, -1]] CI1[{Last[p]}] + CI1[Drop[p, -1]] CI0[{Last[p]}]]
    pc[p_List] := Module[{ci,mb},mb = DeleteDuplicates[p]; ci = Count[p, #] & /@ mb; n!/(Times @@ (ci!) Times @@ (mb^ci))] (* partition count *)
    row[n_Integer] := row[n] = Factor[(Total[(CI0[#] pc[#]) & /@ IntegerPartitions[n]])/(n! 2^(n - 1))] /. CI[l_List] :> j^(Total[l][[2]])
    array[n_, k_] := row[n] /. j -> k (* A325012 *)
    Table[LinearSolve[Table[Binomial[i,j],{i,1,2^n},{j,1,2^n}],Table[array[n,k],{k,1,2^n}]],{n,1,6}] // Flatten

Formula

A325012(n,k) = Sum_{j=1..2^n} T(n,j) * binomial(k,j).
T(n,k) = A325017(n,k) + A325018(n,k) = 2*A325017(n,k) - A325019(n,k) = 2*A325018(n,k) + A325019(n,k).

A325017 Triangle read by rows: T(n,k) is the number of unoriented colorings of the facets of a regular n-dimensional orthoplex using exactly k colors. Row n has 2^n columns.

Original entry on oeis.org

1, 1, 1, 4, 6, 3, 1, 20, 204, 1056, 2850, 4080, 2940, 840, 1, 400, 130899, 11230666, 347919225, 5158324560, 43174480650, 225086553300, 775894225050, 1831178115900, 3008073915000, 3439243962000, 2685727044000, 1366701336000, 408648240000, 54486432000
Offset: 1

Views

Author

Robert A. Russell, Jun 09 2019

Keywords

Comments

Also called cross polytope and hyperoctahedron. For n=1, the figure is a line segment with two vertices. For n=2 the figure is a square with four edges. For n=3 the figure is an octahedron with eight triangular faces. For n=4, the figure is a 16-cell with sixteen tetrahedral facets. The Schläfli symbol, {3,...,3,4}, of the regular n-dimensional orthoplex (n>1) consists of n-2 threes followed by a four. Each of its 2^n facets is an (n-1)-dimensional simplex. Two unoriented colorings are the same if congruent; chiral pairs are counted as one.
Also the number of unoriented colorings of the vertices of a regular n-dimensional orthotope (cube) using exactly k colors.

Examples

			Triangle begins with T(1,1):
1  1
1  4   6    3
1 20 204 1056 2850 4080 2940 840
For T(2,2)=4, two squares have three edges the same color, one has opposite edges the same color, and one has opposite edges different colors.
		

Crossrefs

Cf. A325016 (oriented), A325018 (chiral), A325019 (achiral), A325013 (up to k colors).
Other n-dimensional polytopes: A007318(n,k-1) (simplex), A325009 (orthotope).

Programs

  • Mathematica
    a48[n_] := a48[n] = DivisorSum[NestWhile[#/2&,n,EvenQ],MoebiusMu[#]2^(n/#)&]/(2n); (* A000048 *)
    a37[n_] := a37[n] = DivisorSum[n, MoebiusMu[n/#]2^#&]/n; (* A001037 *)
    CI0[{n_Integer}] := CI0[{n}] = CI[Transpose[If[EvenQ[n], p2 = IntegerExponent[n, 2]; sub = Divisors[n/2^p2]; {2^(p2+1) sub, a48 /@ (2^p2 sub) }, sub = Divisors[n]; {sub, a37 /@ sub}]]] 2^(n-1); (* even perm. *)
    CI1[{n_Integer}] := CI1[{n}] = CI[sub = Divisors[n]; Transpose[If[EvenQ[n], {sub, a37 /@ sub}, {2 sub, (a37 /@ sub)/2}]]] 2^(n-1); (* odd perm. *)
    compress[x : {{, } ...}] := (s = Sort[x]; For[i = Length[s], i > 1, i -= 1, If[s[[i, 1]]==s[[i-1, 1]], s[[i-1, 2]] += s[[i, 2]]; s = Delete[s, i], Null]]; s)
    cix[{a_, b_}, {c_, d_}] := {LCM[a, c], (a b c d)/LCM[a, c]};
    Unprotect[Times]; Times[CI[a_List], CI[b_List]] :=  (* combine *) CI[compress[Flatten[Outer[cix, a, b, 1], 1]]]; Protect[Times];
    CI0[p_List] := CI0[p] = Expand[CI0[Drop[p, -1]] CI0[{Last[p]}] + CI1[Drop[p, -1]] CI1[{Last[p]}]]
    CI1[p_List] := CI1[p] = Expand[CI0[Drop[p, -1]] CI1[{Last[p]}] + CI1[Drop[p, -1]] CI0[{Last[p]}]]
    pc[p_List] := Module[{ci,mb},mb = DeleteDuplicates[p]; ci = Count[p, #] & /@ mb; n!/(Times @@ (ci!) Times @@ (mb^ci))] (* partition count *)
    row[n_Integer] := row[n] = Factor[(Total[((CI0[#] + CI1[#]) pc[#]) & /@ IntegerPartitions[n]])/(n! 2^n)] /. CI[l_List] :> j^(Total[l][[2]])
    array[n_, k_] := row[n] /. j -> k (* A325013 *)
    Table[LinearSolve[Table[Binomial[i,j],{i,1,2^n},{j,1,2^n}],Table[array[n,k],{k,1,2^n}]],{n,1,6}] // Flatten

Formula

A325013(n,k) = Sum_{j=1..2^n} T(n,j) * binomial(k,j).
T(n,k) = A325016(n,k) - A325018(n,k) = (A325016(n,k) + A325019(n,k)) / 2 = A325018(n,k) + A325019(n,k).

A325019 Triangle read by rows: T(n,k) is the number of achiral colorings of the facets of a regular n-dimensional orthoplex using exactly k colors. Row n has 2^n columns.

Original entry on oeis.org

1, 0, 1, 4, 3, 0, 1, 19, 141, 394, 450, 180, 0, 0, 1, 306, 33207, 921908, 10359075, 59584470, 197644440, 400752240, 505197000, 386694000, 164656800, 29937600, 0, 0, 0, 0
Offset: 1

Views

Author

Robert A. Russell, Jun 09 2019

Keywords

Comments

Also called cross polytope and hyperoctahedron. For n=1, the figure is a line segment with two vertices. For n=2 the figure is a square with four edges. For n=3 the figure is an octahedron with eight triangular faces. For n=4, the figure is a 16-cell with sixteen tetrahedral facets. The Schläfli symbol, {3,...,3,4}, of the regular n-dimensional orthoplex (n>1) consists of n-2 threes followed by a four. Each of its 2^n facets is an (n-1)-dimensional simplex. An achiral coloring is identical to its reflection. The last 2^(n-2) columns of row n are zero; there are no achiral colorings with that many colors.
Also the number of achiral colorings of the vertices of a regular n-dimensional orthotope (cube) using exactly k colors.

Examples

			Triangle begins with T(1,1):
1  0
1  4   3   0
1 19 141 394 450 180 0 0
For T(2,3)=3, each square has one of the three colors on two opposite edges.
		

Crossrefs

Cf. A325016 (oriented), A325017 (unoriented), A325018 (chiral), A325015 (up to k colors).
Other n-dimensional polytopes: A325003 (simplex), A325011 (orthotope).

Programs

  • Mathematica
    a48[n_] := a48[n] = DivisorSum[NestWhile[#/2&,n,EvenQ],MoebiusMu[#]2^(n/#)&]/(2n); (* A000048 *)
    a37[n_] := a37[n] = DivisorSum[n,MoebiusMu[n/#]2^#&]/n; (* A001037 *)
    CI0[{n_Integer}] := CI0[{n}] = CI[Transpose[If[EvenQ[n], p2 = IntegerExponent[n, 2]; sub = Divisors[n/2^p2]; {2^(p2+1) sub, a48 /@ (2^p2 sub) }, sub = Divisors[n]; {sub, a37 /@ sub}]]] 2^(n-1); (* even permutation *)
    CI1[{n_Integer}] := CI1[{{n}}] = CI[sub = Divisors[n]; Transpose[If[EvenQ[n], {sub, a37 /@ sub}, {2 sub, (a37 /@ sub)/2}]]] 2^(n-1); (* odd permutation *)
    compress[x : {{, } ...}] := (s = Sort[x]; For[i = Length[s], i > 1, i -= 1, If[s[[i, 1]] == s[[i - 1, 1]], s[[i - 1, 2]] += s[[i, 2]]; s = Delete[s, i], Null]]; s)
    cix[{a_, b_}, {c_, d_}] := {LCM[a, c], (a b c d)/LCM[a, c]};
    Unprotect[Times]; Times[CI[a_List], CI[b_List]] :=  (* combine *) CI[compress[Flatten[Outer[cix, a, b, 1], 1]]]; Protect[Times];
    CI0[p_List] := CI0[p] = Expand[CI0[Drop[p, -1]] CI0[{Last[p]}] + CI1[Drop[p, -1]] CI1[{Last[p]}]]
    CI1[p_List] := CI1[p] = Expand[CI0[Drop[p, -1]] CI1[{Last[p]}] + CI1[Drop[p, -1]] CI0[{Last[p]}]]
    pc[p_List] := Module[{ci,mb},mb = DeleteDuplicates[p]; ci = Count[p, #] & /@ mb; n!/(Times @@ (ci!) Times @@ (mb^ci))] (* partition count *)
    row[n_Integer] := row[n] = Factor[(Total[(CI1[#] pc[#]) & /@ IntegerPartitions[n]])/(n! 2^(n - 1))] /. CI[l_List] :> j^(Total[l][[2]])
    array[n_, k_] := row[n] /. j -> k (* A325012 *)
    Table[LinearSolve[Table[Binomial[i,j],{i,1,2^n},{j,1,2^n}],Table[array[n,k],{k,1,2^n}]],{n,1,6}] // Flatten

Formula

A325015(n,k) = Sum_{j=1..2^n} T(n,j) * binomial(k,j).
T(n,k) = 2*A325017(n,k) - A325016(n,k) = A325016(n,k) - 2*A325018(n,k) = A325017(n,k) - A325018(n,k).

A325010 Triangle read by rows: T(n,k) is the number of chiral pairs of colorings of the facets of a regular n-dimensional orthotope using exactly k colors. Row n has 2n columns.

Original entry on oeis.org

0, 1, 0, 0, 3, 3, 0, 0, 1, 16, 30, 15, 0, 0, 0, 15, 135, 330, 315, 105, 0, 0, 0, 6, 222, 1581, 4410, 5880, 3780, 945, 0, 0, 0, 1, 205, 3760, 23604, 71078, 116550, 107100, 51975, 10395, 0, 0, 0, 0, 120, 5715, 73755, 427260, 1351980, 2552130, 2962575, 2079000, 810810, 135135
Offset: 1

Views

Author

Robert A. Russell, May 27 2019

Keywords

Comments

Also called hypercube, n-dimensional cube, and measure polytope. For n=1, the figure is a line segment with two vertices. For n=2 the figure is a square with four edges. For n=3 the figure is a cube with six square faces. For n=4, the figure is a tesseract with eight cubic facets. The Schläfli symbol, {4,3,...,3}, of the regular n-dimensional orthotope (n>1) consists of a four followed by n-2 threes. Each of its 2n facets is an (n-1)-dimensional orthotope. The chiral colorings of its facets come in pairs, each the reflection of the other.
Also the number of chiral pairs of colorings of the vertices of a regular n-dimensional orthoplex using exactly k colors.

Examples

			The triangle begins with T(1,1):
 0 1
 0 0 3  3
 0 0 1 16  30   15
 0 0 0 15 135  330   315    105
 0 0 0  6 222 1581  4410   5880    3780     945
 0 0 0  1 205 3760 23604  71078  116550  107100   51975   10395
 0 0 0  0 120 5715 73755 427260 1351980 2552130 2962575 2079000 810810 135135
For T(2,3)=3, the three squares have the two edges with the same color adjacent.
		

Crossrefs

Cf. A325008 (oriented), A325009 (unoriented), A325011 (achiral), A325006 (up to k colors).
Other n-dimensional polytopes: A325018 (orthoplex).

Programs

  • Mathematica
    Table[Sum[Binomial[j-k-1,j]Binomial[Binomial[k-j,2],n],{j,0,k-2}],{n,1,10},{k,1,2n}] // Flatten

Formula

T(n,k) = Sum{j=0..k-2} binomial(j-k-1,j) * binomial(binomial(k-j,2),n).
T(n,k) = A325008(n,k) - A325009(n,k) = (A325008(n,k) - A325011(n,k)) / 2 = A325009(n,k) - A325011(n,k).

A338144 Triangle read by rows: T(n,k) is the number of chiral pairs of colorings of the edges of a regular n-D orthotope (or ridges of a regular n-D orthoplex) using exactly k colors. Row n has n*2^(n-1) columns.

Original entry on oeis.org

0, 0, 0, 3, 3, 0, 74, 10482, 303268, 3440700, 19842840, 65867760, 133580160, 168399000, 128898000, 54885600, 9979200, 0, 11158298, 4825419243699, 48019052798280376, 60392832865887732525, 20362602448352682660450
Offset: 1

Views

Author

Robert A. Russell, Oct 12 2020

Keywords

Comments

Chiral colorings come in pairs, each the reflection of the other. A ridge is an (n-2)-face of an n-D polytope. For n=1, the figure is a line segment with one edge. For n=2, the figure is a square with 4 edges (vertices). For n=3, the figure is a cube (octahedron) with 12 edges. The number of edges (ridges) is n*2^(n-1). The Schläfli symbols for the n-D orthotope (hypercube) and the n-D orthoplex (hyperoctahedron, cross polytope) are {4,...,3,3} and {3,3,...,4} respectively, with n-2 3's in each case. The figures are mutually dual.
The algorithm used in the Mathematica program below assigns each permutation of the axes to a partition of n and then considers separate conjugacy classes for axis reversals. It uses the formulas in Balasubramanian's paper. If the value of m is increased, one can enumerate colorings of higher-dimensional elements beginning with T(m,1).

Examples

			Triangle begins with T(1,1):
  0
  0  0     3      3
  0 74 10482 303268 3440700 19842840 65867760 133580160 168399000
  ...
For T(2,3)=3, the chiral pairs are AABC-AACB, ABBC-ACBB, and ABCC-ACCB. For T(2,4)=3, the chiral pairs are ABCD-ADCB, ACBD-ADBC, and ABDC-ACDB.
		

Crossrefs

Cf. A338142 (oriented), A338143 (unoriented), A338145 (achiral), A337409 (k or fewer colors), A325018 (orthotope vertices, orthoplex facets).
Cf. A327089 (simplex), A338148 (orthoplex edges, orthotope ridges).

Programs

  • Mathematica
    m=1; (* dimension of color element, here an edge *)
    Fi1[p1_] := Module[{g, h}, Coefficient[Product[g = GCD[k1, p1]; h = GCD[2 k1, p1]; (1+2x^(k1/g))^(r1[[k1]] g) If[Divisible[k1, h], 1, (1+2x^(2 k1/h))^(r2[[k1]] h/2)], {k1, Flatten[Position[cs, n1_ /; n1 > 0]]}], x, n-m]];
    FiSum[] := (Do[Fi2[k2] = Fi1[k2], {k2, Divisors[per]}]; DivisorSum[per, DivisorSum[d1 = #, MoebiusMu[d1/#] Fi2[#] &]/# &]);
    CCPol[r_List] := (r1 = r; r2 = cs - r1; per = LCM @@ Table[If[cs[[j2]] == r1[[j2]], If[0 == cs[[j2]], 1, j2], 2j2], {j2, n}]; If[EvenQ[Sum[If[EvenQ[j3], r1[[j3]], r2[[j3]]], {j3, n}]], 1, -1]Times @@ Binomial[cs, r1] 2^(n-Total[cs]) b^FiSum[]);
    PartPol[p_List] := (cs = Count[p, #]&/@ Range[n]; Total[CCPol[#]&/@ Tuples[Range[0, cs]]]);
    pc[p_List] := Module[{ci, mb}, mb = DeleteDuplicates[p]; ci = Count[p, #]&/@ mb; n!/(Times@@(ci!) Times@@(mb^ci))] (*partition count*)
    row[n_Integer] := row[n] = Factor[(Total[(PartPol[#] pc[#])&/@ IntegerPartitions[n]])/(n! 2^n)]
    array[n_, k_] := row[n] /. b -> k
    Table[LinearSolve[Table[Binomial[i,j],{i,2^(n-m)Binomial[n,m]},{j,2^(n-m)Binomial[n,m]}], Table[array[n,k],{k,2^(n-m)Binomial[n,m]}]], {n,m,m+4}] // Flatten

Formula

A337409(n,k) = Sum_{j=1..n*2^(n-1)} T(n,j) * binomial(k,j).
T(n,k) = A338142(n,k) - A338143(n,k) = (A338142(n,k) - A338145(n,k)) / 2 = A338143(n,k) - A338145(n,k).
T(2,k) = A338148(2,k) = A325018(2,k) = A325010(2,k); T(3,k) = A338148(3,k).

A338148 Triangle read by rows: T(n,k) is the number of chiral pairs of colorings of the edges of a regular n-D orthoplex (or ridges of a regular n-D orthotope) using exactly k colors. Row 1 has 1 column; row n>1 has 2*n*(n-1) columns.

Original entry on oeis.org

0, 0, 0, 3, 3, 0, 74, 10482, 303268, 3440700, 19842840, 65867760, 133580160, 168399000, 128898000, 54885600, 9979200, 0, 40927, 731157018, 729348051686, 151526009158620, 11418355290999750, 415756294427389020, 8643340000393019040
Offset: 1

Views

Author

Robert A. Russell, Oct 12 2020

Keywords

Comments

Chiral colorings come in pairs, each the reflection of the other. A ridge is an (n-2)-face of an n-D polytope. For n=1, the figure is a line segment with one edge. For n=2, the figure is a square with 4 edges (vertices). For n=3, the figure is an octahedron (cube) with 12 edges. For n>1, the number of edges (ridges) is 2*n*(n-1). The Schläfli symbols for the n-D orthotope (hypercube) and the n-D orthoplex (hyperoctahedron, cross polytope) are {4,3,...,3,3} and {3,3,...,3,4} respectively, with n-2 3's in each case. The figures are mutually dual.
The algorithm used in the Mathematica program below assigns each permutation of the axes to a partition of n and then considers separate conjugacy classes for axis reversals. It uses the formulas in Balasubramanian's paper. If the value of m is increased, one can enumerate colorings of higher-dimensional elements beginning with T(m,1).

Examples

			Triangle begins with T(1,1):
  0
  0  0     3      3
  0 74 10482 303268 3440700 19842840 65867760 133580160 168399000
  ...
For T(2,3)=3, the chiral pairs are AABC-AACB, ABBC-ACBB, and ABCC-ACCB. For T(2,4)=3, the chiral pairs are ABCD-ADCB, ACBD-ADBC, and ABDC-ACDB.
		

Crossrefs

Cf. A338146 (oriented), A338147 (unoriented), A338149 (achiral), A337413 (k or fewer colors), A325010 (orthoplex vertices, orthotope facets).
Cf. A327089 (simplex), A338144 (orthotope edges, orthoplex ridges).

Programs

  • Mathematica
    m=1; (* dimension of color element, here an edge *)
    Fi1[p1_] := Module[{g, h}, Coefficient[Product[g = GCD[k1, p1]; h = GCD[2 k1, p1]; (1 + 2 x^(k1/g))^(r1[[k1]] g) If[Divisible[k1, h], 1, (1+2x^(2 k1/h))^(r2[[k1]] h/2)], {k1, Flatten[Position[cs, n1_ /; n1 > 0]]}], x, m+1]];
    FiSum[] := (Do[Fi2[k2] = Fi1[k2], {k2, Divisors[per]}]; DivisorSum[per, DivisorSum[d1 = #, MoebiusMu[d1/#] Fi2[#] &]/# &]);
    CCPol[r_List] := (r1 = r; r2 = cs - r1; per = LCM @@ Table[If[cs[[j2]] == r1[[j2]], If[0 == cs[[j2]], 1, j2], 2j2], {j2, n}]; If[EvenQ[Sum[If[EvenQ[j3], r1[[j3]], r2[[j3]]], {j3, n}]], 1, -1]Times @@ Binomial[cs, r1] 2^(n-Total[cs]) b^FiSum[]);
    PartPol[p_List] := (cs = Count[p, #]&/@ Range[n]; Total[CCPol[#]&/@ Tuples[Range[0, cs]]]);
    pc[p_List] := Module[{ci, mb}, mb = DeleteDuplicates[p]; ci = Count[p, #]&/@ mb; n!/(Times@@(ci!) Times@@(mb^ci))] (*partition count*)
    row[n_Integer] := row[n] = Factor[(Total[(PartPol[#] pc[#])&/@ IntegerPartitions[n]])/(n! 2^n)]
    array[n_, k_] := row[n] /. b -> k
    Join[{{0}},Table[LinearSolve[Table[Binomial[i,j],{i,2^(m+1)Binomial[n,m+1]},{j,2^(m+1)Binomial[n,m+1]}], Table[array[n,k],{k,2^(m+1)Binomial[n,m+1]}]], {n,m+1,m+4}]] // Flatten

Formula

For n>1, A337413(n,k) = Sum_{j=1..2*n*(n-1)} T(n,j) * binomial(k,j).
T(n,k) = A338146(n,k) - A338147(n,k) = (A338146(n,k) - A338149(n,k)) / 2 = A338147(n,k) - A338149(n,k).
T(2,k) = A338144(2,k) = A325018(2,k) = A325010(2,k); T(3,k) = A338144(3,k).
Showing 1-7 of 7 results.