为什么 Cases[] 在这里这么慢？有没有什么技巧可以加快速度？

Question

在尝试粘贴图片时，我注意到Cases[] 非常慢。

要复制，首先将大图像复制到剪贴板（只需按 Print Screen），然后评估以下内容：

In[33]:= SetSystemOptions["PackedArrayOptions" -> "UnpackMessage" -> True];

In[34]:= AbsoluteTiming[nb = NotebookGet@ClipboardNotebook[];]
Out[34]= {0.4687500, Null}

In[35]:= AbsoluteTiming[d1 = nb[[1, 1, 1, 1, 1, 1, 1]];]
Out[35]= {0., Null}

In[36]:= AbsoluteTiming[d2 = First@Cases[nb, r_RasterBox :> First[r], Infinity, 1];]

During evaluation of In[36]:= Developer`FromPackedArray::unpack: Unpacking array in call to Notebook. >>

Out[36]= {0.9375000, Null}

^{（我是在windows上做的，不知道粘贴代码在其他系统上是不是一样。）}

请注意，与直接使用 Part 相比，使用 Cases 提取数据非常慢，即使我明确告诉 Cases 我只需要一个匹配项。

我确实发现（如上所示）Cases 出于某种原因触发了解包，即使搜索应该在到达内部的打包数组之前停止。使用比Infinity 更浅的级别规范可能会避免解包。

问题：在这里使用Cases 比Part 更容易也更可靠（如果子表达式可以出现在不同的位置怎么办？）有没有办法让Cases 在这里快速，也许是通过使用不同的模式或不同的选项？

---

^{可能相关问题：Mathematica's pattern matching poorly optimized? （这就是我将Cases 规则从RasterBox[data_, ___] -> data 更改为r_RasterBox :> First[r] 的原因。）}

Answer 1

我现在无法访问 Mathematica，因此以下内容未经测试。我的猜测是 Cases 在这里解包，因为它首先搜索深度，因此首先看到打包的数组。如果这是正确的，那么您可以改用规则（ReplaceAll，而不是 Replace），并在第一次匹配时抛出异常：

Module[{tag},
   Catch[
     nb /. r_RasterBox :> Block[{}, Throw[First[r], tag] /; True]; 
     $Failed, 
     tag]
]

正如我所说，这只是一个未经检验的猜测。

编辑 2：一种基于从模式匹配器中屏蔽部分表达式的方法

序言

在第一次编辑（如下）中，提出了一种相当繁重的方法。在许多情况下，可以采取替代路线。在这个特定问题（以及许多其他类似问题）中，主要问题是以某种方式从模式匹配器中屏蔽某些子表达式。这也可以通过使用规则来实现，用一些虚拟符号临时替换感兴趣的部分。

代码

这是对 Cases 的修改：

Clear[casesShielded];
casesShielded[expr_,pt_,shieldPattern_,levspec_,n_,opts:OptionsPattern[]]:=
   Module[{dummy,inverseShieldingRules, shielded, i=0},
      inverseShieldingRules =
        If[#==={},#,Dispatch@First@#]&@
           Reap[shielded= expr/.(p:shieldPattern):>
             With[{eval = With[{ind = ++i},Sow[dummy[ind]:>p];dummy[ind]]},
                eval/;True];
           ][[2]];
      Cases[shielded,pt,levspec,n,opts]/.inverseShieldingRules]; 

这个版本的Cases 有一个额外的参数shieldPattern（第三个），它指示哪些子表达式必须被模式匹配器屏蔽。

优点和适用性

上面的代码非常轻量级（与下面的 edit1 建议相比），并且它允许人们完全重用和利用现有的 Cases 功能。这适用于主要模式（或规则）对相关部分的屏蔽不敏感的情况，这是一种相当常见的情况（特别是涵盖_h 类型的模式，包括手头的情况）。这也可能比myCases 的应用更快（如下所述）。

手头的案子

在这里，我们需要这个调用：

In[55]:=    
(d4=First@casesShielded[nb,x_RasterBox:>First@x,
    p_List/;Developer`PackedArrayQ[p],Infinity,1]);//Timing

Out[55]= {0.,Null}

结果当然和之前一样：

In[61]:= d2===d4
Out[61]= True

编辑：另一种类似案例的功能

动机和代码

我花了一些时间来生成这个函数，我不能 100% 确定它总是能正常工作，但这里是 Cases 的一个版本，它仍然以深度优先工作，在 sub 之前分析整个表达式-表达式：

ClearAll[myCases];
myCases[expr_, lhs_ :> rhs_, upToLevel_: 1, max : (_Integer | All) : All, 
    opts : OptionsPattern[]] :=
 Module[{tag, result, f, found = 0, aux},
   With[{
    mopts = FilterRules[{opts}, {Heads -> False}],
    frule =
       Apply[
         RuleDelayed,
         Hold[lhs, With[{eval =  aux}, Null /; True]] /.
            {aux :> Sow[rhs, tag] /; max === All, 
             aux :> (found++; Sow[rhs, tag])}
       ]
    },
    SetAttributes[f, HoldAllComplete];
    If[max =!= All,
       _f /; found >= max := Throw[Null, tag]
    ];
    f[x_, n_] /; n > upToLevel := Null;
    f[x_, n_] :=
      Replace[
       HoldComplete[x],
       {
          frule,
          ex : _[___] :> 
            With[{ev = 
              Replace[
                HoldComplete[ex],
                y_ :> With[{eval = f[y, n + 1]}, Null /; True],
                {2},
                Sequence @@ mopts
              ]}, 
              Null /; True
            ]
       },
       {1}
      ]
   ]; (* external With *)
   result = 
     If[# === {}, #, First@#] &@
        Reap[Catch[f[expr, 0], tag], tag, #2 &][[2]];
   (* For proper garbage-collection of f *)
   ClearAll[f]; 
   result
 ]

工作原理

这不是最琐碎的一段代码，所以这里有一些说明。这个版本的Cases 基于我首先建议的相同想法——即，使用规则替换语义首先尝试对整个表达式进行模式匹配，只有当失败时，才转到子表达式。我强调这仍然是深度优先遍历，但不同于标准的遍历（用于大多数表达式遍历函数，如Map、Scan、Cases 等）。我使用Reap 和Sow 来收集中间结果（匹配）。这里最棘手的部分是防止子表达式求值，我不得不将子表达式包装到HoldComplete 中。因此，我不得不使用（嵌套版本的）Trott-Strzebonski 技术（也许有更简单的方法，但我看不到它们），以便在持有的（子）表达式中启用规则的 r.h.sides ，并使用具有适当级别规范的Replace，考虑了额外添加的HoldComplete 包装器。我在规则中返回Null，因为主要动作是对Sow的部分，所以最后注入原始表达式的内容无关紧要。代码增加了一些额外的复杂性以支持级别规范（我只支持单个整数级别，指示要搜索的最大级别，而不是可能的 lev.specs 的全部范围），找到的结果的最大数量，以及Heads 选项。 frule 的代码用于在我们想要找到所有元素的情况下不引入计算找到的元素的开销。我使用相同的Module-generated 标记作为Sow 的标记和异常标记（当找到足够的匹配项时，我用它来停止进程，就像我最初的建议一样）。

测试和基准

要对此功能进行重要的测试，例如，我们可以找到myCases 的DownValues 中的所有符号，并与Cases 进行比较：

In[185]:= 
And@@Flatten[
    Outer[
       myCases[DownValues[myCases],s_Symbol:>Hold[s],#1,Heads->#2]  ===
       Cases[DownValues[myCases],s_Symbol:>Hold[s],#1,Heads->#2]&,
       Range[0,20],
       {True,False}
    ]]

Out[185]= True

myCases 函数比 Cases 慢大约 20-30 倍：

In[186]:= 
Do[myCases[DownValues[myCases],s_Symbol:>Hold[s],20,Heads->True],{500}];//Timing
Out[186]= {3.188,Null}

In[187]:= Do[Cases[DownValues[myCases],s_Symbol:>Hold[s],20,Heads->True],{500}];//Timing
Out[187]= {0.125,Null}

手头的案子

很容易查到myCases解决了原来的解包问题：

In[188]:= AbsoluteTiming[d3=First@myCases[nb,r_RasterBox:>First[r],Infinity,1];]
Out[188]= {0.0009766,Null}

In[189]:= d3===d2
Out[189]= True

希望myCases 在这种情况下通常有用，尽管使用它代替Cases 的性能损失很大并且必须考虑在内。