49
$\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$
7
  • $\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, 2013 at 14:44
  • 1
    $\begingroup$ Did you look at Flatten command. Flatten[%, 1] should help. $\endgroup$
    – s.s.o
    Feb 25, 2013 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, 2013 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, 2013 at 14:51
  • 1
    $\begingroup$ Strongly related $\endgroup$ Oct 11, 2013 at 14:27

4 Answers 4

48
$\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$
5
  • $\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, 2015 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, 2015 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, 2015 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, 2015 at 2:46
  • $\begingroup$ @Mr.Wizard Can you clarify about how the negative level spec and _List work here? For example, if we have expr={{0, {{1, 2}}, {3}}, {4}}, Replace[expr, {x_List} :> x, {0, -3}] gives {{0, {1, 2}, {3}}, {4}}, leaving the {3} and {4} untouched. Doing instead Replace[expr, {x_} :> x, {0, -2}]` gives {{0, {1, 2}, 3}, 4}, but Replace[expr, {x_} :> x, {0, -3}] gives {{0, {1, 2}, {3}}, {4}}. Why this difference for level spec -2 vs -3? And Why does removing the _List requirement enable taking off the brackets from the {3} and {4}? $\endgroup$
    – user106860
    Aug 5, 2021 at 10:11
25
$\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$
9
  • $\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, 2013 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$ Oct 11, 2013 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$ Oct 11, 2013 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$ Oct 11, 2013 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$ Feb 13, 2017 at 11:46
20
$\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$
10
  • $\begingroup$ +1, very nice! This problem makes for a great small case study. $\endgroup$ Oct 11, 2013 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, 2013 at 10:01
  • 2
    $\begingroup$ @m_goldberg, if we were playing code golf I would have written it as +FlattenAt[#, #~Position~{_List}] & :-) $\endgroup$ Oct 13, 2013 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, 2013 at 7:32
  • 1
    $\begingroup$ @Mr.Wizard, I agree it's a duplicate and merging makes sense. $\endgroup$ Feb 13, 2017 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$
6
  • $\begingroup$ Very nice (I already voted), but see my update :) $\endgroup$ Oct 11, 2013 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, 2017 at 10:45
  • 1
    $\begingroup$ @Mr.Wizard Closing/merging both seem fine to me. $\endgroup$
    – Michael E2
    Feb 25, 2017 at 21:39
  • $\begingroup$ Thanks; I have been waiting on your reply. :-) $\endgroup$
    – Mr.Wizard
    Feb 25, 2017 at 21:41
  • $\begingroup$ @Mr.Wizard Work got busy and I took a break from SE. $\endgroup$
    – Michael E2
    Feb 25, 2017 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.