# Making a faster alternative for {PatternSequence[1, PatternSequence[2, 3 ..] ..] ..}

I need to improve a pattern or switch an approach.

It is best described by an example

For a hierarchy/order given by a list e.g.:

order = {1, 2, 3}


and a list:

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
}


I need to verify that list matches a sequence defined by order:

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


This pattern scales very poorly, already that one won't finish evaluating.

The function should only take list as an argument, consider the order constant. The pattern does not need to be constructed automatically.

• Nesting Repeated can lead to immense back-tracking in the evaluation. I assume that is what's happening in this example. Maybe a finite state machine approach would work better? Sep 23, 2020 at 14:47

The following seems to work for me, unless I am missing something:

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


(The part Replace[match[{rest}][#], False :> Return[False, Map]]& is optional and can in principle be replaced with just match[{rest}]).

Example:

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

(* {0.00038, True} *)

(* {0.000383, False} *)

• Incidentally, this is my answer #666. Sep 23, 2020 at 16:09
• The devil you say. Sep 23, 2020 at 22:59

This solution tries to reduce the list into a list of a single type of elements, if it succeeds then the list is following the prescribed pattern.

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


{0.0019598, True}

This is a take on the state machine that Daniel recommended in a comment:

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}

• I meanwhile implemented state-machine by mapping and working with current/last value, yours is much simpler and idiomatic.
– Kuba
Sep 23, 2020 at 20:49
• Though, will it work for {2,3} or {1,2,3,1}, to not match? Can't test right now.
– Kuba
Sep 24, 2020 at 8:05
• @Kuba You are right, I made an updated check that the sequence starts with a 1 and ends in a 3. Sep 24, 2020 at 11:30