46
$\begingroup$

There are numerous examples here, whose end result is the removal of empty brackets {} and empty lists. I still can't find an example of simply removing redundant brackets though.

It's hard for me to believe there isn't already a common solution to this problem. Please point me there if I missed it. As I am new to Mathematica I am learning primarily by example so when I ran into this problem I was at a loss of where to even start.

For example I have this list as INPUT to a new function:

{
{{{0, 5}, {1, 4}, {2, 3}, {3, 2}, {4, 1}, {5, 0}}},
{{{1, 5}, {2, 4}, {3, 3}, {4, 2}, {5, 1}}},
{{{2, 5}, {3, 4}, {4, 3}, {5, 2}}},
{{{3, 5}, {4, 4}, {5, 3}}},
{{{4, 5}, {5, 4}}},
{{{5, 5}}, {{5, 5}}}
}

I would like the new function to generate this list as OUTPUT:

{
{{0, 5}, {1, 4}, {2, 3}, {3, 2}, {4, 1}, {5, 0}},
{{1, 5}, {2, 4}, {3, 3}, {4, 2}, {5, 1}},
{{2, 5}, {3, 4}, {4, 3}, {5, 2}},
{{3, 5}, {4, 4}, {5, 3}},
{{4, 5}, {5, 4}},
{{5, 5}, {5, 5}}
}


The actual input TO new function:

{{{{0, 5}, {1, 4}, {2, 3}, {3, 2}, {4, 1}, {5, 0}}}, {{{1, 5}, {2, 4}, {3, 3}, {4, 2}, {5, 1}}}, {{{2, 5}, {3, 4}, {4, 3}, {5, 2}}}, {{{3, 5}, {4, 4}, {5, 3}}}, {{{4, 5}, {5, 4}}}, {{{5, 5}}, {{5, 5}}}}

The actual output FROM new function:

{{{0, 5}, {1, 4}, {2, 3}, {3, 2}, {4, 1}, {5, 0}}, {{1, 5}, {2, 4}, {3, 3}, {4, 2}, {5, 1}}, {{2, 5}, {3, 4}, {4, 3}, {5, 2}}, {{3, 5}, {4, 4}, {5, 3}}, {{4, 5}, {5, 4}}, {{5, 5}, {5, 5}}}
$\endgroup$
  • $\begingroup$ Your example following "At this point' makes no sense, because expressions like (t,c) have no meaning, nor do expressions enclosed in square brackets. Otherwise, it appears you are asking to apply a replacement rule like //. {a_List->a} to your expressions. Is that what you're looking for? $\endgroup$ – whuber Feb 25 '13 at 14:44
  • $\begingroup$ Did you look at Flatten command. Flatten[%, 1] should help. $\endgroup$ – s.s.o Feb 25 '13 at 14:45
  • 2
    $\begingroup$ @s.s.o Flatten will only help if the extra brackets are at a particular level. If the idea is to get rid of extra brackets anywhere in the expression something else will be needed. I think my replacement rule is probably the simplest way. $\endgroup$ – Mr.Wizard Feb 25 '13 at 14:46
  • 2
    $\begingroup$ @s.s.o No, I used //. so that it will keep applying the rule until all extraneous brackets are gone. Probably not the most efficient way, but it should be effective. $\endgroup$ – Mr.Wizard Feb 25 '13 at 14:51
  • 1
    $\begingroup$ Strongly related $\endgroup$ – Leonid Shifrin Oct 11 '13 at 14:27
45
$\begingroup$

Starting with:

a = {{{{0, 5}, {1, 4}, {2, 3}, {3, 2}, {4, 1}, {5, 0}}}, {{{1, 5}, {2, 4}, {3, 3}, {4, 
      2}, {5, 1}}}, {{{2, 5}, {3, 4}, {4, 3}, {5, 2}}}, {{{3, 5}, {4, 4}, {5, 3}}}, {{{4, 
      5}, {5, 4}}}, {{{5, 5}}, {{5, 5}}}};

This is probably the simplest:

a //. {x_List} :> x

A single-pass method

Though using ReplaceRepeated is pleasingly concise it is not efficient with deeply nested lists. Because ReplaceAll and ReplaceRepeated scan from the top level the expression will have to be scanned multiple times.

Instead we should use Replace which scans expressions from the bottom up. This means that subexpressions such as {{{{6}}}} will have redundant heads sequentially stripped without rescanning the entire expression from the top. We can start scanning at levelspec -3 because {{}} has a Depth of 3; this further reduces scanning.

expr = {{1, 2}, {{3}}, {{{4, 5}}}, {{{{6}}}}};

Replace[expr, {x_List} :> x, {0, -3}]
{{1, 2}, {3}, {4, 5}, {6}}

Here I will use FixedPointList in place of ReplaceRepeated to count the number of times the expression is scanned in the original method:

Rest @ FixedPointList[# /. {x_List} :> x &, expr] // Column
{{1,2},{3},{{4,5}},{{{6}}}}
{{1,2},{3},{4,5},{{6}}}
{{1,2},{3},{4,5},{6}}
{{1,2},{3},{4,5},{6}}

We see that the expression was scanned four times, corresponding to the three levels that were stripped from {{{{6}}}} plus an additional scan where nothing is changed, which is how both FixedPointList and ReplaceRepeated terminate. To see the full extent of this scanning try:

expr //. {_?Print -> 0, {x_List} :> x};

Or to merely count the total number of matches attempted:

Reap[expr //. {_?Sow -> 0, {x_List} :> x}][[2, 1]] // Length
50

We see that only 7 expressions in total are scanned with the single-pass method:

Reap[
  Replace[expr, {_?Sow -> 0, {x_List} :> x}, {0, -3}]
][[2, 1]] // Length
7

Timings

Let us compare the performance of these two methods on a highly nested expression.

fns = {Append[#, RandomInteger[9]] &, Prepend[#, RandomInteger[9]] &, {#} &};

SeedRandom[1]
big = Nest[RandomChoice[fns][#] & /@ # &, {{1}}, 10000];
Depth[big]
3264
big //. {x_List} :> x                           // Timing // First
Replace[big, {x_List} :> x, {0, -3}] ~Do~ {800} // Timing // First
0.452

0.468

On this huge expression the single-pass Replace is about 800 times faster than //..

$\endgroup$
  • $\begingroup$ I have a similar problem, but somehow none of the suggestions here worked. My code looks like {{{0}}, {{1}}, {{2}}, {{0, 0}}, {{0, 1}, {1, 0}}, {{0, 2}, {2, 0}}, {{1, 1}}, {{1, 2}, {2, 1}}, {{2, 2}}, {{0, 0, 1}, {0, 1, 0}, {1, 0, 0}}, {{0, 0, 2}, {0, 2, 0}, {2, 0, 0}}, {{0, 1, 1}, {1, 0, 1}, {1, 1, 0}}, {{0, 1, 2}, {0, 2, 1}, {1, 0, 2}, {1, 2, 0}, {2, 0, 1}, {2, 1, 0}}, {{0, 2, 2}, {2, 0, 2}, {2, 2, 0}}, {{1, 1, 2}, {1, 2, 1}, {2, 1, 1}}, {{1, 2, 2}, {2, 1, 2}, {2, 2, 1}}} I would just like to have a list of single sets of numbers like {{1,2},{0,1,2},{2.2},...,{1,0,0}} $\endgroup$ – Raksha Mar 21 '15 at 1:13
  • $\begingroup$ @Solarmew It is not clear how your input would be transformed into that output. However I suspect you want one of Flatten, Join, or Union. For example start by assigning your existing code to expr, then try each of these: Union @@ expr, Join @@ expr, Flatten[expr, 1]. $\endgroup$ – Mr.Wizard Mar 21 '15 at 2:20
  • $\begingroup$ Wizard , turns out what i was looking for was {x__?(Head[#] =!= List &)} :> {x}, -1])]; , which, as you can see from my most recent post, was part of a massive overkill to begin with XD $\endgroup$ – Raksha Mar 21 '15 at 2:35
  • 1
    $\begingroup$ @Solarmew For that example you could replace Cases[Permutations /@ Rest@DeleteDuplicates@Subsets[n], {x__?(Head[#] =!= List &)} :> {x}, -1] with Join @@ Permutations /@ Rest@DeleteDuplicates@Subsets[n] or Flatten[Permutations /@ Rest@DeleteDuplicates@Subsets[n], 1]. These will both be faster than using pattern matching. $\endgroup$ – Mr.Wizard Mar 21 '15 at 2:46
24
$\begingroup$

NOTE: merged from a later duplicate question


Update

Ok, since this became another shootout, here is my answer to the challenge:

lremoveFaster[lst_List]:= Replace[lst, {l_List} :> l, {0, Infinity}]

my benchmarks show that it is the fastest so far.

Initial solution

Here is a recursive version:

ClearAll[lremove];
lremove[{l_List}] := lremove[l];
lremove[l_List] := Map[lremove, l];
lremove[x_] := x;

So that

lremove[l]

(* {{{2, 2}, 3}, 2, {2, 33}, 4, 5} *)

"Theoretically", it should be more efficient than ReplaceRepeated for large lists, since the latter has to do many passes through expression. I don't have the time to benchmark right now, though.

Another difference is that lremove will be "stopped" by heads other than List, and not remove extra lists inside such heads. In contrast, ReplaceRepeated -based solution is greedy and will also work inside other heads. Which one is better depends on the goals.

$\endgroup$
  • $\begingroup$ Nice improvement. (I already voted, too). But, darn it, I considered Replace but thought it wouldn't handle {{{1}}} -- just do one replacement. Stupid me. Learned something new. Thanks for playing. $\endgroup$ – Michael E2 Oct 11 '13 at 13:37
  • $\begingroup$ @MichaelE2 Here you can find an explanation why Replace is more efficient in this case than ReplaceAll: how does mathematica determine which rule to use first in substitution. $\endgroup$ – Alexey Popkov Oct 11 '13 at 13:44
  • $\begingroup$ Thanks, @AlexeyPopkov, I was looking for some links like this one. But there were two more, one actually for a question asked by you, IIRC. Will try to find them. $\endgroup$ – Leonid Shifrin Oct 11 '13 at 13:46
  • $\begingroup$ @MichaelE2 Ok, this one is the one I was looking for, although there has to be yet another one that is relevant, if memory serves. $\endgroup$ – Leonid Shifrin Oct 11 '13 at 13:48
  • 1
    $\begingroup$ @Mr.Wizard Seems like a dupe indeed. Interesting that it had to wait for so long to be discovered. I have no objections to both closing this one as a dupe (which you already did) and merging these. $\endgroup$ – Leonid Shifrin Feb 13 '17 at 11:46
19
$\begingroup$

You can also use Position to find the locations of the nested braces and FlattenAt to flatten the list at those positions:

strip = Identity @ FlattenAt[#, Position[#, {_List}]] &

strip @ {{{{{{2, 2}}, 3}, 2, {{2, 33}}, 4, 5}}}
(* {{{2, 2}, 3}, 2, {2, 33}, 4, 5} *)
$\endgroup$
  • $\begingroup$ +1, very nice! This problem makes for a great small case study. $\endgroup$ – Leonid Shifrin Oct 11 '13 at 12:40
  • $\begingroup$ If we were playing code golf, I could beat you by three characters with strip = List @@ FlattenAt[#, Position[#, {_List}]] & :) $\endgroup$ – m_goldberg Oct 13 '13 at 10:01
  • 2
    $\begingroup$ @m_goldberg, if we were playing code golf I would have written it as +FlattenAt[#, #~Position~{_List}] & :-) $\endgroup$ – Simon Woods Oct 13 '13 at 15:40
  • $\begingroup$ @m_goldberg List @@ is not appropriate for the case in which the Head is not List. Such as strip@f[{{}}]. $\endgroup$ – luyuwuli Oct 17 '13 at 7:32
  • 1
    $\begingroup$ @Mr.Wizard, I agree it's a duplicate and merging makes sense. $\endgroup$ – Simon Woods Feb 13 '17 at 10:55
14
$\begingroup$

Update

Here's faster way that avoid reprocessing:

deflate = Block[{flatten},
    flatten[x_List] := x;
    flatten[x___] := {x};
    # /. List -> flatten
    ] &;

Original

In some cases you might be able to use Flatten. In this one, ReplaceRepeated can be use like this:

l = {{{{{{2, 2}}, 3}, 2, {{2, 33}}, 4, 5}}};

l //. {{x___}} :> {x}
(* {{{2, 2}, 3}, 2, {2, 33}, 4, 5} *)

This works, too

l //. {x_List} :> x

Comparison

Timings -- Big lists

We can create some data randomly nesting lists like this:

SeedRandom[1];
l0 = {Table[RandomInteger[{0, 3}], {5}]}
Nest[# /. i_?Positive :> RandomChoice[{0, 1, 0, 1, 3, 4}, i] &, l0, 3]

(* {{3, 1, 0, 1, 1}} *)
(* {{{0, 0, {{0, 3, 0}}}, {{{1}, {0, 0, 0}, 0}}, 0, {0}, {0}}} *)

Each positive number is replace recursively by a list of length equal to the number. We get excess braces every time the number 1 is replaced in a list {1}.

Here is a big list:

SeedRandom[1];
l0 = {Table[RandomInteger[{0, 3}], {5}]}
l2 = Nest[# /. i_?Positive :> RandomChoice[{0, 1, 0, 1, 3, 4}, i] &, l0, 38];

(* l2 // Flatten // Length *)
(* 537612 *)

It has over 95,000 extra braces:

Module[{cnt = 0},
 f1 = l2 //. {x_List} :> (cnt++; x);
 cnt
 ]
(* 95784 *)

f1 = l2 //. {x_List} :> x; // AbsoluteTiming
f2 = deflate[l2]; // AbsoluteTiming
f3 = lremove[l2]; // AbsoluteTiming
f4 = lremoveFaster[l2]; //AbsoluteTiming

{2.814402, Null}
{0.558850, Null}
{0.773060, Null}
{0.155110, Null}

f1 == f2 == f3 == f4

True

Timings -- Small lists

Here we'll use the OP's list and the site's favorite timeAvg function.

SetAttributes[timeAvg, HoldFirst]
timeAvg[func_] := Do[If[# > 0.3, Return[#/5^i]] & @@ Timing@Do[func, {5^i}], {i, 0, 15}]

l //. {x_List} :> x; // timeAvg
deflate[l]; // timeAvg
lremove[l]; // timeAvg
lremoveFaster[l]; // timeAvg

9.2105*10^-6
0.0000167781
0.0000108307
6.2308*10^-6

One can see that ReplaceRepeated, while rather natural and short to code, takes rather a long time on big lists but is fastest on small ones. Leonid's lremoveFaster is fastest.


Actually, if I make flatten a global function instead of local to deflate, then the speed is comparable to ReplaceRepeated on short lists.

flatten[x_List] := x;
flatten[x___] := {x};
l /. List -> flatten // timeAvg

8.9970*10^-6

$\endgroup$
  • $\begingroup$ Very nice (I already voted), but see my update :) $\endgroup$ – Leonid Shifrin Oct 11 '13 at 12:57
  • $\begingroup$ I stumbled across this old duplicate today and marked it as such. (1) If you disagree please tell me, and why. (2) I think perhaps a merge is in order to move these answers to that question; do you agree or disagree with that idea? $\endgroup$ – Mr.Wizard Feb 13 '17 at 10:45
  • 1
    $\begingroup$ @Mr.Wizard Closing/merging both seem fine to me. $\endgroup$ – Michael E2 Feb 25 '17 at 21:39
  • $\begingroup$ Thanks; I have been waiting on your reply. :-) $\endgroup$ – Mr.Wizard Feb 25 '17 at 21:41
  • $\begingroup$ @Mr.Wizard Work got busy and I took a break from SE. $\endgroup$ – Michael E2 Feb 25 '17 at 22:02

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.