Determine repeating number of a given number and corresponding position

Question

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.

Answer 1

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.

Answer 2

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}}

Answer 3

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

Answer 4

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}} *)

Answer 5

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}} *)

Answer 6

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]

Answer 7

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]]

Answer 8

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}}

Answer 9

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}