6
$\begingroup$

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: enter image description here

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)

Improve this question
$\endgroup$
7
$\begingroup$

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]
Improve this answer
$\endgroup$
5
  • $\begingroup$ Thanks, your first method is significantly faster than mine (and all other proposed ones). I was not aware of ArrayFlatten before, thank you. $\endgroup$
    – Mario Krenn
    Jan 1 '17 at 21:39
  • 1
    $\begingroup$ 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. $\endgroup$
    – Simon Woods
    Jan 1 '17 at 21:47
  • $\begingroup$ I am surprised that IntegerDigits is so much slower here. Any thought to why that is? $\endgroup$
    – Mr.Wizard
    Jan 1 '17 at 23:09
  • $\begingroup$ 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. $\endgroup$
    – J. M. can't deal with it ♦
    Jan 2 '17 at 8:44
  • $\begingroup$ @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. $\endgroup$
    – Simon Woods
    Jan 2 '17 at 10:47
4
$\begingroup$

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

Adding solution provided by @SimonWoods

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

enter image description here

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

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

(*  True  *)
Improve this answer
$\endgroup$
4
$\begingroup$

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.

Improve this answer
$\endgroup$
1
  • $\begingroup$ 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. $\endgroup$
    – Mario Krenn
    Jan 1 '17 at 18:46

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.