# Efficient generation of n-bit base-m Gray code with adjacent bit changes

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}
}

• 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. May 2 at 13:08
• @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. May 2 at 13:10
• @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. May 2 at 13:17
• @CATrevillian thanks. I have done two more hand examples. May 2 at 13:34
• 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). May 2 at 15:22

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} *


)

• 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}} May 3 at 11:16

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} *)

• @MoreSenne, I think there are other answers more suitable for accepting than mine :) May 2 at 15:36
• just logged in thanks, and I have accepted the other answer. Thanks for your answer too. May 3 at 10:56

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}} *)

• 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. May 2 at 13:48
• @MoreSenne You're right, the order is not considered. I'll think about how to fix it. May 2 at 14:11

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

• 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. May 2 at 14:50