Creare un'alternativa più veloce per {PatternSequence [1, PatternSequence [2, 3 ..] ..] ..}

Question

Devo migliorare un modello o cambiare approccio.

È meglio descritto da un esempio

Per una gerarchia / ordine dato da un elenco, ad esempio:

order = {1, 2, 3} 

e un elenco:

list = {
  1, 2, 3, 2, 3, 3, 2, 3, 3, 2, 3, 3, 2, 3, 2, 3, 2, 3, 2, 3, 2, 3, 3,
   3, 3, 3, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3, 3
  }

Devo verificare che listcorrisponda a una sequenza definita da order:

MatchQ[list, {PatternSequence[1, PatternSequence[2, 3 ..] ..] ..}]

Questo modello scala molto male, già che non si finirà di valutare.

La funzione dovrebbe prendere solo listcome argomento, considera la costante dell'ordine. Il modello non ha bisogno di essere costruito automaticamente.

Answer 1

Quanto segue sembra funzionare per me, a meno che non mi manchi qualcosa:

ClearAll[match]
match[{}][{}] := True;
match[{fst_, rest___}][l_List] :=
  And @@ Map[
    Replace[
      match[{rest}][#], 
      False :> Return[False, Map]
    ]&,
    Replace[
      ReplaceList[
        l, 
        {
          {___, fst, middle : Except[fst] ..., fst, ___} :> {middle}, 
          {___, fst, r : Except[fst] ...} :> {r}
        }
      ],
      {} -> False
    ]
 ]

(La parte Replace[match[{rest}][#], False :> Return[False, Map]]&è opzionale e in linea di principio può essere sostituita con solo match[{rest}]).

Esempio:

match[{1, 2, 3}][list] // AbsoluteTiming
match[{1, 2, 3}][Append[list, 1]] // AbsoluteTiming

(* {0.00038, True} *)

(* {0.000383, False} *)

Answer 2

Questa soluzione cerca di ridurre l'elenco in un elenco di un singolo tipo di elementi, se ha successo, l'elenco sta seguendo lo schema prescritto.

MatchQ[
  SequenceReplace[
   SequenceReplace[list, {2, 3 ..} :> x],
   {1, x ..} :> y
   ],
  {y ..}
  ] // AbsoluteTiming

{0.0019598, True}

Questa è una versione della macchina a stati che Daniel ha raccomandato in un commento:

f[1, 2] = 2;
f[2, 3] = 3;
f[3, 2] = 2;
f[3, 1] = 1;
f[3, 3] = 3;
f[_, _] := Throw[False]

And[
  First[list] == 1 && Last[list] == 3,
  Catch[Fold[f, list]; True]
] // AbsoluteTiming

{0.0000455, True}