从列表中删除空列表的有效方法，而不需要计算保存的表达式

Question

在之前的线程中提出了一种从列表中删除空列表({})的有效方法:

Replace[expr, x_List :> DeleteCases[x, {}], {0, Infinity}]

使用Trott-Strzebonski就地求值技术，该方法也可以推广到处理保留表达式:

f1[expr_] := 
 Replace[expr, 
  x_List :> With[{eval = DeleteCases[x, {}]}, eval /; True], {0, Infinity}]

此解决方案比基于ReplaceRepeated的解决方案更有效:

f2[expr_] := expr //. {left___, {}, right___} :> {left, right}

但是它有一个缺点:它计算被List包装的表达式:

In[20]:= f1[Hold[{{}, 1 + 1}]]
Out[20]= Hold[{2}]

所以我的问题是:从列表中删除所有空列表({})而不评估持有表达式的最有效方法是什么?只有当空的List[]对象本身是另一个List的元素时，才应该删除。

---

以下是一些时间安排:

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}

定义:

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

Answer 1

如何:

Clear[f3];
f3[expr_] := 
 FixedPoint[
  Function[e, 
   Replace[e, {a___, {}, b___} :> {a, b}, {0, Infinity}]],
   expr]

它似乎符合规格:

In[275]:= f3[{a, {}, {b, {}}, c[d, {}]}]
Out[275]= {a, {b}, c[d, {}]}
In[276]:= f3[Hold[{{}, 1 + 1, {}}]]
Out[276]= Hold[{1 + 1}]

Answer 2

您可以将您提到的解决方案与最小的性能影响结合起来，并使用本文中的技术来保持代码不被评估，并通过使用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];

上面的函数假设输入表达式用Hold封装。例子:

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

Answer 3

我只是有点晚了。: -)

虽然相当复杂，但测试速度比f1:

快一个数量级。

fx[expr_] :=
 Module[{s},
  expr // 
   Quiet[{s} /. {x_} :> ({} /. {x___} -> (# /. {} -> x //. {x ..} -> x) &)]
 ]

不求值:

Hold[{{}, 1 + 1}] // fx

Hold[{1 + 1}]

计时

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

检查

f1@expr === fx@expr
f1@pl   === fx@pl

True
True

解释这个函数的基本版本是这样的:

{} /. {x___} -> (# //. {} | {x ..} -> x) &

这个想法是首先减少//. {} | {x ..} -> x的表达式，然后使用带有空表达式的注入器模式来删除x的所有实例，就好像它们被Sequence[]取代了，但没有求值。

第一个更改是通过将替换拆分到/. {} -> x //. {x ..} -> x中来进行优化。第二个变化是以某种方式在模式中本地化x，这样即使x出现在表达式本身中也不会失败。由于Mathematica处理嵌套作用域结构的方式，我不能简单地使用Module[{x}, . . . ]，而是必须再次使用注入器模式来将一个唯一的符号输入x___等，以及Quiet以防止它抱怨不标准的使用。