4
$\begingroup$

In combinatorial mathematics, a $k$-ary De Bruijn sequence $B(k, n)$ of order $n$ is a cyclic sequence of a given alphabet $A$ with size $k$ for which every possible subsequence of length $n$ in $A$ appears as a sequence of consecutive characters exactly once.

Each $B(k, n)$ has length $k^n$ and there are $\dfrac{(k!)^{k^{n-1}}}{k^n}$ distinct De Bruijn sequences.

By using DeBruijnGraph and FindEulerianCycle should be possible to obtain all the distinct sequences. In the example below I should obtain 24 sequences ($k = 3$, $n = 2$). However, I get only three distinct sequences:

out=FindEulerianCycle[DeBruijnGraph[3, 1], 24];
(First /@ #) & /@ out

{{1, 1, 2, 1, 3, 2, 2, 3, 3}, {2, 1, 1, 2, 2, 3, 1, 3, 3}, {3, 1, 1, 2, 1, 3, 2, 2, 3}}

How can I obtain all the distinct De Bruijn sequences?

$\endgroup$
  • $\begingroup$ I can't reproduce your problem on MMA 9 -- I get 24 cycles. $\endgroup$ – mfvonh Jun 24 '14 at 17:59
  • $\begingroup$ I can reproduce the result in the question on version 8.0.4 $\endgroup$ – Jens Jun 24 '14 at 18:22
  • $\begingroup$ So it is probably a bug of version 8 which I'm also running. It would be great to find a workaround though. $\endgroup$ – VLC Jun 24 '14 at 18:41
  • $\begingroup$ @mfvonh Just out of curiosity, does it work on MMA 9 if you run: FindEulerianCycle[DeBruijnGraph[4, 1], 20736]? $\endgroup$ – VLC Jun 25 '14 at 8:35
  • $\begingroup$ Have you tried using FindHamiltonianCycle (with appropriate adjustments to the graph, etc.) to see if perhaps the bug is in FindEulerianCycle? (I'm on 9, so both work...) $\endgroup$ – ciao Jun 25 '14 at 9:26
1
$\begingroup$

An idea for a workaround, but the Permutations is pretty inefficient and quickly burns through memory. Any ideas how to improve this?

DeBruijnGraph[3, 1] // EdgeList
Cases[
  Permutations[List @@@ %],
  x_ /; x[[;; -2, 2]] == x[[2 ;;, 1]]];
NestWhile[
  RotateLeft, 
  #, 
  First@# != {1, 1} &] & /@ % // DeleteDuplicates;
Apply[DirectedEdge, %, {2}] // Length

24

$\endgroup$
  • $\begingroup$ This works for DeBruijnGraph[3,1], but it get stuck for DeBruijnGraph[4,1]. There are too many possible permutations I guess. There must be another way that is less memory demanding. $\endgroup$ – VLC Jun 25 '14 at 8:55
1
$\begingroup$

I post this (it was an approach to a New York Times NumberPlay). Note there are major scaling issues for this (Hamiltonian cycles). Apologies if this is unhelpful.

Some examples:

f[k_, n_] := (k!)^k^(n - 1)/k^n
fun[alpha_, n_] := Module[{t, g, gp},
  t = Tuples[alpha, n];
  g = Map[Function[x, {#, Take[Join[#, {x}], -n]}], alpha] & /@ t;
  gp = DirectedEdge @@@ Join @@ Map[StringJoin, g, {3}]]
seq[u_] := Module[{tk},
  tk = u[[All, 1]];
  StringJoin @@ {First@tk}~Join~(StringTake[#, -1] & /@ Rest@tk)]

Some tests: For 3 letter alphabet, 2 symbols: f[3,2] =24

grp = Graph[fun[{"a", "b", "c"}, 2], 
];
ham = FindHamiltonianCycle[grp, All];
Column[seq /@ ham]

yields the desired 24:

enter image description here

Similarly f[4,2] is 20736 :

Length@FindHamiltonianCycle[Graph[fun[CharacterRange["a", "d"], 2]], 
  All]

also yields 20736.

And just for illustration f[4,1] =6 (as f[n,1]=(n-1)!).

Column[seq /@ 
  FindHamiltonianCycle[Graph[fun[CharacterRange["a", "d"], 1]], All]]

enter image description here

$\endgroup$
  • $\begingroup$ Thanks for your contribution, but FindHamiltonianCycle on MMA 8 accepts only undirected graphs, so, unfortunately, this approach doesn't work for me. $\endgroup$ – VLC Jun 25 '14 at 12:48
  • $\begingroup$ @VLC ok...did not appreciate that $\endgroup$ – ubpdqn Jun 25 '14 at 13:08

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.