0
$\begingroup$

I am trying to effectively find a number which tells me the number of sequences of ones in a vector of zeros and ones. For example, consider the vector:

{1,1,0,0,1,1,1,0,1}

My question is, how many {1,1} does it contain, while I don't want to consider {1,1,1} like 2 times series of {1,1}. So the answer should be 1 not 3. Of course I want to find out answer for sequences of {1,1,1} , {1,1,1,1}... to the longest sequence, in some different series of zeros and ones. Is there some nice built in function which can help me please ?

To Addendum:

Thanks again, yes algorithm using Tally works much better, actually a need it for this function which is calculating from vector input RQA analysis, If you have some suggestion how to speed up I would be glad. I want to use it on vector of length 10^4 and now it takes on my machine like 70 seconds.

ClearAll[Rp1];
Rp1[data_] := 
 Module[{rr, N1, idx, R, SR, RR, DDE, DET, i, j, DE}, 
  rr = N[Variance[data]];
  N1 = Length[data];
  R = ConstantArray[0, {N1, N1}];
  idx = Nearest[data -> Automatic, data, {\[Infinity], Sqrt[rr]}][[
    All, 2 ;;]];
  MapIndexed[{x, y} \[Function] R[[y, x]] = 1, idx];
  R;
  SR = Total[Total[R]];
  RR = SR/(N1*(N1 - 1));
  oneCount[list_, len_] := 
   Total@UnitStep[
     ListCorrelate[ArrayPad[ConstantArray[1, len], 1, -1], 
       list, {2, -2}, 0] - len];
  DE = Total[
    Table[oneCount[Diagonal[R, i], 1], {i, 1, 
      Length[Diagonal[R, 1]]}]] ;
  DET = (SR - 2*DE )/SR;
  N[{RR, DET}]
  ]
$\endgroup$
  • $\begingroup$ If you need further speed improvements, you should probably investigate using Compile. $\endgroup$ – Carl Woll Apr 5 '18 at 16:35
2
$\begingroup$

One idea is to use SequenceCount, but then you will need to account for sequences of 1s at the edge of the lists. An alternative is to use ListCorrelate with a kernel like {-1, 1, 1, -1}. For example:

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

2

With the above kernel, the only sequence of 0s and 1s that produces a 2 is {0, 1, 1, 0}:

{-1, 1, 1, -1} . #& /@ Tuples[{0, 1}, 4]
Count[%, 2]

{0, -1, 1, 0, 1, 0, 2, 1, -1, -2, 0, -1, 0, -1, 1, 0}

1

So, the following code will count all sequences of {0, 1, 1, 0} in your list:

Total @ UnitStep[ListCorrelate[{-1,1,1,-1}, list, {2,-2}, 0] - 2]

1

We can turn this into a function, and generalize to different lengths:

oneCount[list_, len_] := Total @ UnitStep[
    ListCorrelate[ArrayPad[ConstantArray[1, len], 1, -1], list, {2, -2}, 0] - len
]

For example:

oneCount[list, 2]
oneCount[list, 3]

1

1

Addendum

It seems you want a tally of all of the runs of 1s. In that case it would be much faster to use a different algorithm that does a single pass over the list:

allSequences[list_] := Tally[
    Length /@ Split[list][[If[list[[1]]==1, 1, 2] ;; -1 ;; 2]]
]

For your example:

allSequences @ {1,1,0,0,1,1,1,0,1}

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

and for a larger example:

list = RandomInteger[1,10^4];

allSequences[list] // RepeatedTiming

{0.0017, {{3, 307}, {2, 623}, {1, 1248}, {4, 172}, {5, 67}, {8, 13}, {6, 39}, {12, 1}, {10, 5}, {7, 14}, {9, 4}, {11, 3}}}

$\endgroup$
  • $\begingroup$ Many thanks, is there any chance to make this code faster, for some matrix of zeros and ones of length 10000 ? Smat[Mat_] := ( oneCount[list_, len_] := Total@UnitStep[ ListCorrelate[ArrayPad[ConstantArray[1, len], 1, -1], list, {2, -2}, 0] - len]; oo = Table[ Table[oneCount[Diagonal[Mat, j], i], {i, 1, Length[Diagonal[Mat, j]]}], {j, 1, Length[Mat] - 1}]; Yout = Total@ Table[Flatten[{oo[[i]], Table[0, {i - 1}]}], {i, Length[oo]}] $\endgroup$ – Mark Foster Apr 4 '18 at 13:27
  • $\begingroup$ @MarkFoster See update $\endgroup$ – Carl Woll Apr 4 '18 at 17:47

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.