# Determine repeating number of a given number and corresponding position

For instance, the data is as follows:

data = {1, 1, 1, -1, -1, 1, 1, -1}


The target output when determining how many times "1" repeats should be:

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


with the 1 showing that the first set of repetitions begins at position 1 in the list and the 3 showing that "1" occurs 3 times. The 6 shows that the second set of repetitions begins in the sixth position of the list and the "1" occurs twice.

• How do we know that you're seeking the positions and length of $1$s, and not $-1$s? – David G. Stork Aug 16 '16 at 22:10
• I apologize for any confusion I may have caused, David. I did mean 1s and not -1s. I should have used 1s and 0s in the example, but andre's response gives me the output I required. Edit: Batracos, your suggestion doesn't seem to give me the output I'm looking for. Thank you for your help though! – Alejandro Braun Aug 16 '16 at 22:14
• This looks like a duplicate of (116085). Also related: (23607), (117859) – Mr.Wizard Aug 17 '16 at 3:20
• Thank you for pointing that out, Mr. Wizard. I didn't come across those in my search but they offer some elegant ways to solve the problem. Also, thank you to everyone who provided a solution! I do not fully comprehend how all of the solutions work, but they give me something to learn about! – Alejandro Braun Aug 18 '16 at 18:36

I think this question may still be considered a duplicate of Finding negative sequences in a large list: optimization but it seems to permit a somewhat simpler solution which I would like to post.

This is still written for performance over brevity. I shall benchmark it later if I remember.

fn[a_List, n_] :=
Module[{p, q, r},
p = Pick[Range @ Length @ a, Unitize[n - a], 1];
q = Prepend[p + 1, 1];
r = Append[p, Length@a + 1] - q;
Pick[{q, r}\[Transpose], Unitize @ r, 1]
]


Example:

data = {1, 1, 1, -1, -1, 1, 1, -1};

fn[data, 1]

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


If you have Mma version >= 10.1 , this does the job :

data = {1, 1, 1, -1, -1, 1, 1, -1};
{First[#], Last[#] - First[#] + 1} & /@ SequencePosition[data, {Repeated[1]}, Overlaps -> False]


In terms of speed, this solution is catastrophic. See studies in other answers.

{#1, Length[{##}]} & @@@ Split[PositionIndex[data][1], #2 - #1 == 1 &]
{#1, Length[{##}]} & @@@ Split[Pick[Range@Length@data, 1 - Unitize[1 - data], 1], #2 - #1 == 1 &]


This one's just for fun, kind of a reverse-codegolf

i = 1;
Reap[Scan[(Sow[{First@#, i, Length@#}]; i += Length[#];) &,
Split[data]]] // Cases[#, {1, x__} :> {x}, Infinity] &
(* {{1, 3}, {6, 2}} *)


You could use Position[] and Split[_, #2 - #1 == 1 &]

data = {1, 1, 1, -1, -1, 1, 1, -1};

(*
Flatten@Position[data, 1]
{1, 2, 3, 6, 7}
*)

{First@#, Length@#} & /@
Split[Flatten@Position[data, 1], #2 - #1 == 1 &]
(* {{1, 3}, {6, 2}} *)


It seems that I'm late to the party, yet another one-liner:

Thread[{Most@Prepend[Accumulate@# + 1, 1], #}][[3/2-data[[1]]/2;; ;; 2]] &[Length /@ Split@data]


Just a variant of Jason B answer (because I enjoy Reap and Sow):

Reap[MapIndexed[Sow[#2[[1]], #1] &, data],
1, {First@#, Length@#} & /@ Split[#2, #2 - #1 == 1 &] &][[-1, 1]]


ReplaceRepeated version, inefficient as it frequently is.

SeedRandom[1];
test = RandomChoice[{-1, 1}, 20]


{1, 1, -1, 1, -1, -1 ... 1, 1, 1}

(Reverse[Append[1] /@ Position[test, 1]] //.
{x___, {a_, b_}, {c_, 1}, y___} /; a == c + 1 :>
{x, {c, b + 1}, y}) // Reverse


{{1, 2}, {4, 1}, {8, 1}, {10, 1}, {18, 3}}

Seeing an answer from andre using SequencePosition but remembering that it can be slow with patterns I wanted to test a String alternative. For this answer I shall assume that your list is always composed of 1 and -1 and you are searching for 1, just to keep the code a bit shorter. If not Unitize can be used as demonstrated earlier. Alternatively a different offset could be used before FromCharacterCode if the values in your input are not too large.

fn2[a_List] :=
Module[{str, pos},
str = FromCharacterCode[a + 96];
pos = StringPosition[str, "a" .., Overlaps -> False];
If[pos === {}, Return[{}]];
{#, #2 - # + 1}\[Transpose] & @@ (pos\[Transpose])
]


This is slower than my first method but it is much faster than SequencePosition:

x = RandomChoice[{-1, 1}, 2*^3];

fn[x, 1]; // RepeatedTiming

fn2[x];   // RepeatedTiming

SequencePosition[x, {1 ..}, Overlaps -> False]; // RepeatedTiming

{0.0000665, Null}

{0.000263, Null}

{10.79, Null}