Ricerca dalla fine di un elenco in Mathematica

Question

Molti algoritmi (come l'algoritmo per trovare la successiva permutazione di un elenco in ordine lessicografico) implicano la ricerca dell'indice dell'ultimo elemento in un elenco. Tuttavia, non sono stato in grado di trovare un modo per farlo in Mathematica che non sia imbarazzante. L'approccio più diretto utilizza LengthWhile, ma significa invertire l'intera lista, che rischia di essere inefficiente nei casi in cui si conosce l'elemento che si desidera è vicino alla fine della lista e invertire il senso del predicato:

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

Potremmo fare un ciclo esplicito, imperativo con Do, ma anche questo risulta un po 'goffo. Sarebbe utile se Return sarebbe in realtà tornare da una funzione al posto del blocco Do, ma non è così, così si potrebbe anche utilizzare Break:

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

In ultima analisi, ho deciso di iterare utilizzando coda ricorsione, che significa che la terminazione anticipata è un po 'più facile. Utilizzando il strano ma utile #0 notazione che consente funzioni anonime fanno chiamare, questo diventa:

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

Tutto questo sembra troppo difficile, però. Qualcuno vede un modo migliore?

MODIFICA aggiungere: Naturalmente, la mia soluzione preferita ha un bug che significa che è rotto su lunghi elenchi a causa di $IterationLimit.

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

È possibile risolvere questo problema con 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 non è la mia caratteristica preferita Mathematica.

Answer 1

Personalmente, non vedo nulla di sbagliato con la soluzione basata su LengthWhile. Inoltre, se vogliamo riutilizzare le funzioni di mma list-mma built-in (al contrario di loop espliciti o ricorsione), non vedo un modo per evitare di ripristinare l'elenco. Ecco una versione che lo fa, ma non inverte il predicato:

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

O se non è più semplice non lo so. È sicuramente meno efficiente di quello basato su LengthWhile, in particolare per gli array compressi. Inoltre, io uso la convenzione di restituire 0 quando non viene trovato alcun elemento che soddisfa una condizione, piuttosto che $Failed, ma questa è solo una preferenza personale.

EDIT

Ecco una versione ricorsiva sulla base di liste collegate, che è un po 'più efficiente:

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

Alcuni parametri di riferimento:

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

Se l'elenco può essere creato con un array compresso (di qualsiasi dimensione), è possibile sfruttare la compilazione su C per soluzioni basate su loop.Per evitare il sovraccarico di compilazione, è possibile Memoize la funzione compilata, in questo modo:

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

La parte Verbatim è necessaria in quanto nelle firme tipici come {_Integer,1}, _Integer sarà altrimenti essere interpretato come un modello e la definizione memoized sarà non incontro. Ecco un esempio:

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

Out[61]= {0.016,8999} 

EDIT 3

Ecco una versione molto più compatto e più veloce della soluzione ricorsiva sulla base di liste collegate:

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

E 'veloce come le versioni basato su Do - loop e due volte più veloce dell'originale findLastRecursive (il benchmark pertinente da aggiungere a breve - non posso fare benchmark coerenti (con precedenti) su una macchina diversa al momento). Penso che questo sia un buon esempio del fatto che le soluzioni ricorsive in coda in mma possono essere efficienti quanto quelle procedurali (non compilate).

Answer 2

Ecco alcune alternative, due dei quali non invertire la lista:

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

Alcuni temporizzazioni (numero 1 è Pillsy di prima) di trovare l'ultima corsa di 1 di in una vasta gamma di 100.000 1 di a che un singolo zero è posto su varie posizioni. Tempi sono la media di 10 meusurements ripetute:

codice utilizzato per gli orari:

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

Non

davvero una risposta, solo un paio di varianti findLastDo.

(1) In realtà Return può richiedere un secondo argomento non documentato che indica da cosa tornare.

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) migliore è usare Cattura [... Tira ...]

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 per archi e 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

Per i più avventurosi ...

Le seguenti definizioni definire un'espressione involucro reversed[...] che si maschera come un oggetto lista il cui contenuto sembra essere una versione invertita della lista avvolto:

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

uso Esempio:

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

Si noti che questo il metodo è più lento piuttosto che invertire l'elenco ...

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

... ma naturalmente utilizza molta meno memoria.

Non raccomanderei questa tecnica per uso generale come difetti nella mascheratura possono manifestarsi come bug sottili. Considerare: quali sono le funzioni altre necessarie per rendere la simulazione perfetta? Le definizioni di wrapper esposte sono apparentemente sufficienti per ingannare LengthWhile e TakeWhile per casi semplici, ma altre funzioni (in particolare i kernel incorporati) potrebbero non essere facilmente ingannate. Overriding Head sembra particolarmente irto di pericoli.

Nonostante questi inconvenienti, questa tecnica di rappresentazione può talvolta essere utile in circostanze controllate.

Answer 6

Una soluzione elegante potrebbe essere:

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

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

ma come si basa su pattern matching, è modo più lento rispetto alle altre soluzioni suggerite.