# Simpler way to create special binary Lists

I want to create a List of binary arrays, which are combination of two inverse binary Tuples, like this:

tup3={{0, 0, 0, 1, 1, 1}, {0, 0, 1, 1, 1, 0}, {0, 1, 0, 1, 0, 1},
{0, 1, 1, 1, 0, 0}, {1, 0, 0, 0, 1, 1}, {1, 0, 1, 0, 1, 0},
{1, 1, 0, 0, 0, 1}, {1, 1, 1, 0, 0, 0}}


I was able to create it using Riffle and then reshaping the array (for arbitrary nn):

nn=3;
ArrayReshape[Riffle[Tuples[{0, 1}, nn], Tuples[{1, 0}, nn]], {2^nn, 2*nn}]


However it looks too complicated to me, and I believe that Mathematica would provide a simpler method. Also I wonder whether there is a faster method.

Edit: Let me compare all methods up to now in terms of speed:

Edit2 (01.01.2017, 23.00): For nn=23:

• SimonWoods2: 3.38987sec
• kglr5: 3.3****
• kglr4: 3.5703sec
• NicoDean: 6.63795sec
• SimonWoods1: 7.68363sec
• kglr3: 8.21169sec
• BobHanlon: 10.9597sec
• kglr2: 22.067sec
• kglr1: 22.9503sec

The methods of Simon Woods and kglr are significantly faster than my solution, and at the moment faster than any other proposals. And the top-3 for nn=27:

• kglr (PadRight): 63.13 +/- 2.86 sec (individual: 61.2264, 60.551, 63.6354, 67.7876, 62.4526)
• kglr (ArrayPad): 63.18 +/- 1.75 sec (individual: 63.54, 60.27, 63.57, 65.03, 63.50)
• Simon Woods (ArrayFlatten): 62.89 +/- 3.00 sec (individual: 58.5406, 63.3664, 64.3787, 65.2684)

(very similar and within the errors)

This is faster:

ArrayFlatten[{{Tuples[{0, 1}, nn], Tuples[{1, 0}, nn]}}]


This is slower, but as an alternative approach:

IntegerDigits[Range[2^nn] (2^nn - 1), 2, 2 nn]

• Thanks, your first method is significantly faster than mine (and all other proposed ones). I was not aware of ArrayFlatten before, thank you. Jan 1, 2017 at 21:39
• You're welcome. kglr's latest is very competitive, I would not be surprised to see faster methods appear. I suggest you let this question remain open for at least a day or two - these list manipulation performance optimisation questions tend to be very popular and often produce some interesting tricks and clever code. Jan 1, 2017 at 21:47
• I am surprised that IntegerDigits is so much slower here. Any thought to why that is? Jan 1, 2017 at 23:09
• It's a bit faster if you expand out the Range[]: With[{s = 2^nn}, IntegerDigits[Range[s - 1, s^2 - s, s - 1] , 2, 2 nn]], but still slower than Tuples[]. I also note that the first method yields a packed array, but the second one doesn't. Jan 2, 2017 at 8:44
• @Mr.Wizard, the IntegerDigits method produces an array which is unpacked at the top level, though I'm not sure if that accounts for the difference. I think maybe Tuples is just very very fast. Jan 2, 2017 at 10:47

Starting with a fresh kernel to keep caching from affecting the timings

f1[nn_] := f1[nn] =
ArrayReshape[
Riffle[Tuples[{0, 1}, nn], Tuples[{1, 0}, nn]],
{2^nn, 2*nn}]

f2[nn_] := f2[nn] =
Flatten /@ Transpose[{Tuples[{0, 1}, nn], Tuples[{1, 0}, nn]}]


f3[nn_] := f3[nn] =
ArrayFlatten[{{Tuples[{0, 1}, nn], Tuples[{1, 0}, nn]}}]


Since the time grows exponentially, use ListLogPlot

ListLogPlot[
Table[{
AbsoluteTiming[f1[n]][[1]],
AbsoluteTiming[f2[n]][[1]],
AbsoluteTiming[f3[n]][[1]]}, {n, 24}] //
Transpose,
Joined -> True,
PlotLegends -> {f1, f2, f3}]


Solution provided by @SimonWoods performs best. Verifying that the functions are equivalent

And @@ Table[f1[n] === f2[n] === f3[n], {n, 24}]

(*  True  *)


Update: Alternatives using ArrayPad and PadRight:

(out1 = ArrayPad[Tuples[{0, 1}, nn], {{0}, {0, nn}}, Tuples[{1, 0}, nn]]);
// AbsoluteTiming // First


0.344810

(out1a = PadRight[Tuples[{0, 1}, nn], {2^nn, 2 nn}, Tuples[{1, 0}, nn]]);
// AbsoluteTiming // First


0.315793

(out1b = ArrayReshape[Riffle[Tuples[{0, 1}, nn], Tuples[{1, 0}, nn]], {2^nn, 2*nn}]);
// AbsoluteTiming // First


0.687106

Simon's updated version is the fastest among the three methods:

(out1c = ArrayFlatten[{{Tuples[{0, 1}, nn], Tuples[{1, 0}, nn]}}]); //
AbsoluteTiming // First


0.259235

 out1 == out1a == out1b == out1c


True

Original Post:

Join @@@ Transpose[{#, Reverse@#}] &@Tuples[{0, 1}, nn]


or

MapThread[Join, {#, Reverse@#} &@Tuples[{0, 1}, nn]]


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

Note: both of these are much slower than OP's method.

ArrayReshape[Transpose@{#, Reverse@#} &@Tuples[{0, 1}, nn], {2^nn, 2*nn}]


is much faster but still not as fast as OP's approach.

• Thank you kglr, this is certainly much simpler than my method, much more elegant (i didn't think of Join). However, surprisingly, it is quite a bit slower than my method. Jan 1, 2017 at 18:46