Tìm kiếm từ cuối danh sách trong Mathematica

Question

Nhiều thuật toán (như thuật toán để tìm hoán vị tiếp theo của danh sách theo thứ tự từ điển) liên quan đến việc tìm chỉ mục của phần tử cuối cùng trong danh sách. Tuy nhiên, tôi đã không thể tìm ra cách để làm điều này trong Mathematica mà không phải là vụng về. Cách tiếp cận đơn giản nhất sử dụng LengthWhile, nhưng có nghĩa là đảo ngược toàn bộ danh sách, có khả năng không hiệu quả trong trường hợp bạn biết phần tử bạn muốn ở gần cuối danh sách và đảo ngược ý nghĩa của vị từ:

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

Chúng tôi có thể thực hiện một vòng lặp rõ ràng, bắt buộc với Do, nhưng điều đó cũng sẽ trở nên hơi khó khăn. Nó sẽ giúp đỡ nếu Return thực sự sẽ trở về từ một hàm thay vì Do khối, nhưng nó không, vì vậy bạn cũng có thể sử dụng Break:

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

Cuối cùng, tôi quyết định lặp lại sử dụng đuôi-đệ quy, mà có nghĩa là chấm dứt sớm sẽ dễ dàng hơn một chút. Sử dụng lạ nhưng hữu ích #0 ký hiệu cho phép chức năng ẩn danh tự gọi mình, điều này trở thành:

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

Tất cả điều này dường như quá khó khăn, mặc dù. Có ai nhìn thấy một cách tốt hơn?

EDIT để thêm: Tất nhiên, giải pháp ưa thích của tôi có lỗi có nghĩa là nó bị hỏng trong danh sách dài vì $IterationLimit.

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

Bạn có thể sửa lỗi này với 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 không phải là tính năng Mathematica yêu thích của tôi.

Answer 1

Cá nhân, tôi không thấy bất kỳ điều gì sai với giải pháp dựa trên LengthWhile. Ngoài ra, nếu chúng ta muốn sử dụng lại các hàm truyền tải danh sách được xây dựng trong mma (trái ngược với các vòng lặp hoặc đệ quy rõ ràng), tôi không thấy cách nào để tránh hoàn nguyên danh sách. Đây là phiên bản thực hiện điều đó, nhưng không đảo ngược biến vị ngữ:

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

Có đơn giản là tôi không biết hay không. Nó chắc chắn kém hiệu quả hơn cái dựa trên LengthWhile, đặc biệt là cho các mảng được đóng gói. Ngoài ra, tôi sử dụng quy ước trả về 0 khi không tìm thấy phần tử nào đáp ứng điều kiện, thay vì $Failed, nhưng đây chỉ là sở thích cá nhân.

EDIT

Đây là một phiên bản đệ quy dựa trên danh sách liên kết, trong đó có phần hiệu quả hơn:

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

Một số tiêu chuẩn:

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

Nếu danh sách của bạn có thể được tạo thành một mảng đóng gói (của bất kỳ kích thước nào), thì bạn có thể khai thác trình biên dịch thành C cho các giải pháp dựa trên vòng lặp.Để tránh những phí biên soạn, bạn có thể memoize chức năng biên soạn, như vậy:

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

Phần Verbatim là cần thiết vì trong chữ ký điển hình như {_Integer,1}, _Integer sẽ khác được hiểu như là một mô hình và định nghĩa memoized sẽ không trận đấu. Dưới đây là một ví dụ:

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

Out[61]= {0.016,8999} 

EDIT 3

Dưới đây là một phiên bản rất nhỏ gọn hơn và nhanh hơn các giải pháp đệ quy dựa trên danh sách liên kết:

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

Đó là nhanh như các phiên bản dựa trên Do - vòng lặp và nhanh hơn hai lần so với findLastRecursive ban đầu (tiêu chuẩn có liên quan sẽ được bổ sung sớm - tôi không thể thực hiện các tiêu chuẩn phù hợp (với trước đó) trên một máy khác tại thời điểm này). Tôi nghĩ đây là một minh chứng tốt về thực tế là các giải pháp đệ quy đuôi trong mma có thể hiệu quả như các thủ tục (không biên dịch) thủ tục.

Answer 2

Dưới đây là một số lựa chọn thay thế, hai trong số đó không đảo ngược danh sách:

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

Một số timings (số 1 là của Pillsy đầu tiên một) của việc tìm kiếm thời gian cuối cùng của 1 trong một mảng 100.000 1 trong mà một số không được đặt ở các vị trí khác nhau. Thời gian là giá trị trung bình của 10 meusurements lặp đi lặp lại:

Mã sử ​​dụng cho timings:

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

Không thực sự là một câu trả lời, chỉ cần một vài biến thể trên findLastDo.

(1) Thực tế Return có thể lấy một đối số thứ hai không có giấy tờ cho biết phải trả lại những gì.

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) Tốt hơn là sử dụng Catch [... Ném ...]

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 

Daniel Lichtblau

Answer 4

Timing Reverse cho Strings và đồng Real

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

Dành cho những người mạo hiểm ...

Các định nghĩa sau đây xác định một biểu thức wrapper reversed[...] giả mạo làm một đối tượng danh sách có nội dung dường như là một phiên bản ngược của danh sách bọc:

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

sử dụng mẫu:

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

Lưu ý rằng điều này phương pháp là chậm hơn hơn là thực sự đảo ngược danh sách ...

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

... nhưng tất nhiên nó sử dụng ít bộ nhớ hơn nhiều.

Tôi sẽ không khuyến cáo kỹ thuật này để sử dụng chung vì các lỗ hổng trong trang giả có thể thể hiện mình là lỗi tinh tế. Hãy xem xét: những gì khác chức năng cần phải thực hiện để làm cho mô phỏng hoàn hảo? Các định nghĩa trình bao bọc hiển thị dường như đủ tốt để đánh lừa LengthWhile và TakeWhile cho các trường hợp đơn giản, nhưng các chức năng khác (đặc biệt là hạt nhân được xây dựng trong) có thể không dễ dàng bị lừa. Ghi đè Head dường như đặc biệt đầy nguy hiểm.

Bất kể những hạn chế này, kỹ thuật mạo danh này đôi khi có thể hữu ích trong các trường hợp được kiểm soát.

Answer 6

Một giải pháp thanh lịch sẽ là:

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

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

nhưng vì nó dựa trên mô hình kết hợp, đó là cách chậm hơn so với các giải pháp khác đề nghị.