4
$\begingroup$

How can I generate n-bit base-m Gray code in Mathematica, where only 1 bit changes at a time and all possibilities are covered? I have been hitting my head against a metaphorical wall for a few hours now, feeling frustrated at my forgotten Electrical Engineering knowledge.

For FullGrayCode[4,2] I would expect something like this that I found by hand:

{
    {0, 0, 0, 0},
    {1, 0, 0, 0},
    {1, 1, 0, 0},
    {0, 1, 0, 0},
    {0, 1, 1, 0},
    {1, 1, 1, 0},
    {1, 0, 1, 0},
    {0, 0, 1, 0},
    {0, 0, 1, 1},
    {1, 0, 1, 1},
    {1, 1, 1, 1},
    {0, 1, 1, 1},
    {0, 1, 0, 1},
    {1, 1, 0, 1},
    {1, 0, 0, 1},
    {0, 0, 0, 1}
}

For FullGrayCode[3,2] a novel case I might expect something like this

{
    {0,0},
    {0,1},
    {0,2},
    {1,2},
    {1,1},
    {1,0},
    {2,0},
    {2,1},
    {2,2}
}

For FullGrayCode[3,3] I could expect:

{
    {0,0,0},
    {0,0,1},
    {0,0,2},
    {0,1,2},
    {0,1,1},
    {0,1,0},
    {0,2,0},
    {0,2,1},
    {0,2,2},
    {1,2,2},
    {1,2,1},
    {1,2,0},
    {1,1,0},
    {1,1,1},
    {1,1,2},
    {1,0,2},
    {1,0,1},
    {1,0,0},
    {2,0,0},
    {2,0,1},
    {2,0,2},
    {2,1,2},
    {2,1,1},
    {2,1,0},
    {2,2,0},
    {2,2,1},
    {2,2,2}
}

I originally wrote this:

FullGrayCode[n_Integer?Positive, m_Integer?Positive]:=Module[
  {sequence, baseMIncrement, grayCode},
  baseMIncrement[num_List]:=Module[
    {carry, pos, numCopy},
    carry = 1;
    pos = Length[num];
    numCopy = num;
    While[pos > 0 && carry > 0,
      numCopy[[pos]] = Mod[numCopy[[pos]] + carry, m];
      carry = If[numCopy[[pos]] == 0, 1, 0];
      pos--;
    ];
    numCopy
  ];
  grayCode[num_List] := Module[
    {gray},
    gray = num;
    gray[[1]] = Mod[gray[[1]] + 1, m];
    If[gray[[1]] != 0,
      gray[[2]] = Mod[gray[[2]] + 1, m]
    ];
    gray
  ];
  sequence = {ConstantArray[0, n]};
  For[i = 1, i < m^n, i++,
    sequence = Append[sequence, grayCode[baseMIncrement[sequence[[-1]]]]];
  ];
  sequence
]

but the difference between the first and second (and so on) have all of the bits changing except for one of them, it should be one of the bits change.

Additional hand done case in Excel for FullGrayCode[3,4] (non-efficient and rotated 2-3):

{
    {0,0,0},
    {0,0,1},
    {0,0,3},
    {0,0,2},
    {0,1,2},
    {0,1,3},
    {0,1,1},
    {0,1,0},
    {0,3,0},
    {0,3,1},
    {0,3,3},
    {0,3,2},
    {0,2,2},
    {0,2,3},
    {0,2,1},
    {0,2,0},
    {1,2,0},
    {1,2,1},
    {1,2,3},
    {1,2,2},
    {1,3,2},
    {1,3,3},
    {1,3,1},
    {1,3,0},
    {1,1,0},
    {1,1,1},
    {1,1,3},
    {1,1,2},
    {1,0,2},
    {1,0,3},
    {1,0,1},
    {1,0,0},
    {3,0,0},
    {3,0,1},
    {3,0,3},
    {3,0,2},
    {3,1,2},
    {3,1,3},
    {3,1,1},
    {3,1,0},
    {3,3,0},
    {3,3,1},
    {3,3,3},
    {3,3,2},
    {3,2,2},
    {3,2,3},
    {3,2,1},
    {3,2,0},
    {2,2,0},
    {2,2,1},
    {2,2,3},
    {2,2,2},
    {2,3,2},
    {2,3,3},
    {2,3,1},
    {2,3,0},
    {2,1,0},
    {2,1,1},
    {2,1,3},
    {2,1,2},
    {2,0,2},
    {2,0,3},
    {2,0,1},
    {2,0,0}
}
Improve this question
$\endgroup$
7
  • 1
    $\begingroup$ You might be interested in the GrayCode resource function (resources.wolframcloud.com/FunctionRepository/resources/…). See in the examples on that page how to combine its output with PadLeft to obtain something that looks very much like your output. $\endgroup$
    – MarcoB
    May 2 at 13:08
  • $\begingroup$ @MarcoB sorry that is not what I am wanting thanks. I also want this to be able to work in any base too for a specific red bit length too. $\endgroup$
    – More Senne
    May 2 at 13:10
  • 1
    $\begingroup$ @MoreSenne that is an important bit of information that is better added to your question as an edit. What was suggested seems only to differ from your expected output by the padding direction. $\endgroup$
    – CA Trevillian
    May 2 at 13:17
  • 1
    $\begingroup$ @CATrevillian thanks. I have done two more hand examples. $\endgroup$
    – More Senne
    May 2 at 13:34
  • 1
    $\begingroup$ I think the orderings in your examples are not consistent. Which might or might not matter, depending on what exactly is required (in case the problem at hand was not fully specified). $\endgroup$
    – Daniel Lichtblau
    May 2 at 15:22

4 Answers 4

Reset to default
6
$\begingroup$

A simple recursion handles this.

fullGrayCode[1, n_Integer] /; n >= 1 := Transpose[{Range[0, n - 1]}]

fullGrayCode[m_Integer, n_Integer] /; m >= 2 && n >= 1 := Module[
  {gcm1 = fullGrayCode[m - 1, n], revgcm1},
  revgcm1 = Reverse[gcm1];
  Apply[Join,
   Table[Map[Join[{j}, #] &, If[EvenQ[j], gcm1, revgcm1]]
    , {j, 0, n - 1}]]
  ]

Examples:

In[36]:= fullGrayCode[3, 3]

(* Out[36]= {{0, 0, 0}, {0, 0, 1}, {0, 0, 2}, {0, 1, 2}, {0, 1, 1}, {0, 
  1, 0}, {0, 2, 0}, {0, 2, 1}, {0, 2, 2}, {1, 2, 2}, {1, 2, 1}, {1, 2,
   0}, {1, 1, 0}, {1, 1, 1}, {1, 1, 2}, {1, 0, 2}, {1, 0, 1}, {1, 0, 
  0}, {2, 0, 0}, {2, 0, 1}, {2, 0, 2}, {2, 1, 2}, {2, 1, 1}, {2, 1, 
  0}, {2, 2, 0}, {2, 2, 1}, {2, 2, 2}} *)

In[37]:= fullGrayCode[4, 2]

(* Out[37]= {{0, 0, 0, 0}, {0, 0, 0, 1}, {0, 0, 1, 1}, {0, 0, 1, 0}, {0, 
  1, 1, 0}, {0, 1, 1, 1}, {0, 1, 0, 1}, {0, 1, 0, 0}, {1, 1, 0, 
  0}, {1, 1, 0, 1}, {1, 1, 1, 1}, {1, 1, 1, 0}, {1, 0, 1, 0}, {1, 0, 
  1, 1}, {1, 0, 0, 1}, {1, 0, 0, 0}} *)

More strenuous example:

In[237]:= Timing[fgc = fullGrayCode[10, 6];]
fgc // Dimensions

(* Out[237]= {13.5205, Null}

Out[238]= {60466176, 10} *

)

Improve this answer
$\endgroup$
1
  • $\begingroup$ Amazing thanks @Daniel, just wrote this quickly to check that it works, and it does thanks: In[45]:= gr=fullGrayCode[7,8]; Map[Total,Abs[Table[gr[[n-1]]-gr[[n]],{n,2,gr//Length}]]]//Tally Out[46]= {{1,2097151}} $\endgroup$
    – More Senne
    May 3 at 11:16
4
$\begingroup$

Not particularly efficient solution:

Clear[FullGrayCode];

FullGrayCode[m_, n_] := 
 FindHamiltonianCycle[
   Rule @@@ 
    Select[Tuples[SortBy[Tuples[Range[0, n - 1], m], Total], 2], 
     EditDistance @@ # == 1 &]][[1, All, 1]]

FullGrayCode[2, 3]
(* {0,0}
   {0,1}
   {0,2}
   {1,2}
   {1,1}
   {2,1}
   {2,2}
   {2,0}
   {1,0} *)
Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ @MoreSenne, I think there are other answers more suitable for accepting than mine :) $\endgroup$
    – Domen
    May 2 at 15:36
  • 1
    $\begingroup$ just logged in thanks, and I have accepted the other answer. Thanks for your answer too. $\endgroup$
    – More Senne
    May 3 at 10:56
0
$\begingroup$

Here is a simple solution to generate bits as a starting point (order is not considered):

ClearAll[FullGrayCode];

FullGrayCode[m_Integer, n_] := 
 DeleteDuplicates @
 Catenate @
  FixedPointList[
   Catenate @*
    Map[ReplaceList[{a___, b_, c___} :> {a, b + 1, c} /; 
        b < n - 1]], {ConstantArray[0, m]}]

FullGrayCode[4, 2]

(* Out: {{0, 0, 0, 0}, {1, 0, 0, 0}, {0, 1, 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 
  1}, {1, 1, 0, 0}, {1, 0, 1, 0}, {1, 0, 0, 1}, {0, 1, 1, 0}, {0, 1, 
  0, 1}, {0, 0, 1, 1}, {1, 1, 1, 0}, {1, 1, 0, 1}, {1, 0, 1, 1}, {0, 
  1, 1, 1}, {1, 1, 1, 1}} *)

FullGrayCode[2, 3]

(* Out: {{0, 0}, {1, 0}, {0, 1}, {2, 0}, {1, 1}, {0, 2}, {2, 1}, {1, 2}, {2, 
  2}} *)

FullGrayCode[3, 3]

(* Out: {{0, 0, 0}, {1, 0, 0}, {0, 1, 0}, {0, 0, 1}, {2, 0, 0}, {1, 1, 0}, {1,
   0, 1}, {0, 2, 0}, {0, 1, 1}, {0, 0, 2}, {2, 1, 0}, {2, 0, 1}, {1, 
  2, 0}, {1, 1, 1}, {1, 0, 2}, {0, 2, 1}, {0, 1, 2}, {2, 2, 0}, {2, 1,
   1}, {2, 0, 2}, {1, 2, 1}, {1, 1, 2}, {0, 2, 2}, {2, 2, 1}, {2, 1, 
  2}, {1, 2, 2}, {2, 2, 2}} *)
Improve this answer
$\endgroup$
2
  • 3
    $\begingroup$ No, that is incorrect, your code gives: {{0,0,0,0}, {1,0,0,0}, {0,1,0,0, …}}. That is two bits changing. Gray code only allows one but to ever change at a time. $\endgroup$
    – More Senne
    May 2 at 13:48
  • 1
    $\begingroup$ @MoreSenne You're right, the order is not considered. I'll think about how to fix it. $\endgroup$
    – Ben Izd
    May 2 at 14:11
0
$\begingroup$

The walsh functions are generated e.g by

(DiscreteHadamardTransform/@IdentityMatrix[4] )+1/2//TableForm

1   1   1   1
1   1   0   0
1   0   0   1
1   0   1   0

Wash function are an an orthogonal function set if seen as the value on the 0,1-valued step functions on integer intervals.

The code is a bit mirror transform of the index bit string that is implemented in GrayCode for sets.

Needs["Combinatorica`" ] many warnings and see: Compatibilty Guide ( I cannot find)

GrayCode[{a, b, c, d}] // TableForm

d
c d
c
b c
b c d
b d
b
a b
a b d
a b c d a b c
a c
a c d
a d
a

So the functonality will now be found somewhere in Permutations, Subsets, Graphs, I cannot find by a simple ?Gray

Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ No sorry, PadLeft[GrayCode[{0,1,2,3}]], gives {{0,0,0,0},{0,0,0,3},{0,0,2,3},{0,0,0,2},{0,0,1,2},{0,1,2,3},{0,0,1,3},{0,0,0,1},{0,0,0,1},{0,0,1,3},{0,1,2,3},{0,0,1,2},{0,0,0,2},{0,0,2,3},{0,0,0,3},{0,0,0,0}} again this steps further than 1 but between the third and forth. $\endgroup$
    – More Senne
    May 2 at 14:50

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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