A327086 Array read by descending antidiagonals: A(n,k) is the number of achiral colorings of the edges of a regular n-dimensional simplex using up to k colors.
1, 2, 1, 3, 4, 1, 4, 9, 10, 1, 5, 16, 45, 28, 1, 6, 25, 136, 387, 128, 1, 7, 36, 325, 2784, 8352, 792, 1, 8, 49, 666, 13125, 186304, 382563, 7620, 1, 9, 64, 1225, 46836, 2117750, 36507008, 44526672, 124344
Offset: 1
Examples
Array begins with A(1,1): 1 2 3 4 5 6 7 8 9 10 11 12 ... 1 4 9 16 25 36 49 64 81 100 121 144 ... 1 10 45 136 325 666 1225 2080 3321 5050 7381 10440 ... 1 28 387 2784 13125 46836 137543 349952 797769 1667500 3248971 5973408 ... ... For A(2,3) = 9, the colorings are AAA, AAB, AAC, ABB, ACC, BBB, BBC, BCC, and CCC.
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]]], 0, pc[#] j^Total[CycleX[#]][[2]]] & /@ 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[OddQ[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} A327090(n,j) * binomial(k,j).
Comments