10
$\begingroup$

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.

$\endgroup$
  • 2
    $\begingroup$ How do we know that you're seeking the positions and length of $1$s, and not $-1$s? $\endgroup$ – David G. Stork Aug 16 '16 at 22:10
  • $\begingroup$ 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! $\endgroup$ – Alejandro Braun Aug 16 '16 at 22:14
  • $\begingroup$ This looks like a duplicate of (116085). Also related: (23607), (117859) $\endgroup$ – Mr.Wizard Aug 17 '16 at 3:20
  • $\begingroup$ 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! $\endgroup$ – Alejandro Braun Aug 18 '16 at 18:36
11
$\begingroup$

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}}
$\endgroup$
14
$\begingroup$

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.

$\endgroup$
9
$\begingroup$
{#1, Length[{##}]} & @@@ Split[PositionIndex[data][1], #2 - #1 == 1 &]
{#1, Length[{##}]} & @@@ Split[Pick[Range@Length@data, 1 - Unitize[1 - data], 1], #2 - #1 == 1 &]
$\endgroup$
8
$\begingroup$

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}} *)
$\endgroup$
6
$\begingroup$

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}} *)
$\endgroup$
6
$\begingroup$

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]
$\endgroup$
5
$\begingroup$

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]]
$\endgroup$
5
$\begingroup$

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

$\endgroup$
3
$\begingroup$

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}
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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