为什么案例[]这么慢？有什么技巧可以加快速度吗？

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上做了这个,不确定其他系统上的粘贴代码是否相同.)}

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

我确实发现(如上所示)Cases由于某种原因触发解包,即使搜索应该在它到达内部的打包数组之前停止.使用比Infinity可能避免解包的浅层规范.

问题:Cases在这里 使用比Part(如果子表达式可以出现在不同的位置怎么样？)更容易和更可靠？有没有办法在Cases这里快速,可能通过使用不同的模式或不同的选项？

---

^{可能相关的问题:Mathematica的模式匹配效果不佳？ (这就是为什么我改变了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

编辑:一个类似于案例的功能

动机和代码

我花了一段时间来生成这个函数,我并不是百分之百确定它总是正常工作,但是这里有一个版本Cases,虽然仍然在深度优先工作,但在子表达式之前将表达式作为一个整体进行分析:

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技术(也许,有更简单的方法,但我无法看到它们),以便能够在保持(子)表达式中规则化的rhsides,并使用Replace适当的级别规范,考虑额外添加的HoldComplete包装器.我返回Null规则,因为主要动作是Sow部分,所以在最后注入原始表达式并不重要.代码添加了一些额外的复杂性以支持级别规范(我只支持单个整数级别,指示要搜索的最大级别,而不是可能的lev.specs的全部范围),找到的最大结果数量,以及该Heads选项.代码用于frule在我们想要查找所有元素的情况下不引入计算找到元素的开销.我使用相同的Module生成标记作为标记Sow,并作为异常的标记(当我找到足够的匹配时,我用它来停止进程,就像我原来的建议一样).

测试和基准

有此功能的非平凡的测试,例如,我们可以发现在所有符号DownValues的myCases,并比较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是实质性的并且必须被考虑在内.