TransWikia.com

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

Mathematica Asked on March 26, 2021

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.

2 Answers

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} *)

Answered by Leonid Shifrin on March 26, 2021

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}

Answered by C. E. on March 26, 2021

Add your own answers!

Ask a Question

Get help from others!

© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP