A327085 Array read by descending antidiagonals: A(n,k) is the number of chiral pairs of colorings of the edges of a regular n-dimensional simplex using up to k colors.
0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 4, 21, 6, 0, 0, 10, 140, 405, 28, 0, 0, 20, 575, 7904, 17154, 252, 0, 0, 35, 1785, 76880, 1415648, 1920375, 4726, 0, 0, 56, 4606, 486522, 41453650, 855834880, 547375212, 150324, 0
Offset: 1
Examples
Array begins with A(1,1): 0 0 0 0 0 0 0 0 0 0 0 ... 0 0 1 4 10 20 35 56 84 120 165 ... 0 1 21 140 575 1785 4606 10416 21330 40425 71995 ... 0 6 405 7904 76880 486522 2300305 8806336 28725192 82626270 214744629 ... ... For A(2,3) = 1, 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]]], 1, -1] pc[#] j^Total[CycleX[#]][[2]] & /@ IntegerPartitions[n+1]]/(n+1)!] 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]]],1,-1] pc[#]k^ex[#] &/@ IntegerPartitions[n+1]]/(n+1)! 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} A327089(n,j) * binomial(k,j).
Comments