9
$\begingroup$ 
ListA = {14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 12, 12, 12, 14, 14, 14, 12, 
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 12, 14, 12, 
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 
12, 12, 12, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 12, 12, 12, 
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 54, 48, 48, 48, 52, 46, 
46, 46, 46, 52, 52, 54, 62, 56, 52, 54, 50, 46, 44, 44, 44, 44, 44, 
54, 38, 40, 46, 52, 44, 52, 50, 56, 54, 54, 56, 46, 46, 56, 48, 58, 
60, 54, 54, 46, 54, 50, 52, 54, 48, 56, 48, 56, 48, 52, 44, 54, 56, 
44, 54, 44, 54, 50, 50, 38, 40, 44, 44, 52, 42, 42, 42, 48, 44, 44, 
44, 42, 38, 42, 42, 44, 38, 36, 36, 40, 40, 42, 40, 38, 38, 40, 40, 
42, 40, 40, 42, 44, 68, 46, 38, 40, 62, 54, 40, 40, 40, 40, 42, 42, 
42, 42, 44}

I need to locate the start and end positions of any sequence of repeated successive numbers. So if a repeat goes on for 10 successive numbers I need the first and tenth position, and similar for shorter repeat of 3 successive numbers I need the first and third position (see first two sequences in ListA above).

I expected the result to be another list. The first two entries for results of ListA would be ListB = {{1, 10}, {11, 13}, ..., etc.}. Single numbers in ListA with no sequence can be ignored.

Improve this question
$\endgroup$
4
  • $\begingroup$ Related: (46117). Possible duplicate: (104672) (not an exact duplicate but close enough that I think answers are readily adapted) $\endgroup$
    – Mr.Wizard
    Dec 10, 2016 at 16:55
  • $\begingroup$ Thanks for everyone's response. I really enjoyed seeing all the different methods to solve the problem. $\endgroup$
    – SPIL
    Dec 12, 2016 at 10:00
  • $\begingroup$ Which solution is likely to be fastest over a long list? $\endgroup$
    – SPIL
    Dec 12, 2016 at 10:36
  • $\begingroup$ Although I have not run benchmarks on these specific answers I expect my proposal to be faster than anything that is not compiled as that was my intent in the original Q&A. See (22419) for one approach if you wish to benchmark these methods yourself. $\endgroup$
    – Mr.Wizard
    Dec 12, 2016 at 11:31

10 Answers 10

Reset to default
6
$\begingroup$ 
fn[{{_, fp_}, ___, {_, lp_}}] := Flatten@{fp, lp}
fn[_] := Nothing
fn /@ SplitBy[MapIndexed[List, ListA], First]

{{1, 10}, {11, 13}, {14, 16}, {18, 48}, {51, 88}, {89, 99}, {100, 249}, {251, 253}, {255, 258}, {259, 260}, {268, 272}, {282, 283}, {285, 286}, {291, 292}, {311, 312}, {315, 316}, {318, 320}, {322, 324}, {327, 328}, {331, 332}, {333, 334}, {337, 338}, {339, 340}, {342, 343}, {352, 355}, {356, 359}}

Improve this answer
$\endgroup$
2
  • $\begingroup$ This works well, and appears to work quite fast on large data sets. $\endgroup$
    – SPIL
    Dec 13, 2016 at 11:12
  • $\begingroup$ @SPIL I bring this up only because you have asked about or commented upon speed multiple times now so it seems like performance is important to you. My corrected runs code is as much as one hundred times faster than this method, on e.g. ListA = Join @@ (ConstantArray[RandomInteger[99], #] & /@ RandomInteger[{1, 30}, 15000]);. I have found it to be faster than anything based on Split or SplitBy. $\endgroup$
    – Mr.Wizard
    Dec 14, 2016 at 9:03
9
$\begingroup$

In versions 10 and later, you can get the result using a single function SequencePosition:

repSeqPos = SequencePosition[#, {Repeated[a_, {2, Infinity}]}, Overlaps->False]&;

repSeqPos @ listA

{{1, 10}, {11, 13}, {14, 16}, {18, 48}, {51, 88}, {89, 99}, {100, 249}, {251, 253}, {255, 258}, {259, 260}, {268, 272}, {282, 283}, {285, 286}, {291, 292}, {311, 312}, {315, 316}, {318, 320}, {322, 324}, {327, 328}, {331, 332}, {333, 334}, {337, 338}, {339, 340}, {342, 343}, {352, 355}, {356, 359}}

Improve this answer
$\endgroup$
1
  • $\begingroup$ This works perfectly. But the code becomes very labored and slow as the data set increases in size. $\endgroup$
    – SPIL
    Dec 13, 2016 at 11:11
6
$\begingroup$

Gives also the start-ends of single-element sublists:

pos = Accumulate @ Partition[{1}~Join~(Length /@ Split @ ListA), 2, 1]

{{1, 10}, {11, 13}, {14, 16}, {17, 17}, {18, 48}, {49, 49}, {50, 50}, {51, 88}, {89, 99}, {100, 249}, {250, 250}, {251, 253}, {254, 254}, {255, 258}, {259, 260}, {261, 261}, {262, 262}, {263, 263}, {264, 264}, {265, 265}, {266, 266}, {267, 267}, {268, 272}, {273, 273}, {274, 274}, {275, 275}, {276, 276}, {277, 277}, {278, 278}, {279, 279}, {280, 280}, {281, 281}, {282, 283}, {284, 284}, {285, 286}, {287, 287}, {288, 288}, {289, 289}, {290, 290}, {291, 292}, {293, 293}, {294, 294}, {295, 295}, {296, 296}, {297, 297}, {298, 298}, {299, 299}, {300, 300}, {301, 301}, {302, 302}, {303, 303}, {304, 304}, {305, 305}, {306, 306}, {307, 307}, {308, 308}, {309, 309}, {310, 310}, {311, 312}, {313, 313}, {314, 314}, {315, 316}, {317, 317}, {318, 320}, {321, 321}, {322, 324}, {325, 325}, {326, 326}, {327, 328}, {329, 329}, {330, 330}, {331, 332}, {333, 334}, {335, 335}, {336, 336}, {337, 338}, {339, 340}, {341, 341}, {342, 343}, {344, 344}, {345, 345}, {346, 346}, {347, 347}, {348, 348}, {349, 349}, {350, 350}, {351, 351}, {352, 355}, {356, 359}, {360, 360}}

Ignoring subsequences of length 1:

Select[pos, Differences@# != {0} &]

{{1, 10}, {11, 13}, {14, 16}, {18, 48}, {51, 88}, {89, 99}, {100, 249}, {251, 253}, {255, 258}, {259, 260}, {268, 272}, {282, 283}, {285, 286}, {291, 292}, {311, 312}, {315, 316}, {318, 320}, {322, 324}, {327, 328}, {331, 332}, {333, 334}, {337, 338}, {339, 340}, {342, 343}, {352, 355}, {356, 359}}

Alternatively:

pos = MinMax /@ SplitBy[MapIndexed[List, ListA], First][[All, All, 2]]
Select[pos, #[[1]] != #[[2]] &]
Improve this answer
$\endgroup$
5
$\begingroup$

Another possibility:

seqs = {1, 0} + # & /@ Partition[Prepend[Accumulate[Length /@ Split[ListA]], 0], 2, 1];
Pick[seqs, Unequal @@@ seqs]
   {{1, 10}, {11, 13}, {14, 16}, {18, 48}, {51, 88}, {89, 99}, {100, 249}, {251, 253},
    {255, 258}, {259, 260}, {268, 272}, {282, 283}, {285, 286}, {291, 292}, {311, 312},
    {315, 316}, {318, 320}, {322, 324}, {327, 328}, {331, 332}, {333, 334}, {337, 338},
    {339, 340}, {342, 343}, {352, 355}, {356, 359}}
Improve this answer
$\endgroup$
5
$\begingroup$

So many ways in Mathematica to do anything:

ending = Accumulate[Length[#] & /@ Split[ListA]];
starting = Flatten[{1, ending[[1 ;; Length[ending] - 1]] + 1}];
Select[Transpose[{starting, ending}], #[[2]] - #[[1]] > 0 &]

{{1, 10}, {11, 13}, {14, 16}, {18, 48}, {51, 88}, {89, 99}, {100,
249}, {251, 253}, {255, 258}, {259, 260}, {268, 272}, {282, 283}, {285, 286}, {291, 292}, {311, 312}, {315, 316}, {318, 320}, {322, 324}, {327, 328}, {331, 332}, {333, 334}, {337, 338}, {339, 340}, {342, 343}, {352, 355}, {356, 359}}

Improve this answer
$\endgroup$
5
$\begingroup$

Update: revised to return only sequences of length two or greater

I propose a derivative of my answer to Find continuous sequences inside a list

runs[a_List] := 
 Pick[{##}\[Transpose], Unitize @ Subtract[##], 1] &[Prepend[# + 1, 1], 
    Append[#, Length@a]] & @ SparseArray[Differences@a]["AdjacencyLists"]

runs @ ListA // Short

{{1,10}, {11,13}, {14,16}, <<20>>, {342,343}, {352,355}, {356,359}}
Improve this answer
$\endgroup$
13
  • $\begingroup$ Yes this is far faster. But why does it produce {360, 360} at the end? I need sequences 2 and greater. Please can you help? $\endgroup$
    – SPIL
    Dec 13, 2016 at 11:02
  • $\begingroup$ @SPIL Oh, only sequences of length two or greater? Sorry, I missed that detail! This is giving start/end for all runs. Let me see if I can fix this. $\endgroup$
    – Mr.Wizard
    Dec 13, 2016 at 11:04
  • $\begingroup$ @SPIL please see my revised answer and let me know if you discover any more problems. It's not quite as fast as before but still appears to be faster than other methods. $\endgroup$
    – Mr.Wizard
    Dec 13, 2016 at 11:36
  • $\begingroup$ I'm in v11.0.1.I remember that SparseArray object has a propertes "NonzeroPositions",but now seem to change into MatrixColumns.So pity. $\endgroup$
    – yode
    Dec 13, 2016 at 12:11
  • $\begingroup$ @yode Sorry, I don't understand your comment. Are you saying the Property "NonzeroPositions" has been removed or replaced in v11? $\endgroup$
    – Mr.Wizard
    Dec 13, 2016 at 12:12
4
$\begingroup$

Jim's answer encouraged me!

Leaving all the hard work to pattern matching:

f[{}, n_] := {{}, {1, 1, n}}
f[{ls___, {st_, ct_, last_}}, last_]:= {ls, {st, ct + 1, last}}
f[{ls___, {st_, st_, last_}}, new_] := {ls, {st + 1, st + 1, new}}
f[{ls___, {st_, ct_, last_}}, new_] := {ls~Append~{st, ct}, {ct + 1, ct + 1, new}}

First@Fold[f, {}, ListA]

{{1, 10}, {11, 13}, {14, 16}, {18, 48}, {51, 88}, {89, 99}, {100, 249}, {251, 253}, {255, 258}, {259, 260}, {268, 272}, {282, 283}, {285, 286}, {291, 292}, {311, 312}, {315, 316}, {318, 320}, {322, 324}, {327, 328}, {331, 332}, {333, 334}, {337, 338}, {339, 340}, {342, 343}, {352, 355}, {356, 359}}

Improve this answer
$\endgroup$
3
$\begingroup$

You my SplitBy Identity to get the sublist. Then FoldList to get their start and end positions in the list. Finally Select those that are longer than one position.

Select[Subtract @@ # != 0 &]@
 FoldList[
  Last@#1 + {1, Length@#2} &,
  {0, 0},
  SplitBy[listA, Identity]
  ]

{{1, 10}, {11, 13}, {14, 16}, {18, 48}, {51, 88}, {89, 99}, {100, 249}, {251, 253}, 
 {255, 258}, {259, 260}, {268, 272}, {282, 283}, {285, 286}, {291, 292}, {311, 312}, 
 {315, 316}, {318, 320}, {322, 324}, {327, 328}, {331, 332}, {333, 334}, {337, 338}, 
 {339, 340}, {342, 343}, {352, 355}, {356, 359}}

Hope this helps.

Improve this answer
$\endgroup$
1
$\begingroup$ 
#[[{1, -1}]]&/@ 
 Values[Select[
   PositionIndex[
    Flatten[MapIndexed[First[#2] + #1 &, Unitize[Split[ListA]]]]], 
   Length@# > 1 &]]

{{1,10},{11,13},{14,16},{18,48},{51,88},{89,99},{100,249},{251,253},{255,258},{259,260},{268,272},{282,283},{285,286},{291,292},{311,312},{315,316},{318,320},{322,324},{327,328},{331,332},{333,334},{337,338},{339,340},{342,343},{352,355},{356,359}}

Improve this answer
$\endgroup$
0
$\begingroup$

Just for fun here is a slightly contrived ReplaceList method based on Finding a subsequence in a list.

ReplaceList[ListA,
  {P___, Q : Repeated[q_, {2, ∞}], Except[q_], ___} /; 
    Last[{P}] =!= q :>
      Length[{P}] + {1, Length[{Q}]}
]

{{1, 10}, {11, 13}, {14, 16}, {18, 48}, {51, 88}, {89, 99}, {100, 249}, {251, 
  253}, {255, 258}, {259, 260}, {268, 272}, {282, 283}, {285, 286}, {291, 
  292}, {311, 312}, {315, 316}, {318, 320}, {322, 324}, {327, 328}, {331, 
  332}, {333, 334}, {337, 338}, {339, 340}, {342, 343}, {352, 355}, {356, 359}}

The Last[{P}] =!= q part is ugly and throws a warning but I couldn't think of better.

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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