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-8 of 8 results.

A060530 Number of inequivalent ways to color edges of a cube using at most n colors.

Original entry on oeis.org

0, 1, 218, 22815, 703760, 10194250, 90775566, 576941778, 2863870080, 11769161895, 41669295250, 130772947481, 371513523888, 970769847320, 2362273657030, 5406141568500, 11728193258496, 24276032182173, 48201464902410, 92221684354915
Offset: 0

Views

Author

N. J. A. Sloane, Apr 11 2001

Keywords

Comments

Here inequivalent means under the action of the rotation group of the cube, of order 24, which in its action on the edges has cycle index (x1^12 + 3*x2^6 + 6*x4^3 + 6*x1^2*x2^5 + 8*x3^4)/24.
Also, number of inequivalent colorings of the edges of a regular octahedron using at most n colors. - José H. Nieto S., Jan 19 2012
From Robert A. Russell, Oct 08 2020: (Start)
Each chiral pair is counted as two when enumerating oriented arrangements. The Schläfli symbols for the regular octahedron and cube are {3,4} and {4,3} respectively. They are mutually dual.
There are 24 elements in the rotation group of the regular octahedron/cube. They divide into five conjugacy classes. The first formula is obtained by averaging the edge cycle indices after replacing x_i^j with n^j according to the Pólya enumeration theorem.
Conjugacy Class Count Even Cycle Indices
Identity 1 x_1^12
Vertex rotation 8 x_3^4
Edge rotation 6 x_1^2x_2^5
Small face rotation 6 x_4^3
Large face rotation 3 x_2^6 (End)
Also, number of ways of coloring the vertices of the truncated tetrahedron or faces of the triakis tetrahedron up to rotation and reflection. - Peter Kagey, Nov 27 2024

References

  • N. G. De Bruijn, Polya's theory of counting, in E. F. Beckenbach, ed., Applied Combinatorial Mathematics, Wiley, 1964, pp. 144-184 (see p. 147).

Crossrefs

Cf. A199406 (unoriented), A337406 (chiral), A331351 (achiral).
Other elements: A000543 (cube vertices, octahedron faces), A047780 (cube faces, octahedron vertices).
Cf. A046023 (tetrahedron), A282670 (dodecahedron/icosahedron).
Row 3 of A337407 (orthotope edges, orthoplex ridges) and A337411 (orthoplex edges, orthotope ridges).

Programs

  • Mathematica
    Table[(n^12+6n^7+3n^6+8n^4+6n^3)/24,{n,0,20}] (* Harvey P. Dale, Feb 13 2013 *)
  • PARI
    { for (n=0, 200, write("b060530.txt", n, " ", (n^12 + 6*n^7 + 3*n^6 + 8*n^4 + 6*n^3)/24); ) } \\ Harry J. Smith, Jul 06 2009

Formula

a(n) = (n^12 + 6*n^7 + 3*n^6 + 8*n^4 + 6*n^3)/24. (Replace all x_i's in the cycle index by n.)
G.f.: -x*(150*x^10 +19758*x^9 +425032*x^8 +2763481*x^7 +6769435*x^6 +6773089*x^5 +2763307*x^4 +423883*x^3 +20059*x^2 +205*x +1)/(x -1)^13. - Colin Barker, Aug 13 2012
From Robert A. Russell, Oct 08 2020: (Start)
a(n) = 1*C(n,1) + 216*C(n,2) + 22164*C(n,3) + 613804*C(n,4) + 6901425*C(n,5) + 39713430*C(n,6) + 131754420*C(n,7) + 267165360*C(n,8) + 336798000*C(n,9) + 257796000*C(n,10) + 109771200*C(n,11) + 19958400*C(n,12), where the coefficient of C(n,k) is the number of oriented colorings using exactly k colors.
a(n) = A199406(n) + A337406(n) = 2*A199406(n) - A331351(n) = 2*A337406(n) + A331351(n). (End)

Extensions

Entry revised by N. J. A. Sloane, Jan 03 2005

A327083 Array read by descending antidiagonals: A(n,k) is the number of oriented colorings of the edges of a regular n-dimensional simplex using up to k colors.

Original entry on oeis.org

1, 2, 1, 3, 4, 1, 4, 11, 12, 1, 5, 24, 87, 40, 1, 6, 45, 416, 1197, 184, 1, 7, 76, 1475, 18592, 42660, 1296, 1, 8, 119, 4236, 166885, 3017600, 4223313, 17072, 1, 9, 176, 10437, 1019880, 85025050, 1748176768, 1139277096, 424992
Offset: 1

Views

Author

Robert A. Russell, Aug 19 2019

Keywords

Comments

An n-dimensional simplex has n+1 vertices and (n+1)*n/2 edges. For n=1, the figure is a line segment with one edge. For n-2, the figure is a triangle with three edges. For n=3, the figure is a tetrahedron with six edges. The Schläfli symbol, {3,...,3}, of the regular n-dimensional simplex consists of n-1 threes. Two oriented colorings are the same if one is a rotation of the other; chiral pairs are counted as two.
A(n,k) is also the number of oriented colorings of (n-2)-dimensional regular simplices in an n-dimensional simplex using up to k colors. Thus, A(2,k) is also the number of oriented colorings of the vertices (0-dimensional simplices) of an equilateral triangle.

Examples

			Array begins with A(1,1):
  1  2    3     4      5       6       7        8        9        10 ...
  1  4   11    24     45      76     119      176      249       340 ...
  1 12   87   416   1475    4236   10437    22912    45981     85900 ...
  1 40 1197 18592 166885 1019880 4738153 17962624 58248153 166920040 ...
  ...
For A(2,3) = 11, the nine achiral colorings are AAA, AAB, AAC, ABB, ACC, BBB, BBC, BCC, and CCC. The chiral pair is ABC-ACB.
		

Crossrefs

Cf. A327084 (unoriented), A327085 (chiral), A327086 (achiral), A327087 (exactly k colors), A324999 (vertices, facets), A337883 (faces, peaks), A337407 (orthotope edges, orthoplex ridges), A337411 (orthoplex edges, orthotope ridges).
Rows 1-4 are A000027, A006527, A046023, A331350.
Column 2 is A218144(n+1).

Programs

  • Mathematica
    CycleX[{2}] = {{1,1}}; (* cycle index for permutation with given cycle structure *)
    CycleX[{n_Integer}] := CycleX[n] = If[EvenQ[n], {{n/2,1}, {n,(n-2)/2}}, {{n,(n-1)/2}}]
    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)
    CycleX[p_List] := CycleX[p] = compress[Join[CycleX[Drop[p,-1]], If[Last[p] > 1, CycleX[{Last[p]}], ## &[]], If[# == Last[p], {#, Last[p]}, {LCM[#, Last[p]], GCD[#, Last[p]]}] & /@ Drop[p,-1]]]
    pc[p_List] := Module[{ci, mb}, mb = DeleteDuplicates[p]; ci = Count[p, #] & /@ mb; Total[p]!/(Times @@ (ci!) Times @@ (mb^ci))] (*partition count*)
    row[n_Integer] := row[n] = Factor[Total[If[EvenQ[Total[1-Mod[#,2]]], pc[#] j^Total[CycleX[#]][[2]], 0] & /@ IntegerPartitions[n+1]]/((n+1)!/2)]
    array[n_, k_] := row[n] /. j -> k
    Table[array[n,d-n+1], {d,1,10}, {n,1,d}] // Flatten
    (* Using Fripertinger's exponent per Andrew Howroyd's code in A063841: *)
    pc[p_] := Module[{ci, mb}, mb = DeleteDuplicates[p]; ci = Count[p, #] &/@ mb; Total[p]!/(Times @@ (ci!) Times @@ (mb^ci))]
    ex[v_] := Sum[GCD[v[[i]], v[[j]]], {i,2,Length[v]}, {j,i-1}] + Total[Quotient[v,2]]
    array[n_,k_] := Total[If[EvenQ[Total[1-Mod[#,2]]], pc[#]k^ex[#], 0] &/@ IntegerPartitions[n+1]]/((n+1)!/2)
    Table[array[n,d-n+1], {d,10}, {n,d}] // Flatten

Formula

The algorithm used in the Mathematica program below assigns each permutation of the vertices to a partition of n+1. It then determines the number of permutations for each partition and the cycle index for each partition.
A(n,k) = Sum_{j=1..(n+1)*n/2} A327087(n,j) * binomial(k,j).
A(n,k) = A327084(n,k) + A327085(n,k) = 2*A327084(n,k) - A327086(n,k) = 2*A327085(n,k) + A327086(n,k).

A337409 Array read by descending antidiagonals: T(n,k) is the number of chiral pairs of colorings of the edges of a regular n-dimensional orthotope (hypercube) using k or fewer colors.

Original entry on oeis.org

0, 0, 0, 0, 0, 0, 0, 3, 74, 0, 0, 15, 10704, 11158298, 0, 0, 45, 345640, 4825452718593, 314824408633217132928, 0, 0, 105, 5062600, 48038354542204960, 38491882659952177472606694634030116, 136221825854745676076981182469325427379054390050209792, 0
Offset: 1

Views

Author

Robert A. Russell, Aug 26 2020

Keywords

Comments

Each member of a chiral pair is a reflection, but not a rotation, of the other. For n=1, the figure is a line segment with one edge. For n=2, the figure is a square with 4 edges. For n=3, the figure is a cube with 12 edges. The number of edges is n*2^(n-1).
Also the number of chiral pairs of colorings of the regular (n-2)-dimensional simplexes in a regular n-dimensional orthoplex.

Examples

			Table begins with T(1,1):
0  0     0      0       0        0         0          0          0 ...
0  0     3     15      45      105       210        378        630 ...
0 74 10704 345640 5062600 45246810 288005144 1430618784 5881281480 ...
For T(2,3)=3, the chiral arrangements are AABC-AACB, ABBC-ACBB, and ABCC-ACCB.
		

Crossrefs

Cf. A337407 (oriented), A337408 (unoriented), A337410 (achiral).
Rows 2-4 are A050534, A337406, A331360.
Cf. A327085 (simplex edges), A337413 (orthoplex edges), A325014 (orthotope vertices).

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[array[n,d+m-n], {d,7}, {n,m,d+m-1}] // Flatten

Formula

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).
T(n,k) = A337407(n,k) - A337408(n,k) = (A337407(n,k) - A337410(n,k)) / 2 = A337408(n,k) - A337410(n,k).

A337411 Array read by descending antidiagonals: T(n,k) is the number of oriented colorings of the edges of a regular n-dimensional orthoplex (cross polytope) using k or fewer colors.

Original entry on oeis.org

1, 2, 1, 3, 6, 1, 4, 24, 218, 1, 5, 70, 2285, 90054, 1, 6, 165, 703760, 1471640157, 573439556, 1, 7, 336, 10194250, 1466049174160, 6332134720430727, 50043770249328, 1, 8, 616, 90775566, 310441584462375, 629648890639384572032, 1839894096099964270283469, 59966884221697869216, 1
Offset: 1

Views

Author

Robert A. Russell, Aug 26 2020

Keywords

Comments

Each chiral pair is counted as two when enumerating oriented arrangements. For n=1, the figure is a line segment with one edge. For n=2, the figure is a square with 4 edges. For n=3, the figure is an octahedron with 12 edges. The number of edges is 2n*(n-1) for n>1.
Also the number of oriented colorings of the regular (n-2)-dimensional orthotopes (hypercubes) in a regular n-dimensional orthotope.

Examples

			Table begins with T(1,1):
1   2     3      4        5        6         7          8           9 ...
1   6    24     70      165      336       616       1044        1665 ...
1 218 22815 703760 10194250 90775566 576941778 2863870080 11769161895 ...
For T(2,2)=6, the arrangements are AAAA, AAAB, AABB, ABAB, ABBB, and BBBB.
		

Crossrefs

Cf. A337412 (unoriented), A337413 (chiral), A337414 (achiral).
Rows 1-4 are A000027, A006528, A060530, A331354.
Cf. A327083 (simplex edges), A337407 (orthotope edges), A325004 (orthoplex vertices).

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; If[EvenQ[Sum[If[EvenQ[j3], r1[[j3]], r2[[j3]]], {j3,n}]], (per = LCM @@ Table[If[cs[[j2]] == r1[[j2]], If[0 == cs[[j2]],1,j2], 2j2], {j2,n}]; Times @@ Binomial[cs, r1] 2^(n-Total[cs]) b^FiSum[]),0]);
    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[m]=b;
    row[n_Integer] := row[n] = Factor[(Total[(PartPol[#] pc[#])&/@ IntegerPartitions[n]])/(n! 2^(n-1))]
    array[n_, k_] := row[n] /. b -> k
    Table[array[n,d+m-n], {d,8}, {n,m,d+m-1}] // Flatten

Formula

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).
T(n,k) = A337412(n,k) + A337413(n,k) = 2*A337412(n,k) - A337414(n,k) = 2*A337413(n,k) + A337414(n,k).

A337408 Array read by descending antidiagonals: T(n,k) is the number of unoriented colorings of the edges of a regular n-dimensional orthotope (hypercube) using k or fewer colors.

Original entry on oeis.org

1, 2, 1, 3, 6, 1, 4, 21, 144, 1, 5, 55, 12111, 11251322, 1, 6, 120, 358120, 4825746875682, 314824456456819827136, 1, 7, 231, 5131650, 48038446526132256, 38491882660019692002988737797054040, 136221825854745676520058554256163406987047485113810944, 1
Offset: 1

Views

Author

Robert A. Russell, Aug 26 2020

Keywords

Comments

Each chiral pair is counted as one when enumerating unoriented arrangements. For n=1, the figure is a line segment with one edge. For n=2, the figure is a square with 4 edges. For n=3, the figure is a cube with 12 edges. The number of edges is n*2^(n-1).
Also the number of unoriented colorings of the regular (n-2)-dimensional simplexes in a regular n-dimensional orthoplex.

Examples

			Table begins with T(1,1):
1   2     3      4       5        6         7          8          9 ...
1   6    21     55     120      231       406        666       1035 ...
1 144 12111 358120 5131650 45528756 288936634 1433251296 5887880415 ...
For T(2,2)=6, the arrangements are AAAA, AAAB, AABB, ABAB, ABBB, and BBBB.
		

Crossrefs

Cf. A337407 (oriented), A337409 (chiral), A337410 (achiral).
Rows 1-4 are A000027, A002817, A199406, A331359.
Cf. A327084 (simplex edges), A337412 (orthoplex edges), A325013 (orthotope vertices).

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, 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}]; 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[array[n,d+m-n], {d,7}, {n,m,d+m-1}] // Flatten

Formula

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).
T(n,k) = A337407(n,k) - A337409(n,k) = (A337407(n,k) - A337410(n,k)) / 2 = A337409(n,k) + A337410(n,k).

A337410 Array read by descending antidiagonals: T(n,k) is the number of achiral colorings of the edges of a regular n-dimensional orthotope (hypercube) using k or fewer colors.

Original entry on oeis.org

1, 2, 1, 3, 6, 1, 4, 18, 70, 1, 5, 40, 1407, 93024, 1, 6, 75, 12480, 294157089, 47823602694208, 1, 7, 126, 69050, 91983927296, 67514530382043163023924, 443077371786837979607993095063601152, 1
Offset: 1

Views

Author

Robert A. Russell, Aug 26 2020

Keywords

Comments

An achiral arrangement is identical to its reflection. For n=1, the figure is a line segment with one edge. For n=2, the figure is a square with 4 edges. For n=3, the figure is a cube with 12 edges. The number of edges is n*2^(n-1).
Also the number of achiral colorings of the regular (n-2)-dimensional simplexes in a regular n-dimensional orthoplex.

Examples

			Table begins with T(1,1):
1  2    3     4     5      6      7       8       9       10 ...
1  6   18    40    75    126    196     288     405      550 ...
1 70 1407 12480 69050 281946 931490 2632512 6598935 15041950 ...
For T(2,2)=6, the arrangements are AAAA, AAAB, AABB, ABAB, ABBB, and BBBB.
		

Crossrefs

Cf. A337407 (oriented), A337408 (unoriented), A337409 (chiral).
Rows 1-4 are A000027, A002411, A331351, A331361.
Cf. A327086 (simplex edges), A337414 (orthoplex edges), A325015 (orthotope vertices).

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, 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; If[EvenQ[Sum[If[EvenQ[j3], r1[[j3]], r2[[j3]]], {j3,n}]],0,(per = LCM @@ Table[If[cs[[j2]] == r1[[j2]], If[0 == cs[[j2]],1,j2], 2j2], {j2,n}]; 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-1))]
    array[n_, k_] := row[n] /. b -> k
    Table[array[n,d+m-n], {d,7}, {n,m,d+m-1}] // Flatten

Formula

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).
T(n,k) = 2*A337408(n,k) - A337407(n,k) = A337407(n,k) - 2*A337409(n,k) = A337408(n,k) - A337409(n,k).

A337887 Array read by descending antidiagonals: T(n,k) is the number of oriented colorings of the square faces of a regular n-dimensional orthotope (hypercube) using k or fewer colors.

Original entry on oeis.org

1, 2, 1, 3, 10, 1, 4, 57, 90054, 1, 5, 240, 1471640157, 629648865588086369152, 1, 6, 800, 1466049174160, 76983765319971901895960429658208179, 76686070519895153193719509580895099970955878067526648007224125292544, 1
Offset: 2

Views

Author

Robert A. Russell, Sep 28 2020

Keywords

Comments

Each chiral pair is counted as two when enumerating oriented arrangements. Each face is a square bounded by four edges. For n=2, the figure is a square with one face. For n=3, the figure is a cube with 6 faces. For n=4, the figure is a tesseract with 24 faces. The number of faces is 2^(n-2)*C(n,2).
Also the number of oriented colorings of peaks of an n-dimensional orthoplex. A peak is an (n-3)-dimensional simplex.

Examples

			Array begins with T(2,1):
 1     2          3             4               5                 6 ...
 1    10         57           240             800              2226 ...
 1 90054 1471640157 1466049174160 310441584462375 24679078461920106 ...
		

Crossrefs

Cf. A337888 (unoriented), A337889 (chiral), A337890 (achiral).
Other elements: A325012 (vertices), A337407 (edges).
Other polytopes: A337883 (simplex), A337891 (orthoplex).
Rows 2-4 are A000027, A047780, A331354.

Programs

  • Mathematica
    m = 2;(* dimension of color element, here a square face *)
    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, 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; If[EvenQ[Sum[If[EvenQ[j3], r1[[j3]], r2[[j3]]], {j3,n}]], (per = LCM @@ Table[If[cs[[j2]] == r1[[j2]], If[0 == cs[[j2]],1,j2], 2j2], {j2,n}]; Times @@ Binomial[cs, r1] 2^(n-Total[cs]) b^FiSum[]),0]);
    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-1))]
    array[n_, k_] := row[n] /. b -> k
    Table[array[n,d+m-n], {d,6}, {n,m,d+m-1}] // Flatten

Formula

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).
T(n,k) = A337888(n,k) + A337889(n,k) = 2*A337888(n,k) - A337890(n,k) = 2*A337889(n,k) + A337890(n,k).

A338142 Triangle read by rows: T(n,k) is the number of oriented 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

1, 1, 4, 9, 6, 1, 216, 22164, 613804, 6901425, 39713430, 131754420, 267165360, 336798000, 257796000, 109771200, 19958400, 1, 22409618, 9651132365418, 96038196404417832, 120785673234798359850
Offset: 1

Views

Author

Robert A. Russell, Oct 12 2020

Keywords

Comments

Each chiral pair is counted as two when enumerating oriented arrangements. 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):
  1
  1   4     9      6
  1 216 22164 613804 6901425 39713430 131754420 267165360 336798000
  ...
		

Crossrefs

Cf. A338143 (unoriented), A338144 (chiral), A338145 (achiral), A337407 (k or fewer colors), A325016 (orthotope vertices, orthoplex facets).
Cf. A327087 (simplex), A338146 (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 + 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, 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; If[EvenQ[Sum[If[EvenQ[j3], r1[[j3]], r2[[j3]]], {j3, n}]], (per = LCM @@ Table[If[cs[[j2]] == r1[[j2]], If[0 == cs[[j2]], 1, j2], 2j2], {j2, n}]; Times @@ Binomial[cs, r1] 2^(n-Total[cs]) b^FiSum[]), 0]);
    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-1))]
    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

A337407(n,k) = Sum_{j=1..n*2^(n-1)} T(n,j) * binomial(k,j).
T(n,k) = A338143(n,k) + A338144(n,k) = 2*A338143(n,k) - A338145(n,k) = 2*A338144(n,k) + A338145(n,k).
T(2,k) = A338146(2,k) = A325016(2,k) = A325008(2,k); T(3,k) = A338146(3,k).
Showing 1-8 of 8 results.