8
$\begingroup$

I have a stream of data like this:

0001100111100000111111001110000001111111111000000111000111110000...

(I can represent them as a list, like in {0,0,0,1,1,...}, I guess that's easier to work with.)

Now I want to count how many sequences of two "1"s, three "1"s, etc there are (the zeros lengths are not important, they're just separators), to show them in a histogram. I have no problems doing this procedural, but functional programming remains difficult for me. While I don't mind pausing for a cup of coffee (there's 4.8 million data points), I guess in functional programming this will be orders of magnitude faster. How do I do this with functional programming?

Note
"0011100" only counts as a sequence of length 3, the two sub-sequences of length 2 should not be taken into account.

$\endgroup$
7
$\begingroup$

If your data is in list form (conversion from string will swamp advantage), this should be quite a bit faster (5-50+X than existing answers, timings on the loungbook, so I'd expect 10+X faster for all on W/S):

tOnes = Module[{p = Append[Pick[Range@Length@#, #, 1], 0], sa},
    If[p === {0}, {},
     sa = SparseArray[Subtract[Rest@p, Most@p], Automatic, 1]["AdjacencyLists"];
     Tally[Differences[Prepend[sa, 0]]]]] &;

Comparable in speed, and arguably prettier:

tOnes2 = With[{d = Join[{0}, #, {0}]}, 
    Tally[Differences@DeleteDuplicates@Pick[Accumulate@d, d, 0]]] &;

Comparison:

(* make some data & string/digit equivalents for string/Mr.W solutions *)
data = RandomInteger[{0, 1}, 4000000];
strng = StringJoin[ToString /@ data];
mwdata = FromDigits[data];
ClearSystemCache[]

(* eldo *)
eldotim = 
  First@Timing[
    eldo = Tally@
       Select[StringLength /@ StringSplit[strng, "0"], # > 0 &];];

(* Mr. W *)
mwtim = First@
   Timing[mwr = 
      Tally[Length /@ Split[IntegerDigits@mwdata][[;; ;; 2]]];];

(* 2012rcampion *)
rctim = First@Timing[
    lengths = Cases[Split[data], l : {1, ___} :> Length[l]];
    tally = Tally[lengths];
    ];

(* kguler *)
kgtim = First@
   Timing[tally2 = Tally@StringLength@StringCases[strng, "1" ..];];

(* Me *)
me1tim = First@Timing[me = tOnes@data;];
me2tim = First@Timing[me2 = tOnes2@data;];

Transpose[{{"Mr.W", "eldo", "2012rcampion", "kguler", "Me1", "Me2"},
   {mwtim, eldotim, rctim, kgtim, me1tim, me2tim}}] // TableForm

(* Check *)
me == me2 == tally == eldo == tally2 == mwr

enter image description here

(* True *)

$\endgroup$
  • $\begingroup$ ... that "gut feeling" again :) ...+1 $\endgroup$ – kglr Apr 3 '15 at 22:29
6
$\begingroup$
strng = "0001100111100000111111001110000001111111111000000111000111110000";

tally = Tally@StringLength@StringSplit[strng, "0" ..]
tally2 = Tally@StringLength@StringCases[strng, "1" ..]
tally3 = Tally@StringCases[strng, s : "1" .. :> StringLength[s]]

all give

(* {{2, 1}, {4, 1}, {6, 1}, {3, 2}, {10, 1}, {5, 1}} *)
$\endgroup$
  • $\begingroup$ Very nice - the 2 points :) $\endgroup$ – eldo Apr 3 '15 at 15:20
  • 2
    $\begingroup$ Looks like yours is the fastest so far (0.7 s on 4M elements, vs. 1.5 s for me and 2.3 s for eldo). $\endgroup$ – 2012rcampion Apr 3 '15 at 15:20
  • $\begingroup$ @2012rcampion, i don't expect it will stay on the 'fastest so far" list too long:) $\endgroup$ – kglr Apr 3 '15 at 15:39
  • $\begingroup$ @kguler: Assuming the OP has the data as a string (so no conversion overhead), this is about as fast as it can be done short of a chunk of C... +1 $\endgroup$ – ciao Apr 3 '15 at 20:50
  • $\begingroup$ @kguler: Oops, I spoke to soon ;-) $\endgroup$ – ciao Apr 3 '15 at 22:16
3
$\begingroup$

data = "0001100111100000111111001110000001111111111000000111000111110000";

Tally@Select[StringLength /@ StringSplit[data, "0"], # > 0 &]

{{2, 1}, {4, 1}, {6, 1}, {3, 2}, {10, 1}, {5, 1}}

$\endgroup$
3
$\begingroup$

Generate 4M data points:

data = RandomInteger[1, 4000000];

Split into runs of identical elements, then find all sequences of 1s and compute their Lengths:

lengths = Cases[Split[data], l : {1 ..} :> Length[l]];

From here you can either Tally up all the lengths to use later:

Tally[lengths]//Sort
(* {{1, 499797}, {2, 249940}, {3, 124555}, {4, 62985}, {5, 31233}, {6, 
  15454}, {7, 7912}, {8, 3987}, {9, 1912}, {10, 969}, {11, 459}, {12, 
  238}, {13, 100}, {14, 59}, {15, 30}, {16, 6}, {17, 9}, {18, 6}, {19,
  1}, {20, 1}, {22, 2}} *)

... or make a Histogram directly:

Histogram[lengths, {1}, {"Log", "Count"}]

enter image description here

Update

It's slightly faster (1.5 s vs 1.6 s) to use {1, ___} instead of {1 ..} as the pattern.

$\endgroup$
1
$\begingroup$

Starting with Integer input:

in = 0001100111100000111111001110000001111111111000000111000111110000;

Length /@ Split[IntegerDigits @ in][[;; ;; 2]]
{2, 4, 6, 3, 10, 3, 5}

You can Tally that if you want:

Tally @ %
{{2, 1}, {4, 1}, {6, 1}, {3, 2}, {10, 1}, {5, 1}}
$\endgroup$
  • $\begingroup$ Short and sweet, +1 $\endgroup$ – ciao Apr 4 '15 at 0:37

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.