How to remove redundant {} from a nested list of lists?

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 //..

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.

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