# Find subsequences of consecutive integers inside a list

I have a list which is something like this:

{3,4,5,6,7,10,11,12,15,16,17,19,20,21,22,23,24,42,43,44,45,46}


What I'd like to to is get the intervals which are in a "continuous" sequence, something like:

{{3,7},{10,12},{15,17},{19,24},{42,46}}


and get the extremes. Note that the original data (of which this is a small excerpt) shows no sign of regularity or repetition. Numbers start from 1 and get up to 200 (these numbers come from applying Position[] to an array).

Any pointers/ideas?

• Commented Apr 19, 2013 at 13:56

## 12 Answers

You can use Split in this simple case

list = {3, 4, 5, 6, 7, 10, 11, 12, 15, 16, 17, 19, 20, 21, 22, 23, 24, 42, 43, 44, 45, 46};
{Min[#], Max[#]} & /@ Split[list, #2 - #1 == 1 &]


What it does is that the last argument to split gives True only when neighboring elements have a difference of 1. If not, the list is split there. Then you can use the Min/Max approach to find the ends. First and Last will work too.

Update:

Since the attention to this question/answer is rather surprising, let me point out one important thing: It is the crucial difference between Split and SplitBy. Both functions take a second argument to supply a testing function to specify the point to split but the behavior is completely different. Btw, the same is true for Gather and GatherBy.

While the second argument to Split makes that it

treats pairs of adjacent elements as identical whenever applying the function test to them yields True,

SplitBy does a completely different thing. It

splits list a into sublists consisting of runs of successive elements that give the same value when f is applied.

If you weren't aware of this, a closer look is surely advisable.

• Awesome, thanks! I didn't know the Split[] function, now I know :)
– mgm
Commented Apr 19, 2013 at 12:47
• @DavidCarraher Thanks. That many upvotes are rather surprising. Commented Apr 20, 2013 at 9:43
• I very nearly posted the same answer (except using [[All, {1,-1}]]) first, but the phone rang. Next time I'll let it ring! Commented Apr 20, 2013 at 10:24
• @SimonWoods It's a bit like digging for gold except the big rep pieces seem to be a mixture of easy but not directly solvable questions and topics which are of interest by a lot of people.. If you see such a question swimming by, let the phone ring ;-) Commented Apr 20, 2013 at 10:36

UPDATE: After reading Ajasja's answer I realized that I was making this way more complicated than it needed to be. My new code is easily an order of magnitude faster than my prior code or two orders faster than Split.

Split is a wonderfully clean method but it is not the fastest. Without resorting to C code one can get more than two orders of magnitude improvement on long lists with this:

intervals[a_List] :=
{a[[Prepend[# + 1, 1]]], a[[Append[#, -1]]]}\[Transpose] & @
SparseArray[Differences @ a, Automatic, 1]["AdjacencyLists"]


Compared to Split:

a = Delete[#, List /@ RandomSample[#, 15000]] & @ Range@1*^7;

(r1 = intervals[a]) // Timing // First

(r2 = {Min[#], Max[#]} & /@ Split[a, #2 - #1 == 1 &]) // Timing // First

r1 === r2


0.0624

7.005

True

A short description of how the method works:

Differences is used to find the steps between each element and the next for the entire list.

I have used SparseArray Properties many times on this site: (1), (2), (3), (4), (5), (6), (7), (8), (9)
Here it is used as a well-optimized method to find the positions of all non-background elements in the differences list. I specify a background of 1 to find the positions of all other elements, representing a change of other than +1. (In later versions Pick is also well-optimized so that becomes an option(10) but here we need to manipulate the position list itself so it may be the best method even in later versions.)

Padding (Append, Prepend) the position list with 1 and -1 is used catch the first and last elements, respectively, of the original list. Adding (not appending) one to the list is used to offset the positions to get the elements on both sides of each jump. Finally, Transpose is used to pair off these values into the interval lists.

• Spectacular, thanks!
– mgm
Commented Apr 19, 2013 at 15:31
• @mag I was able to make my code much faster; please take a look. And you're welcome. Commented Apr 20, 2013 at 1:59
• Could you include just a short description of how the code works? What does the "AdjacencyLists" do? Why the Append/Prepend? Don't have MMA at hand right now... Commented Apr 20, 2013 at 22:11
• @Jacob I'll get v9 sometime soon, don't worry. Please follow the nine links provided; if after you still have questions I'll be happy to answer them to the best of my ability. Commented Apr 22, 2013 at 0:05
• @Mr.Wizard I didn't see it right away (its not in the docs), but I guess it somewhat speaks for itself :). I was expecting a SparseArray object, but I can handle lists :). Commented Apr 22, 2013 at 0:13

Recently, I had to solve exactly the same problem. But my data consisted of several hundred lists of $10^6$ elements. The profiler showed this was becoming a significant overhead for my applications, so I invested an hour into a faster implementation. Anyway, here is a bit more than another order of magnitude improvement over Mr. W's answer (and more than 300× faster than the naive Mathematica implementation):

The algorithm is quite simple: Iterate through the list and every time a difference different from 1 appears (curr - prev) != 1 push prev as the closing part of the interval and curr as the opening part of the next interval.

InternalBag is used for O(1) insertion.

compiledGetContigIntervals =
Compile[{{ind, _Integer, 1}},
Block[{i, openInterval = 0, result = InternalBag[Most@{0}]},
openInterval = ind[[1]];(* the first opening interval *)
(* loop through all the indices and check for differences <> 1
If that is the case stuff the interval *)

Do[With[{curr = ind[[i]], prev = ind[[i - 1]]},
If[(curr - prev) != 1,
InternalStuffBag[result, openInterval];
InternalStuffBag[result, prev];
openInterval = curr;]]
, {i, 2, Length@ind}];

InternalStuffBag[result, openInterval];
InternalStuffBag[result, ind[[-1]]];
(* return the intervals *)
Partition[InternalBagPart[result, All], 2]],

"CompilationTarget" -> C, "RuntimeOptions" -> "Speed",
CompilationOptions -> {"ExpressionOptimization" -> True,
"InlineCompiledFunctions" -> True,
"InlineExternalDefinitions" -> True}];


(If you don't have a C compiler just leave out the options at the end of Compile)

And now the timings:

a = Delete[#, List /@ RandomSample[#, 500]] &@Range@1*^7;

intervals[a_List] := {a[[Prepend[# + 1, 1]]], a[[Append[#, -1]]]}\[Transpose] &@
SparseArray[Differences@a, Automatic, 1]["AdjacencyLists"]

(r1 = compiledGetContigIntervals[a]) // AbsoluteTiming // First
(r2 = intervals[a]) // AbsoluteTiming // First
(r3 = {Min[#], Max[#]} & /@ Split[a, #2 - #1 == 1 &]) // AbsoluteTiming // First
r1 === r3
r2 === r3

(*0.040002*)
(*0.191011*)
(*14.636837*)

(*True*)
(*True*)


(If the code is not compiled to C, but to the WVM the timing is 0.74 s)

• Thanks to your answer I realized there was a much better approach to the problem than I had used. Commented Apr 20, 2013 at 1:58
• When you have time, could you add the Timing for my new method to your answer? I cannot test the fast C method in version 7 to compare. Commented Apr 20, 2013 at 8:20
• @Mr.Wizard Will do, but I'm afraid it will have to wait until Monday. Commented Apr 20, 2013 at 8:44
• @Mr.Wizard Updated the timings Commented Apr 22, 2013 at 13:06
• Thanks for the timings, and the edit. Commented Apr 22, 2013 at 14:55

A job for Mr Bray and Mr Curtis?

{First[#], Last[#]} & /@
FindClusters[{3, 4, 5, 6, 7, 10, 11, 12, 15, 16, 17, 19, 20, 21, 22,
23, 24, 42, 43, 44, 45, 46},
DistanceFunction -> BrayCurtisDistance]


{{3, 7}, {10, 12}, {15, 17}, {19, 24}, {42, 46}}

• While interesting this appears to be highly inefficient; I hung my machine attempting to use this on longer lists. Commented Apr 19, 2013 at 15:05
• The recent answer by Fortsaint made me look at this again; unfortunately it also fails on e.g. Join @@ Range[{1, 11, 18931, 18953}, {9, 48, 18948, 19000}] Commented Jan 17, 2017 at 3:36

I have made a solution using LibraryLink that appears to be even faster than Ajasja's function that uses Compile. Here is the C code.

#include <stdio.h>
#include <stdlib.h>

#include "WolframLibrary.h"

/* Return the version of Library Link */
DLLEXPORT mint WolframLibrary_getVersion( ) {
return WolframLibraryVersion;
}

/* Initialize Library */
DLLEXPORT int WolframLibrary_initialize( WolframLibraryData libData) {
return LIBRARY_NO_ERROR;
}

/* Uninitialize Library */
DLLEXPORT void WolframLibrary_uninitialize( WolframLibraryData libData) {
return;
}

DLLEXPORT int unitS_T_T(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res)
{
int err = 0;

MTensor result;
MTensor input;

register mint *inputAndResultDataPtr;

mint resDim[2];
mint inputDataLen;

_Bool isEven;

input = MArgument_getMTensor(Args[0]);

inputAndResultDataPtr = libData->MTensor_getIntegerData(input);

inputDataLen = libData->MTensor_getFlattenedLength(input);

//mAr stands for mallocArray, as this is not an array in the purest sense.

const mint* mArHP = malloc(sizeof(mint)*2*inputDataLen);
register mint* mArrayPtr = mArHP;

register mint count = 0;

isEven = (_Bool)((inputDataLen+1) % 2);

//the n in nEvenIterations stands for "number of".
//nEvenIterations tells us how often to repeat the code in the loop.
//To see that it is correct, consider how often you can increment
//inputAndResultDataPtr
//by 2, without making it point beyond the end of the integerData.

register mint nEvenIterations = (isEven? inputDataLen-2 : inputDataLen-1)/2;

//we need count2 to decide how long the result tensor will be.
register mint count2;

register mint a = *inputAndResultDataPtr;
//From here on, we consistently increment this pointer before assigning from
//its target value, rather than after.

register mint b;

*mArrayPtr = a;
mArrayPtr++;

count2 = 1;

//We make sure that in the loop below, whenever we store an upper bound, we
//also can
//store a lower bound. This is what safe in evenSafeLength refers to.
//The variable that the maximum between a or b, was set using an element
//of the array beyond the (candidate for) the upper bound anyway. We do not
//need to store the lower bound
//in a variable, as we store it in the array right away.

while(count < nEvenIterations)
{
inputAndResultDataPtr++;
b = *inputAndResultDataPtr;

if( b != a+1)
{
*mArrayPtr = a;
mArrayPtr++;
*mArrayPtr = b;
mArrayPtr++;
count2 += 2;
}

//if !isEven, the line of code below will make inputAndResultDataPtr
//eventually point to the last value.
inputAndResultDataPtr++;
a = *inputAndResultDataPtr;

if( a != b+1)
{

*mArrayPtr = b;
mArrayPtr++;
*mArrayPtr = a;
mArrayPtr++;
count2 += 2;

}

count++;

}

//a and b alternating roles. We can predict which one is higher.

if(isEven)
{
inputAndResultDataPtr++;
b = *inputAndResultDataPtr;
//inputAndResultDataPtr now points to the last value

if( b != a+1)
{

*mArrayPtr = a;
mArrayPtr++;
*mArrayPtr = b;
mArrayPtr++;
count2 += 2;
}

//count++;

}

*mArrayPtr = *inputAndResultDataPtr;
count2++;

//count2 should be even
resDim[0] = count2/2;
resDim[1] = 2;

err = libData->MTensor_new(MType_Integer, 2, resDim, &result);

inputAndResultDataPtr = libData->MTensor_getIntegerData(result);

count = 0;

mArrayPtr = mArHP;

while(count < count2)
{
*inputAndResultDataPtr = *mArrayPtr;
mArrayPtr++;
inputAndResultDataPtr++;
count++;
}

free(mArHP);
libData->MTensor_disown(input);

MArgument_setMTensor(Res, result);

return err;
}


About the code

The idea is very similar to that of other answers.

There are some pretentious register keywords that don't change anything. I did a nice little trick with the variables a and b in the code to save on assignments. Also my intuition is that inlining the code twice in the loop only makes things faster (fewer tests count < nEvenIterations). It makes the code longer tough :-/. The code involves copying an array entry for entry. The problem is that the size of the result tensor is not known in advance and that you can only set the size of a tensor once.

Making the Mathematica function

To let Mathematica use the C code, we will make a string of the code and store it in the variable cCodeString. To do this, copy the code above, paste it between quotes "" and click "Yes" in the dialog (to escape the characters).

cCodeString = (*Insert C code here*);


Now we process the code/string and make a function out of it.

<< CCompilerDriver;
lib = CreateLibrary[cCodeString, "unitS"];
unitS = LibraryFunctionLoad["unitS",
"unitS_T_T", {{Integer, 1, "Shared"}},
{Integer, 2}];


Timing comparisons

This uses definitions from other answers.

(r1=intervals[a])//Timing//First
(r2={Min[#],Max[#]}&/@Split[a,#2-#1==1&])//Timing//First
(r3=compiledGetContigIntervals[a])//Timing//First
(r4=unitS[a])//Timing//First

0.329104
10.1459
0.023
0.008142

r1 === r2 === r3 === r4

True


Notes

I made the code with the scenario that there are many "jumps" in mind. When there are very few jumps, like in the case for which we compare timings, it is probably much faster to determine the positions of the gaps using a binary search.

For a constant number of jumps, I feel such a binary search would require only $O(log(n))$ time and that should be the main work in the algorithm.

Not as neat as the other answers but yet another way :

alist = {3, 4, 5, 6, 7, 10, 11, 12, 15, 16, 17, 19, 20, 21, 22, 23, 24, 42, 43, 44, 45, 46};

{alist[[#[[1]]]], alist[[#[[2]] - 1]]} & /@ Partition[Union[{1, Length[alist] + 1},
1 + Position[Differences[alist], _?(# != 1 &)][[All, 1]]], 2, 1]

{{3, 7}, {10, 12}, {15, 17}, {19, 24}, {42, 46}}

• I took the liberty of editing your answer. Revert if you dislike it. Due to the compressed formatting of the original I overlooked certain positive attributes. +1 Commented Apr 20, 2013 at 10:42
• @Mr.Wizard Many thanks, your edits are always useful. Commented Apr 20, 2013 at 11:12

Perhaps not as neat as some of the others, but a pedagogical use of Fold that I thought was worth sharing:

sequenceBoundaries[x : {__Integer}] :=
(Fold[ If[#2 - Last[Flatten[#1]] == 1,
{Sequence @@ Most[#1], Join[Last[#1], {#2}]},
Join[#1, {{#2}}]] &, {{First@x}},  Rest@x] )[[All, {1, -1}]]

sequenceBoundaries[{3, 4, 5, 6, 7, 10, 11, 12, 15, 16, 17, 19, 20, 21,
22, 23, 24, 42, 43, 44, 45, 46}]

(* {{3, 7}, {10, 12}, {15, 17}, {19, 24}, {42, 46}} *)


I don't know how efficient this is on a large list but it seems ridiculously straightforward

MinMax /@ FindClusters@list

• This is similar to cormullion's but simplified. Are you sure this is robust without the express DistanceFunction -> BrayCurtisDistance he used? If so this is a marvelously clean solution, performance aside. Commented Jan 17, 2017 at 3:31
• I am afraid it is not robust. Consider for example list = Join @@ Range[{1, 11, 18931, 18953}, {9, 48, 18948, 19000}]; your function returns {{1, 48}, {18931, 19000}} but these are not continuous. Commented Jan 17, 2017 at 3:35
• Yes you're right. Thanks for pointing it out. Mr cormullion got the proper solution and I did not noticed it. Once corrected with the proper distance function, mine is just slightly more concise thanks to the MinMax function. Commented Jan 18, 2017 at 5:30

I guess SequencePositon wasn't available back in 13..

{list[[#1]], list[[#2 + 1]]} & @@@
SequencePosition[Differences@list, {1 ..}, Overlaps -> False]


{{3, 7}, {10, 12}, {15, 17}, {19, 24}, {42, 46}}

if you make that a {1 ...} you pick up any isolated values too.

Using SequenceCases:

list = {3, 4, 5, 6, 7, 10, 11, 12, 15, 16, 17, 19, 20, 21, 22, 23, 24,
42, 43, 44, 45, 46}

SequenceCases[list, x_ /; ContainsOnly[Differences@x, {1}]] //
Map[{First@#, Last@#} &]


Using SequenceReplace:

SequenceReplace[list,
x_ /; ContainsOnly[Differences@x, {1}] :> {First@x, Last@x}]


{{3, 7}, {10, 12}, {15, 17}, {19, 24}, {42, 46}}

• Purely for pedagogical use as the Sequence* functions are slower compared to other list manipulation functions.
– Syed
Commented May 10, 2023 at 16:47
list =
{3, 4, 5, 6, 7, 10, 11, 12, 15, 16, 17, 19, 20, 21, 22, 23, 24, 42, 43, 44, 45, 46};


Using FindRanges by Jan Pöschko (Wolfram Research)

ResourceFunction["FindRanges"][list]


{{3, 7}, {10, 12}, {15, 17}, {19, 24}, {42, 46}}

list = {3, 4, 5, 6, 7, 10, 11, 12, 15, 16, 17, 19, 20, 21, 22, 23, 24,42, 43, 44, 45, 46};


Using SequenceSplit and TakeList:

f = MinMax /@ TakeList[#,
Cases[x : {1 ..} :> Length@x]@
SequenceSplit[Differences@#, x : {1 ..} :> Join @@ {x, {1}}]] &;

f@list


{{3, 7}, {10, 12}, {15, 17}, {19, 24}, {42, 46}}

A variant of @Verbeia's answer using Fold is as follows:

sequenceBoundaries =
Apply[Append, Reverse[Fold[
Function[{acc, x}, Module[{curr = acc[[1]], ints = acc[[2]]},
If[x == curr[[2]] + 1, {{curr[[1]], x}, ints}, {{x, x},
Append[ints, curr]}]]], {{#[[1]], #[[1]]}, {}}, Rest@#]]] &;

sequenceBoundaries@list


{{3, 7}, {10, 12}, {15, 17}, {19, 24}, {42, 46}}`