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.
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
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.
Links
- Robert A. Russell, Table of n, a(n) for n = 1..325 First 25 antidiagonals.
- Harald Fripertinger, The cycle type of the induced action on 2-subsets
- E. M. Palmer and R. W. Robinson, Enumeration under two representations of the wreath product, Acta Math., 131 (1973), 123-143.
Crossrefs
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).
Comments