Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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?

share|improve this question
    
I can't reproduce your problem on MMA 9 -- I get 24 cycles. –  mfvonh Jun 24 at 17:59
    
I can reproduce the result in the question on version 8.0.4 –  Jens Jun 24 at 18:22
    
So it is probably a bug of version 8 which I'm also running. It would be great to find a workaround though. –  VLC Jun 24 at 18:41
    
@mfvonh Just out of curiosity, does it work on MMA 9 if you run: FindEulerianCycle[DeBruijnGraph[4, 1], 20736]? –  VLC Jun 25 at 8:35
    
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...) –  rasher Jun 25 at 9:26

2 Answers 2

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

share|improve this answer
    
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. –  VLC Jun 25 at 8:55

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

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

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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