Créer une alternative plus rapide pour {PatternSequence [1, PatternSequence [2, 3 ..] ..] ..}

Question

J'ai besoin d'améliorer un modèle ou de changer d'approche.

Il est mieux décrit par un exemple

Pour une hiérarchie / ordre donné par une liste, par exemple:

order = {1, 2, 3} 

et une liste:

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
  }

Je dois vérifier que listcorrespond à une séquence définie par order:

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

Ce modèle s'échelonne très mal, déjà que l'on ne finira pas d'évaluer.

La fonction ne doit prendre listque comme argument, considérez la constante d'ordre. Le modèle n'a pas besoin d'être construit automatiquement.

Answer 1

Ce qui suit semble fonctionner pour moi, sauf si quelque chose me manque:

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 pièce Replace[match[{rest}][#], False :> Return[False, Map]]&est optionnelle et peut en principe être remplacée par juste match[{rest}]).

Exemple:

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

(* {0.00038, True} *)

(* {0.000383, False} *)

Answer 2

Cette solution tente de réduire la liste en une liste d'un seul type d'éléments, si elle réussit, la liste suit le modèle prescrit.

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

{0.0019598, True}

Voici une version de la machine à états que Daniel a recommandée dans un commentaire:

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}