# Partition a list by count of a number

I want to take this list when the 2 appear 3 times

SeedRandom[1]
list = RandomChoice[{.2, .5, .3} -> {1, 2, 3}, 20]

{3,1,3,1,2,1,2,2,2,3,2,3,2,2,3,3,3,2,2,2}


Hope to get {{3, 1, 3, 1, 2, 1, 2, 2}, {2, 3, 2, 3, 2}, {2, 3, 3, 3, 2, 2},{2}}.I think GeneralUtilitiesPartitionBy can help to do this,but I'm fail to do it.

i = 0; GeneralUtilitiesPartitionBy[list, (If[# == 2, i++;
If[i == 4, i = 0]]; i === 3) &]


Will get nothing. Can anybody give a concise version? Of course, I will feel more happy if I get a GeneralUtilitiesPartitionBy version. Because I have failed many times with it.

• Though my answer is late I hope you will read and consider it. Commented Mar 4, 2017 at 18:33

Using SequenceCases:

list = {3, 1, 3, 1, 2, 1, 2, 2, 2, 3, 2, 3, 2, 2, 3, 3, 3, 2, 2, 2};

SequenceCases[list, _?(Count[#, 2] == 3 &)]


{{3, 1, 3, 1, 2, 1, 2, 2}, {2, 3, 2, 3, 2}, {2, 3, 3, 3, 2, 2}}

It is always good to start with System functions:

Flatten /@ Partition[Split[list, #1 =!= 2 &], UpTo[3]]

{{3, 1, 3, 1, 2, 1, 2, 2}, {2, 3, 2, 3, 2}, {2, 3, 3, 3, 2, 2}, {2}}


alternatively:

Module[{i = 0},
Sow[#, ⌊ If[# == 2, i++, i]/3 ⌋ ] & /@ list // Reap // Last
]

• As all of solution,your first method deserve a acceptance still.Thanks.. :)
– yode
Commented Mar 1, 2017 at 10:50

Requires a touch more than just a single call to PartitionBy, but works:

Flatten /@ Partition[GeneralUtilitiesPartitionBy[list, # == 2 &], UpTo[3]]


And here is a solution just using PartitionBy as you requested:

i = 1;
GeneralUtilitiesPartitionBy[list,
If[# == 2, i++; Evaluate@If[i == 3, i = 0; True, False], False] &
]


I think the tricks are make sure the second argument returns True when you want a partition to be created (and False otherwise). And the Evaluate seemed to be required.

Cool idea to use PartitionBy!

• I'm confused why we should need that Evaluate
– yode
Commented Mar 1, 2017 at 9:40
• We can concise it a little.i = 1; GeneralUtilitiesPartitionBy[list, If[# == 2, i++; Evaluate@If[Divisible[i, 3], True]] &].But the Evaluate haunt me still.It's seem the failure before cause to it.
– yode
Commented Mar 1, 2017 at 10:58

Here is a version using SplitBy.

Module[{i = 0}, SplitBy[lst, Floor[1/3 If[# != 2, i, i++]] &]]


(After reading Kuba's second solution more carefully, it turns out that they use the same idea on their second solution, but I figure the SplitBy version is nice to have alongside the Sow/Reap solution.)

Also

lengths = Differences@Flatten[{0, Position[list, 2][[3 ;; ;; 3]], Length@list}];

InternalPartitionRagged[list, lengths]


{{3, 1, 3, 1, 2, 1, 2, 2}, {2, 3, 2, 3, 2}, {2, 3, 3, 3, 2, 2}, {2}}

In versions 10 and later, you can use FoldPairList[TakeDrop, ...] instead of InternalPartitionRagged.

FoldPairList[TakeDrop, list, lengths]


{{3, 1, 3, 1, 2, 1, 2, 2}, {2, 3, 2, 3, 2}, {2, 3, 3, 3, 2, 2}, {2}}

This problem is a variation of:

Applying my Split method:

list = {3,1,3,1,2,1,2,2,2,3,2,3,2,2,3,3,3,2,2,2};

Module[{n = 0}, Split[list, # != 2 || ++n < 3 || (n = 0) &]]

{{3, 1, 3, 1, 2, 1, 2, 2}, {2, 3, 2, 3, 2}, {2, 3, 3, 3, 2, 2}, {2}}


The obvious comparison is to march's similar code using SplitBy, and Kuba's Sow/Reap method:

SeedRandom[0]
list = RandomInteger[9, 500000];

Module[{i = 0}, SplitBy[list, ⌊1/3 If[# != 2, i, i++]⌋ &]] //
Length // RepeatedTiming

Module[{i = 0}, Sow[#, ⌊If[# == 2, i++, i]/3⌋] & /@ list // Reap // Last] //
Length // RepeatedTiming

Module[{n = 0}, Split[list, # != 2 || ++n < 3 || (n = 0) &]] //
Length // RepeatedTiming

{1.84, 16576}

{1.137, 16576}

{0.305, 16576}


So my code is at least several times faster than other manual index methods.

However Split itself is not very efficient, cf. Find continuous sequences inside a list.
Applying those faster methods here:

splitEvery[list_, x_, n_Integer] := (
Unitize[list - x]
// SparseArray[#, Automatic, 1] &
// #["AdjacencyLists"][[n ;; ;; n]] &
// {Prepend[# + 1, 1], Append[#, -1]} &
// MapThread[Take[list, {##}] &, #] &
)

splitEvery[list, 2, 3] // Length // RepeatedTiming

{0.021, 16576}


This is nearly an order of magnitude faster than even Kuba's Partition method.
(UpTo doesn't work in v10.1 so I use an older equivalent.)

Flatten /@ Partition[Split[list, #1 =!= 2 &], 3, 3, 1, {}] //
Length // RepeatedTiming

{0.194, 16576}


And as usual with list partitioning problems it is the partitioning itself that takes the most time. If we can work with an interval list instead:

intervalEvery[list_, x_, n_Integer] := (
Unitize[list - x]
// SparseArray[#, Automatic, 1] &
// #["AdjacencyLists"][[n ;; ;; n]] &
// {Prepend[# + 1, 1], Append[#, -1]} &
// Transpose
)

intervalEvery[list, 2, 3] // Length // RepeatedTiming

{0.00343, 16576}


The output of that last function:

intervalEvery[{3,1,3,1,2,1,2,2,2,3,2,3,2,2,3,3,3,2,2,2}, 2, 3]

{{1, 8}, {9, 13}, {14, 19}, {20, -1}}

• Could your tell me why I always get a same list Unitize[list - 2] // SparseArray[#, Automatic, AnyNumber] & // Normal?Change the AnyNumber
– yode
Commented Mar 5, 2017 at 10:05
• @yode The third parameter of SparseArray sets the background element. The Normal form of the SparseArray will always look the same. Use ArrayRules to get a sense of how this works, e.g.: Table[ArrayRules @ SparseArray[Range@5, 5, i], {i, 5}] Commented Mar 5, 2017 at 10:08
• A lot of skills in your answer...but I know those all.Thanks very very much.. :)
– yode
Commented Mar 5, 2017 at 10:19
• @yode You're welcome, and thanks for the Accept. Commented Mar 5, 2017 at 10:21

here is a recursive way using tail-recursion and pattern matching

Clear[func, partition,f];

func[x_List: {__}] :=
x /. {a___, patt : Repeated[PatternSequence[2, ___], {3}], c___} :>
Join[{{a, patt}}, func[{c}]];
f := Replace[#, {a__List, x : _Integer ..} :> {a, {x}}] &;
partition[y_List] := Composition[f, func][y]

partition[{3, 1, 3, 1, 2, 1, 2, 2, 2, 3, 2, 3, 2, 2, 3, 3, 3, 2, 2, 2, 1, 2, 2, 3}]

(* {{3, 1, 3, 1, 2, 1, 2, 2}, {2, 3, 2, 3, 2}, {2, 3, 3, 3, 2, 2}, {2, 1, 2, 2}, {3}} *)
`