Создание более быстрой альтернативы для {PatternSequence [1, PatternSequence [2, 3 ..] ..] ..}

Sep 23 2020

Мне нужно улучшить шаблон или изменить подход.

Лучше всего это описать на примере

Для иерархии / порядка, заданного списком, например:

order = {1, 2, 3} 

и список:

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
  }

Мне нужно проверить, listсоответствует ли последовательность, определенная order:

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

Этот паттерн очень плохо масштабируется, уже то, что не доеду.

Функция должна принимать только listв качестве аргумента, учитывая константу порядка. Шаблон не нужно строить автоматически.

Ответы

10 LeonidShifrin Sep 23 2020 at 22:53

Следующее, кажется, работает для меня, если я чего-то не упускаю:

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

(Деталь не Replace[match[{rest}][#], False :> Return[False, Map]]&является обязательной и в принципе может быть заменена просто match[{rest}]).

Пример:

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

(* {0.00038, True} *)

(* {0.000383, False} *)
10 C.E. Sep 24 2020 at 02:44

Это решение пытается сократить список до списка элементов одного типа. Если это удается, то список следует заданному шаблону.

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

{0.0019598, True}

Это взгляд на конечный автомат, который Даниэль рекомендовал в комментарии:

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}