Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I have run across several times recently where I must match a sequence that is cyclically repeating. For example, with the sequence,

Sequence[a, b, c]

how would I write a pattern that matched against

a
a, b
a, b, c
a, b, c, a

etc., but not any of the surrounding elements?

For a two element sequence comprising the entire list, this is straightforward, if a bit verbose:

MatchQ[#, {a | PatternSequence[a, b] .., a | PatternSequence[]}] & /@ 
 {{a}, {a, b}, {a, b, a}, {a, b, a, b, a, b, a}}
(* {True, True, True, True} *)

But, this does not work when the sequence is part of a bigger list, e.g.

Cases[
 {q, r, a, b, a, b, a, s, e, f, a}, 
 x : PatternSequence[a|(PatternSequence[a, b] ..), a | PatternSequence[]] :> {x}, 
 Infinity
]
(* {{a}, {a}, {a}, {a}} *)

Even reversing the initial element to (PatternSequence[a, b] ..)|a returns the same thing.

So, my questions are:

  1. How can I write the pattern so it extracts parts of larger lists that may contain other elements?

  2. How can I generalize the pattern to match against larger cyclically repeating sequences?

share|improve this question
1  
Partial success: Cases[{{q, r, a, b, a, b, a, s, e, f, a}}, {y___, x : Longest@PatternSequence[(PatternSequence[a, b] ...), a | PatternSequence[]], z___} :> {x}]. I don't think PatternSequence matches a sub-Sequence by itself but needs to appear inside a Head. I might be wrong, though. –  Michael E2 Mar 11 at 15:07
    
I think @Michael is right: it generally doesn't seem to be possible to match any sequence on its own, only as part of a bigger expression. ___ alone will only match a single element, but {___} will match a list with an arbitrary number of elements. It is only the complete list that will match, not it's elements separately. Example: ReplaceAll[Range[10], Longest[___Integer] -> x]. This can't replace the whole sequence of numbers in one go. This can: ReplaceAll[Range[10], z_[___Integer] :> z[x]]. –  Szabolcs Mar 11 at 16:01
    
So the key is to somehow also match on whatever contains that sequence. What function do you want to use this in in practice? Cases? Replace? MatchQ? Or a function definition? It might work best in the last case. –  Szabolcs Mar 11 at 16:01
    
@Szabolcs in general, I'm using MatchQ, but I would like it to be adaptable to both Cases and Replace. Usually, I'm working with lists, but I'd like this as general as possible. –  rcollyer Mar 11 at 16:35

3 Answers 3

up vote 3 down vote accepted

A very interesting question. I thought of a much plainer approach than the other responders but it proves to perform quite well. I simply PadRight the reference sequence to match the length of the test sequence.

Functions

cycQ[ref_][test_] := test === PadRight[ref, Length @ test, ref]

cycpat[f_, r___] := p : PatternSequence[f, ___] /; cycQ[{f, r}][{p}] // Identity

cycQ tests one sequence against another:

cycQ[{1, 2, 3}] /@ {{}, {1}, {1, 2, 3}, {1, 2, 3, 1}, {2, 3}}
{True, True, True, True, False}

cycpat is the pattern-building function:

cycpat[1, 2, 3]
p$ : PatternSequence[1, ___] /; cycQ[{1, 2, 3}][{p$}]

Sample applications

Sample data:

SeedRandom[1]
test = RandomInteger[{1, 3}, 20]
{2, 1, 2, 2, 1, 1, 1, 2, 1, 1, 1, 1, 3, 1, 2, 3, 1, 1, 2, 2}

Finding the single longest sequence in the list:

test /. {___, x : Longest @ cycpat[1, 2, 3], ___} :> {x}
{1, 2, 3, 1}

Finding all sequence fragments in a list, length 2 or greater:

ReplaceList[test, {___, x : cycpat[1, 2, 3] /; Length[{x}] > 1, ___} :> {x}]
{{1, 2}, {1, 2}, {1, 2}, {1, 2, 3}, {1, 2, 3, 1}, {1, 2}}

Performance

rm -rf's cyclicPatternMatchQ, while certainly interesting, isn't fast enough to be widely applicable:

SeedRandom[1]
a = RandomInteger[{1, 5}, 300];

a /. {___, x : Longest@cycpat[1, 2, 3, 4, 5], ___} :> {x} // Timing

a /. {___, Longest@m__, ___} /; 
    cyclicPatternMatchQ[{1, 2, 3, 4, 5}][{m}] :> {m}      // Timing
{0.0874, {1, 2, 3, 4}}

{4.368, {1, 2, 3, 4}}

belisarius's form function is much faster but still not as fast as cycpat:

form[w_List] := (* Note I removed the x and y patterns *)
 PatternSequence[Longest@Repeated[PatternSequence @@ w, {0, Infinity}], 
  Alternatives @@ 
    Table[Longest@Repeated[PatternSequence @@ w[[;; i]], {0, 1}], {i, Length[w], 1, -1}]]

SeedRandom[10]
big = RandomInteger[{1, 5}, 1200];

big /. {___, q : Longest @ cycpat[1, 2, 3, 4, 5], ___} :> {q}  // Timing
big /. {___, q : Longest @ form @ {1, 2, 3, 4, 5}, ___} :> {q} // Timing
{3.51, {1, 2, 3, 4, 5, 1}}

{7.41, {1, 2, 3, 4, 5, 1}}

It is worth noting however that (use of) form slows down semi-proportionately to the length of the sequence it is given, while cycpat does not:

big /. {___, q : Longest[cycpat @@ Range[50]], ___} :> {q} // Timing
big /. {___, q : Longest @ form @ Range[50], ___} :> {q}   // Timing

{3.588, {1, 2, 3, 4, 5}}

{43.524, {1, 2, 3, 4, 5}}

cycpat still seems rather slow for a list of only 1200 elements but I was unable to improve its performance. Possibly a form of memoization would speed the highly repetitive application of cycQ without unacceptable memory consumption.

share|improve this answer
    
I am not sure if it is THAT slow. There should be about Binomial[1200+2,2] or 721801 sequences to try. Do[f[i], {i, 1*^6}] // Timing already takes the order of a second, so I doubt it can be improved more than an order of magnitude the most –  Rojo Apr 7 at 11:54
    
+1, I wish I had thought of this. Very interesting. –  rcollyer Apr 7 at 12:45
    
@Rojo I suppose that for a standard pattern expression that may be correct. I suspect that a stand-alone search would permit a more intelligent algorithm, but that is not what was requested. –  Mr.Wizard Apr 7 at 17:14
    
@rcollyer Thank you. Does your application require a pattern (that may be combined with other patterns, etc.) or do you simply want to search a list? I suspect the latter can be much faster; for example if I know a priori that the longest match in big is 1, 2, 3, 4, 5, 1 I can find its position in 0.00005 second. –  Mr.Wizard Apr 7 at 17:18
    
I was just thinking there are cases where a pattern is absolutely necessary. I'll have to play with it a bit, and see. –  rcollyer Apr 7 at 18:30

Here is a reasonable first implementation of a cyclical pattern matcher that behaves as described in the question. It takes an input cyclic list (single cycle) and a list that is to be tested:

ClearAll@cyclicPatternMatchQ
cyclicPatternMatchQ[cycList_][testList_] := MatchQ[cycList, 
    testList /. {Shortest[h___], (PatternSequence @@ cycList) ... , 
        Shortest[t___]} :> {h, t, ___}]

Here is a sample test case with results:

{#, cyclicPatternMatchQ[{a, b, c}]@#} & /@ {{a}, {a, b}, {a, b, 
    c}, {a, b, c, a}, {a, b, c, a, b}, {x, y, z, p, q}, {d, a, b, c, 
    d}, {a, b, c, d, a}, {a, b, d, c}} // Grid

You can combine this with regular patterns to match cyclical patterns inside another list:

{d, a, b, c, a, e, f} /. 
    {h___, Longest@m__, t___} /; cyclicPatternMatchQ[{a, b, c}][{m}] :> {h, t}
(* {d, e, f} *)
share|improve this answer
    
+1. How would you make this amenable to using PatternTest instead of Condition? –  rcollyer Mar 11 at 17:00
    
@rcollyer Is there a reason you want to use PatternTest? PatternTest tests per element, whereas you want to test against the entire sequence, so I don't think it's the right tool. –  rm -rf Mar 11 at 17:01
    
More habit than anything else. But, I'm not sure you get that much savings with Condition, i.e. {d, a, b, c, a, e, f} /. {h___, Longest@m__, t___} /; cyclicPatternMatchQ[{a, b, c}][Print[{m}]; {m}] :> {h, t}. Using Condition is certainly easier, but I'm mostly just curious at this point. –  rcollyer Mar 11 at 17:10
findCyclicMatches[u_List, cycle_List] := Module[{form, x, y},
  form[w_List] := 
   PatternSequence[
    x : Longest@Repeated[PatternSequence @@ w, {0, Infinity}], 
    y : Alternatives @@ 
      Table[Longest@Repeated[PatternSequence @@ w[[;; i]], {0, 1}], {i, Length[w], 1, -1}]];

  Last@Reap@ NestWhileList[First@Cases[{#}, {r___, Longest@form@cycle, s___} :>
                                                    (Sow@{x, y}; {r, "Separator", s})] &, 
     u, 
    (Length@Last@{##} <= Length[{##}[[-2]]]) &, 2]
  ]
u = {a, b, c, kk, a, b, c, k, a, b, c, a, b, k, a, b, c, a};
findCyclicMatches[u, {a, b, c}]

(*
 {{{a, b, c, a, b}, {a, b, c, a}, {a, b, c}, {a, b, c}, {}}}
*)
share|improve this answer
    
I'll hold out for the clever way to generate the pattern, as I mainly wish to avoid having to write the thing out. But, +1. –  rcollyer Mar 11 at 16:36
    
@rcollyer Somewhat better now –  belisarius Mar 11 at 17:31

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.