10
$\begingroup$

I would like to count the number of subsequences in list. Say I have data given by:

data = {1, 1, 1, 2, 1, 2, 2, 2, 1, 2, 1};

I would like to count the number times I see the following subsequences: {1,1}, {1,2}, {2,1}, {2,2}. Is there a quick way to do so? I've tried a few approaches using Count and Cases with no luck. Any advice would be greatly appreciated.

Thanks!

$\endgroup$
  • 1
    $\begingroup$ very very closely related 941. Also linked topics there from SO are quite important. $\endgroup$ – Kuba Feb 1 '15 at 17:05
  • $\begingroup$ Do you mean a "sublist" or really a "subsequence"? The latter normally doesn't have to be contiguous while I'd use the former (or "substring" in the case of strings) to refer to contiguous subsequences. In your example the difference doesn't matter, because all subsequences also appear as substrings, so it's not entirely clear. $\endgroup$ – Martin Ender Mar 4 '16 at 10:33
11
$\begingroup$
data = {1, 1, 1, 2, 1, 2, 2, 2, 1, 2, 1};
sub = {{1, 1}, {1, 2}, {2, 1}, {2, 2}};

Count[Partition[data, 2, 1], Alternatives @@ sub]
10

Or each separately:

Count[Partition[data, 2, 1], #] & /@ sub
{2, 3, 3, 2}

More general, for different length subsequences:

Length[ReplaceList[data, {___, ##, ___} :> {}]] & @@@ sub
{2, 3, 3, 2}
 Length[ReplaceList[data, {___, ##, ___} :> {}]] & @@@ {{1, 2, 1}, {1}}
{2, 6}
$\endgroup$
  • 2
    $\begingroup$ A little shorter: Tr @ ReplaceList[data, {___, ##, ___} :> 1] & $\endgroup$ – Mr.Wizard Feb 2 '15 at 8:09
  • $\begingroup$ Thank you very much Kuba! (Also, thanks to Mr. Wizard and ubpdqn.) $\endgroup$ – Jake Knigge Feb 2 '15 at 13:59
6
$\begingroup$

String processing is often useful for these problems if it can be applied.

data = {1, 1, 1, 2, 1, 2, 2, 2, 1, 2, 1};

pat = {{1, 1}, {1, 2}, {2, 1}, {2, 2}};

ts = ToString @ Row[#, ","] &;

StringCount[ts@data, ts /@ pat, Overlaps -> True]
10

Individually:

With[{ds = ts@data},
  StringCount[ds, ts@#, Overlaps -> True] & /@ pat
]
{2, 3, 3, 2}

Or perhaps better:

StringCases[ts@data, ts@# -> # & /@ pat, Overlaps -> True] // Tally
{{{1, 1}, 2}, {{1, 2}, 3}, {{2, 1}, 3}, {{2, 2}, 2}}
$\endgroup$
6
$\begingroup$

Another way with ListCorrelate used with proper arguments, for example :

data = {1, 1, 1, 2, 1, 2, 2, 2, 1, 2, 1};
sub = {{1, 1}, {1, 2}, {2, 1}, {2, 2}};

Total@Boole@
    ListCorrelate[#, data, {1, -1}, "paddingUselessHere", Equal, And] & /@ sub
{2, 3, 3, 2}

Another example

Let's say you're just looking for the longer pattern {1,2,1} :

Total@Boole@ListCorrelate[{1, 2, 1}, data, {1, -1}, "paddingUselessHere", Equal, And]

2

Explanation

It is easy to understand what ListCorrelate does with this example :

ListCorrelate[{p1, p2}, {a, b, c, d}, {1, -1}, "whatever", f, g]

{g[f[p1, a], f[p2, b]], g[f[p1, b], f[p2, c]], g[f[p1, c], f[p2, d]]}

(When the 4th argument of ListCorrelate is {1,-1} (default value), the 5th argument (padding) is useless, that's why i set it to "whatever".)

$\endgroup$
3
$\begingroup$

I post this just for fun (I have voted for Kuba's answer):

data = {1, 1, 1, 2, 1, 2, 2, 2, 1, 2, 1};
targ = {{1, 1}, {1, 2}, {2, 1}, {2, 2}};
Join@@(Last@Reap[Sow[1, #] & /@ (w @@@ Partition[data, 2, 1]), 
  w @@@ targ, #1 /. w[a__] -> List[a] -> Total@#2 &])

w just used as a wrapper for tagging.

yields:

(* {{1, 1} -> 2, {1, 2} -> 3, {2, 1} -> 3, {2, 2} -> 2}*)
$\endgroup$
2
$\begingroup$

Version 10.1 introduces SequencePosition, SequenceCases, and SequenceCount.

SequenceCount[list, sub]
gives a count of the number of times sub appears as a sublist of list.

SequenceCount[list, patt]
gives the number of sublists in list that match the general sequence pattern patt.

All three functions take the Overlaps option:

  • With the default option setting Overlaps -> False, SequenceCount includes only sublists that do not overlap. With the setting Overlaps -> True, it includes sublists that overlap.

  • With Overlaps -> All, multiple sublists that match the same pattern are all included. With Overlaps -> True, only the first such matching sublist at a given position is included.

data = {1, 1, 1, 2, 1, 2, 2, 2, 1, 2, 1};

pat = {{1, 1}, {1, 2}, {2, 1}, {2, 2}};

SequenceCount[data, #, Overlaps -> True] & /@ pat

Thread[pat -> %]
{2, 3, 3, 2}

{{1, 1} -> 2, {1, 2} -> 3, {2, 1} -> 3, {2, 2} -> 2}

Before using these functions you may wish to see:

$\endgroup$
2
$\begingroup$

Using the 6-argument form of Partition:

ClearAll[countF]
countF[x_, y_] := Total @ Partition[x, 2, 1, 1, {}, Boole[MemberQ[y, {##}]] &]

data = {1, 1, 1, 2, 1, 2, 2, 2, 1, 2, 1};
sub = {{1, 1}, {1, 2}, {2, 1}, {2, 2}};

countF[data, sub]

10

countF[data, Most @ Rest @ sub]

6

Using BlockMap:

ClearAll[countF2]
countF2[x_, y_] := Total @ BlockMap[Boole[MemberQ[y, #]]&, x, 2, 1]

countF2[data, sub]

10

countF2[data, Most @ Rest @ sub]

6

$\endgroup$
2
$\begingroup$

Another version using ListCorrelate, that should be much faster for large lists:

(* define inverse pattern *)
Table[
    pattern[{2, 1} . pat] = pat,
    {pat, {{1,1}, {1,2}, {2,1}, {2,2}}}
];

(* use ListCorrelate and fix keys *)
KeyMap[pattern] @ Counts @ ListCorrelate[{2,1},{1,1,1,2,1,2,2,2,1,2,1}]

Values @ %

<|{1, 1} -> 2, {1, 2} -> 3, {2, 1} -> 3, {2, 2} -> 2|>

{2, 3, 3, 2}

Here is an example with a longer data list:

data = RandomInteger[{1, 2}, 10^6];
KeySort @ KeyMap[pattern] @ Counts @ ListCorrelate[{2, 1}, data] //AbsoluteTiming

{0.012973, <|{1, 1} -> 250799, {1, 2} -> 249508, {2, 1} -> 249509, {2, 2} -> 250183|>}

By my testing, this answer is at least 2 orders of magnitude faster than the others.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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