[Math] How many arrangements of $\{a,2b,3c,4d, 5e\}$ have no identical consecutive letters

combinatoricspermutations

How many arrangements of $\{a,2b,3c,4d, 5e\}$ have no identical consecutive letters?

I find it very tough… Could anyone have some good ways?

Best Answer

This is an alternative approach to compute this numbers using a computer. The set of all words we are trying to count is of course finite, to it is a regular language. Luckily, it is easy to construct an automaton which recognizes it, so we can look at the adjacency matrix of the machine and compute its powers. The obvious automaton has $(2+n)n!$ vertices, which is pretty huge.

The actual computation of the matrix powers takes time similar to $$\log\binom{n+1}{2}(n+2)^3n!^3$$ if one uses repeated squaring.

Can someone get an asymtotics idea of the actual result we are computing to compare this algorithm with something like Jiri's (which obviously taes time linear in the result) ?

In mathematica, we can code this with 

vertices[n_] := 
 Join[
  {start, bottom},
  Flatten[
   Table[st[a, is], {a, 1, n},  {is, 
     Tuples[Table[Range[0, i], {i, 1, n}]]}
    ], 1]
  ]

rules[n_] := 
 Join[
  Table[{start, i} -> st[i, MapAt[# - 1 &, Range[n], i]], {i, 
    1, n}],
  Table[{bottom, i} -> bottom, {i, 1, n}],
  Flatten[Table[
    {st[a, is], b} -> 
     If[a == b || is[[b]] == 0, 
      bottom, st[b, MapAt[# - 1 &, is, b]]],
    {a, 1, n}, {b, 1, n}, {is, Tuples[Table[Range[0, i], {i, 1, n}]]}
    ], 2]
  ]

toMatrix[rs_, n_, vs_] := 
 SparseArray[
  Flatten@Table[
    With[{src = Position[vs, v][[1, 1]], 
      dest = Position[vs, {v, i} /. rs][[1, 1]]},
     {src, dest} -> If[src === bottom || dest === bottom, 0, 1]
     ], {v, vs}, {i, n}] ,
  {Length[vs], Length[vs]}
  ]

go[n_] := Module[{vs = vertices[n], a, m},
  a = Position[vs, start][[1, 1]];
  Print[n, ": Matrix size : ", Length[vs]];
  m = MatrixPower[
    Transpose@toMatrix[rules[n], n, vs], 
    Binomial[n + 1, 2],
    SparseArray[{a -> 1}, {Length[vs]}]
    ];
  Total[m[[Position[vs, st[_, {0 ..}]][[All, 1]]]]]
  ]

Using this code, I can evaluate

go /@ Range[1..5]

to get 

1, 1, 10, 1074, 1637124

in 57 seconds.

Related Question