Efficient way to remove empty lists from lists without evaluating held expressions?
In previous thread an efficient way to remove empty lists ({}
) from lists was suggested:
Replace[expr, x_List :> DeleteCases[x, {}], {0, Infinity}]
Using the Trott-Strzebonski in-place evaluation technique this method can be generalized for working also with held expressions:
f1[expr_] :=
Replace[expr,
x_List :> With[{eval = DeleteCases[x, {}]}, eval /; True], {0, Infinity}]
This solution is more efficient than the one based on ReplaceRepeated
:
f2[expr_] := expr //. {left___, {}, right___} :> {left, right}
But it has one disadvantage: it evaluates held expressions if they are wrapped by List
:
In[20]:= f1[Hold[{{}, 1 + 1}]]
Out[20]= Hold[{2}]
So my question is: what is the most efficient way to remove all empty lists ({}
) from lists without evaluating held expressions? The empty List[]
object should be removed only if it is a开发者_运维百科n element of another List
itself.
Here are some timings:
In[76]:= expr = Tuples[Tuples[{{}, {}}, 3], 4];
First@Timing[#[expr]] & /@ {f1, f2, f3}
pl = Plot3D[Sin[x y], {x, 0, Pi}, {y, 0, Pi}];
First@Timing[#[pl]] & /@ {f1, f2, f3}
Out[77]= {0.581, 0.901, 5.027}
Out[78]= {0.12, 0.21, 0.18}
Definitions:
Clear[f1, f2, f3];
f3[expr_] :=
FixedPoint[
Function[e, Replace[e, {a___, {}, b___} :> {a, b}, {0, Infinity}]], expr];
f1[expr_] :=
Replace[expr,
x_List :> With[{eval = DeleteCases[x, {}]}, eval /; True], {0, Infinity}];
f2[expr_] := expr //. {left___, {}, right___} :> {left, right};
How about:
Clear[f3];
f3[expr_] :=
FixedPoint[
Function[e,
Replace[e, {a___, {}, b___} :> {a, b}, {0, Infinity}]],
expr]
It seems to live up to the specs:
In[275]:= f3[{a, {}, {b, {}}, c[d, {}]}]
Out[275]= {a, {b}, c[d, {}]}
In[276]:= f3[Hold[{{}, 1 + 1, {}}]]
Out[276]= Hold[{1 + 1}]
You can combine the solutions you mentioned with a minimal performance hit and maintain the code unevaluated by using a technique from this post, with a modification that the custom holding wrapper will be made private by using Module
:
ClearAll[removeEmptyListsHeld];
removeEmptyListsHeld[expr_Hold] :=
Module[{myHold},
SetAttributes[myHold, HoldAllComplete];
Replace[MapAll[myHold, expr, Heads -> True],
x : myHold[List][___] :>
With[{eval = DeleteCases[x, myHold[myHold[List][]]]},
eval /; True],
{0, Infinity}]//. myHold[x_] :> x];
The above function assumes that the input expression is wrapped in Hold
. Examples:
In[53]:= expr = Tuples[Tuples[{{}, {}}, 3], 4];
First@Timing[#[expr]] & /@ {f1, f2, f3, removeEmptyListsHeld[Hold[#]] &}
Out[54]= {0.235, 0.218, 1.75, 0.328}
In[56]:= removeEmptyListsHeld[Hold[{{},1+1,{}}]]
Out[56]= Hold[{1+1}]
I'm just a bit late with this one. ;-)
Though rather complicated this tests about an order of magnitude faster than your f1
:
fx[expr_] :=
Module[{s},
expr //
Quiet[{s} /. {x_} :> ({} /. {x___} -> (# /. {} -> x //. {x ..} -> x) &)]
]
It does not evaluate:
Hold[{{}, 1 + 1}] // fx
Hold[{1 + 1}]
Timings
expr = Tuples[Tuples[{{}, {}}, 3], 4];
First @ Timing @ Do[# @ expr, {100}] & /@ {f1, fx}
pl = Plot3D[Sin[x y], {x, 0, Pi}, {y, 0, Pi}];
First @ Timing @ Do[# @ pl, {100}] & /@ {f1, fx}
{10.577, 0.982} (* 10.8x faster *) {1.778, 0.266} (* 6.7x faster *)
Check
f1@expr === fx@expr
f1@pl === fx@pl
True True
Explanation
The basic version of this function would look like this:
{} /. {x___} -> (# //. {} | {x ..} -> x) &
The idea is to first reduce the expression with //. {} | {x ..} -> x
and then use the injector pattern with an empty expression to remove all instances of x
, as though they were replaced with Sequence[]
but without evaluation.
The first change is to optimize this somewhat by splitting the replacement into /. {} -> x //. {x ..} -> x
. The second change is to somehow localize x
in the patterns so that it does not fail if x
appears in the expression itself. Because of the way Mathematica handles nested scoping constructs I cannot simply use Module[{x}, . . . ]
but instead have to use the injector pattern again to get a unique symbol into x___
etc., and Quiet
to keep it from complaining about the nonstandard use.
精彩评论