从Mathematica中的列表末尾开始搜索

Question

许多算法（如按字典顺序查找列表的下一个排列的算法）涉及查找列表中最后一个元素的索引。但是，我一直无法在Mathematica中找到一种不笨拙的方法。最简单的方法是使用LengthWhile，但它意味着扭转了整个列表，这很可能是低效的，你知道你想要的元素是靠近列表的末尾，扭转谓语感病例：

findLastLengthWhile[list_, predicate_] := 
(Length@list - LengthWhile[Reverse@list, ! predicate@# &]) /. (0 -> $Failed) 

我们可以用Do做一个明确的命令性循环，但是这样做也有点笨拙。这将有助于如果Return实际上从一个函数，而不是Do块返回，但事实并非如此，所以你还不如用Break：

findLastDo[list_, pred_] := 
Module[{k, result = $Failed}, 
    Do[ 
    If[pred@list[[k]], result = k; Break[]], 
    {k, Length@list, 1, -1}]; 
    result] 

最终，我决定用尾递归，迭代这意味着提前终止会更容易一些。使用怪异，但很有用#0符号，让匿名函数调用自己，这成为：

findLastRecursive[list_, pred_] := 
With[{ 
    step = 
    Which[ 
     #1 == 0, $Failed, 
     pred@list[[#1]], #1, 
     True, #0[#1 - 1]] &}, 
    step[Length@list]] 

所有这一切都似乎太辛苦，虽然。有没有人看到更好的方法？

编辑补充：当然，我的首选解决方案有一个错误，这意味着它由于$IterationLimit在长列表中被破坏。

In[107]:= findLastRecursive[Range[10000], # > 10000 &] 
$IterationLimit::itlim: Iteration limit of 4096 exceeded. 
Out[107]= (* gack omitted *) 

您可以Block解决这个问题：

findLastRecursive[list_, pred_] := 
Block[{$IterationLimit = Infinity}, 
    With[{ 
    step = 
    Which[ 
     #1 == 0, $Failed, 
     pred@list[[#1]], #1, 
     True, #0[#1 - 1]] &}, 
    step[Length@list]]] 

$IterationLimit是不是我最喜欢的数学特征。

Answer 1

就我个人而言，我没有看到LengthWhile的解决方案有任何问题。另外，如果我们想重用mma内置列表遍历函数（而不是显式循环或递归），我没有看到避免恢复列表的方法。这是一个版本，但不会颠倒谓词：

Clear[findLastLengthWhile]; 
findLastLengthWhile[{}, _] = 0; 
findLastLengthWhile[list_, predicate_] /; predicate[Last[list]] := Length[list]; 
findLastLengthWhile[list_, predicate_] := 
    Module[{l = Length[list]}, 
    Scan[If[predicate[#], Return[], l--] &, Reverse[list]]; l]; 

是否更简单我不知道。它肯定比基于LengthWhile的效率低，特别是对于打包阵列。此外，我使用返回0的约定，当找不到满足条件的元素时，而不是$Failed，但这只是个人偏好。

编辑

这是基于链表的递归版本，这是较为有效的：

ClearAll[linkedList, toLinkedList]; 
SetAttributes[linkedList, HoldAllComplete]; 
toLinkedList[data_List] := Fold[linkedList, linkedList[], data]; 

Clear[findLastRec]; 
findLastRec[list_, pred_] := 
    Block[{$IterationLimit = Infinity}, 
    Module[{ll = toLinkedList[list], findLR}, 
     findLR[linkedList[]] := 0; 
     findLR[linkedList[_, el_?pred], n_] := n; 
     findLR[linkedList[ll_, _], n_] := findLR[ll, n - 1]; 
     findLR[ll, Length[list]]]] 

一些性能测试：

In[48]:= findLastRecursive[Range[300000],#<9000&]//Timing 
Out[48]= {0.734,8999} 

In[49]:= findLastRec[Range[300000],#<9000&]//Timing 
Out[49]= {0.547,8999} 

EDIT 2

如果你的列表可以做成一个压缩数组（无论大小），那么你可以利用C语言编译循环解决方案。为了避免编译开销，您可以memoize的编译功能，像这样：

Clear[findLastLW]; 
findLastLW[predicate_, signature_] := findLastLW[predicate, Verbatim[signature]] = 
    Block[{list}, 
     With[{sig = List@Prepend[signature, list]}, 
     Compile @@ Hold[ 
     sig, 
     Module[{k, result = 0}, 
      Do[ 
      If[predicate@list[[k]], result = k; Break[]], 
      {k, Length@list, 1, -1} 
      ]; 
      result], 
     CompilationTarget -> "C"]]] 

的Verbatim部分是必要的，因为在像{_Integer,1}典型特征，_Integer否则会被解释为一个模式和memoized定义不会比赛。这里有一个例子：

In[60]:= 
fn = findLastLW[#<9000&,{_Integer,1}]; 
fn[Range[300000]]//Timing 

Out[61]= {0.016,8999} 

编辑3

这里是基于链表的递归解决方案的更加紧凑和更快的版本：

Clear[findLastRecAlt]; 
findLastRecAlt[{}, _] = 0; 
findLastRecAlt[list_, pred_] := 
    Module[{lls, tag}, 
    Block[{$IterationLimit = Infinity, linkedList}, 
     SetAttributes[linkedList, HoldAllComplete]; 
     lls = Fold[linkedList, linkedList[], list]; 
     ll : linkedList[_, el_?pred] := Throw[Depth[Unevaluated[ll]] - 2, tag]; 
     linkedList[ll_, _] := ll; 
     Catch[lls, tag]/. linkedList[] :> 0]] 

它一样快，版本基于Do - 循环，比原来的findLastRecursive快两倍（相关基准即将添加 - 此刻我不能在一台不同的机器上执行一致性测试）。我认为这是一个很好的例子，说明mma中的尾递归解决方案可以像程序化（未编译）那样高效。

Answer 2

这里有一些替代方案，其中有两个是不能扭转列表：

findLastLengthWhile2[list_, predicate_] := 
Length[list]-(Position[list//Reverse, _?(!predicate[#] &),1,1]/.{}->{{0}})[[1, 1]]+1 

findLastLengthWhile3[list_, predicate_] := 
    Module[{lw = 0}, 
     Scan[If[predicate[#], lw++, lw = 0] &, list]; 
     Length[list] - lw 
    ] 

findLastLengthWhile4[list_, predicate_] := 
    Module[{a}, a = Split[list, predicate]; 
     Length[list] - If[predicate[a[[-1, 1]]], Length[a[[-1]]], 0] 
    ] 

一些时序（1号是Pillsy的第一个）发现1点的上次运行10万层1的一个阵列中的其中一个零位置于各个位置。时序是10个重复meusurements平均：用于计时

代码：

Monitor[ 
timings = Table[ 
    ri = ConstantArray[1, {100000}]; 
    ri[[daZero]] = 0; 
    t1 = (a1 = findLastLengthWhile[ri, # == 1 &];) // Timing // First; 
    t2 = (a2 = findLastLengthWhile2[ri, # == 1 &];) // Timing // First; 
    t3 = (a3 = findLastLengthWhile3[ri, # == 1 &];) // Timing // First; 
    t4 = (a4 = findLastLengthWhile4[ri, # == 1 &];) // Timing // First; 
    {t1, t2, t3, t4}, 
    {daZero, {1000, 10000, 20000, 50000, 80000, 90000, 99000}}, {10} 
    ], {daZero} 
] 

ListLinePlot[ 
    Transpose[{{1000, 10000, 20000, 50000, 80000, 90000,99000}, #}] & /@ 
    (Mean /@ timings // Transpose), 
    Mesh -> All, Frame -> True, FrameLabel -> {"Zero position", "Time (s)", "", ""}, 
    BaseStyle -> {FontFamily -> "Arial", FontWeight -> Bold, 
    FontSize -> 14}, ImageSize -> 500 
] 

Answer 3

不是一个真正的答案，只是一对夫妇的findLastDo变种。

（1）实际上，Return可以接收一个未记录的第二个参数，告诉返回的内容。

In[74]:= findLastDo2[list_, pred_] := 
Module[{k, result = $Failed}, 
    Do[If[pred@list[[k]], Return[k, Module]], {k, Length@list, 1, -1}]; 
    result] 

In[75]:= findLastDo2[Range[25], # <= 22 &] 
Out[75]= 22 

（2）更好的是使用捕捉[...投掷...]

In[76]:= findLastDo3[list_, pred_] := 
Catch[Module[{k, result = $Failed}, 
    Do[If[pred@list[[k]], Throw[k]], {k, Length@list, 1, -1}]; 
    result]] 

In[77]:= findLastDo3[Range[25], # <= 22 &] 
Out[77]= 22 

丹尼尔Lichtblau

Answer 4

时序Reverse为字符串和实数

a = DictionaryLookup[__]; 
b = RandomReal[1, 10^6]; 
Timing[Short@Reverse@#] & /@ {a, b} 

(* 
-> 
{{0.016,   {Zyuganov,Zyrtec,zymurgy,zygotic,zygotes,...}}, 
{3.40006*10^-15,{0.693684,0.327367,<<999997>>,0.414146}}} 
*) 

Answer 5

为了冒险...

所

下面的定义定义的包装表达reversed[...]伪装成一个列表对象，其内容似乎是裹列表的反转版本：

reversed[list_][[i_]] ^:= list[[-i]] 
Take[reversed[list_], i_] ^:= Take[list, -i] 
Length[reversed[list_]] ^:= Length[list] 
Head[reversed[list_]] ^:= List 

使用示例：

$list = Range[1000000]; 
Timing[LengthWhile[reversed[$list], # > 499500 &]] 
(* {1.248, 500500} *) 

注意，这方法是比实际反转列表慢 ...

Timing[LengthWhile[Reverse[$list], # > 499500 &]] 
(* 0.468, 500500 *) 

...但它当然使用更少的内存。

我不会推荐这种技术用于一般用途，因为化妆舞会中的缺陷可以表现为微妙的错误。考虑：为了使仿真更完美，需要实现哪些功能其他？展示的包装器定义显然足够愚弄LengthWhile和TakeWhile对于简单情况，但其他功能（尤其是内核内置插件）可能不容易被愚弄。重写Head似乎特别充满危险。

尽管存在这些缺点，但这种模拟技术有时在受控环境下仍然有用。

Answer 6

优雅的解决办法是：

findLastPatternMatching[{Longest[start___], f_, ___}, f_] := Length[{start}]+1 

(* match this pattern if item not in list *) 
findLastPatternMatching[_, _] := -1 

，但因为它是基于模式匹配，它比其他解决方案建议的方式慢。