13
$\begingroup$

Given a list: data = {{0, 2}, {0, 0}, {1, 0}, {1, 2}, {2, 3}}. I would like to count the number of sublists which contain zero. 

Count[data, {0, _}] + Count[data, {_, 0}] - Count[data, {0, 0}]

Is there any better/efficient way to do this?

| improve this question | |
$\endgroup$
  • 2
    $\begingroup$ Cases[data, {0, _} | {_, 0}] // Length $\endgroup$ – Rorschach Oct 6 '13 at 15:17
  • 1
    $\begingroup$ Or Count[data, a : {__, __} /; MemberQ[a, 0]] $\endgroup$ – C. E. Oct 6 '13 at 15:19
  • 7
    $\begingroup$ Or Count[data, {___, 0, ___}] $\endgroup$ – jVincent Oct 6 '13 at 15:20
  • 3
    $\begingroup$ Related: mathematica.stackexchange.com/questions/10555/… $\endgroup$ – Michael E2 Oct 6 '13 at 15:47
  • 2
    $\begingroup$ @MichaelE2 Pity that question never gained momentum, but a perfect example on why someone should ask a single, clear-cut question instead of four. $\endgroup$ – István Zachar Oct 6 '13 at 17:13

10 Answers 10

Active Oldest Votes
12
$\begingroup$

Using the behavior of Times in case of multiplication by (exact) zero:

Count[Times @@@ data, 0]

3

As proposed by MichaelE2, this can be considerably faster depending on the structure and size of the input: 

Count[Times @@ Transpose[data], 0]

3

| improve this answer | |
$\endgroup$
  • 2
    $\begingroup$ Somewhat faster, and much faster on packed arrays: Count[Times @@ Transpose[data], 0] $\endgroup$ – Michael E2 Oct 6 '13 at 15:42
  • $\begingroup$ @MichaelE2 wicked! $\endgroup$ – Yves Klett Oct 6 '13 at 15:51
  • $\begingroup$ @MichaelE2 added your version in to preserve it for posterity (and performance) - if you want to post separately, lemme know :-) $\endgroup$ – Yves Klett Oct 7 '13 at 11:09
  • $\begingroup$ It's fine as part of yours. It's basically the same idea, and the two belong together. $\endgroup$ – Michael E2 Oct 7 '13 at 12:14
  • $\begingroup$ @MichaelE2 totally. Uh, and it seems your solution wins the speed contest for long list of tuples hands down. $\endgroup$ – Yves Klett Oct 7 '13 at 12:54
8
$\begingroup$

Here is a reasonably fast one:

countZ = 
  Length[Union @@ Map[SparseArray[#]["NonzeroPositions"] &, Transpose[1 - Unitize[#]]]] &

you use it as

countZ[data]

If you don't want to use SparseArrays, this will give roughly similar performance:

countZAlt = Total @ Unitize[Last@Dimensions@# - Total[Unitize[#], {2}]] &
| improve this answer | |
$\endgroup$
  • $\begingroup$ Great, this is a oneliner tutorial :-) $\endgroup$ – Yves Klett Oct 6 '13 at 15:54
  • $\begingroup$ @YvesKlett All right, point taken - I added another version which does not use SparseArray :) $\endgroup$ – Leonid Shifrin Oct 6 '13 at 16:02
8
$\begingroup$

For long sublists it might be reasonable to immediately terminate element-checking after first 0 is encountered: logical operators and Position exhibit such shortcutting.

data = RandomInteger[{0, 9}, {100, 100000}];

AbsoluteTiming@Count[Times @@ Transpose[data], 0]
AbsoluteTiming@Count[Min /@ Abs@data, 0 | 0.]
AbsoluteTiming@countMinC[data]    
AbsoluteTiming@Count[Times @@@ data, 0]
AbsoluteTiming@Fold[Boole@Not@FreeQ[#2, 0] + # &, 0, data] 
AbsoluteTiming@countZ@data 
AbsoluteTiming@countZAlt@data 
AbsoluteTiming@Count[Position[#, 0, 1, 1] & /@ data, Except@{}]
AbsoluteTiming@Count[Simplify[And @@@ data], False]
AbsoluteTiming@Total[Map[Total, data /. {0 -> 1, _Integer -> 0}] /. {0 -> 0, _Integer -> 1}]

{1.244071, 100} (* MichaelE2 *)
{0.048003, 100} (* s0rce *)
{0.043002, 100} (* s0rce compiled *)
{0.924053, 100} (* Yves *)
{0.067004, 100} (* rm -rf *)
{0.844048, 100} (* Leonid countZ *)
{0.049003, 100} (* Leonid countZalt *)
{0.207012, 100} (* Position *)
{2.551146, 100} (* And *)
{2.282131, 100} (* Ymareth *)

Simplify of course could be problematic if data is longer or elements are more complex than integers... Let's check it on many more shorter sublists:

data = RandomInteger[{0, 9}, {100000, 10}];
(* ... *) 

{0.018001,65083} (* MichaelE2 *)
{0.022001,65083} (* s0rce *)
{0.004000,65083} (* s0rce compiled *)
{0.125007,65083} (* Yves *)
{0.040002,65083} (* rm -rf *)
{0.025001,65083} (* Leonid countZ *)
{0.007000,65083} (* Leonid countZalt *)
{0.286016,65083} (* Position *)
{30.547747,65083 (* And *)
{0.323018,65083} (* Ymareth *)

Of course, compiling Times (I guess the only one that is directly compilable) wins over all the others:

countC = Compile[{{d, _Integer, 2}}, Count[Times @@@ d, 0],
   Parallelization -> True , CompilationTarget -> "C",  RuntimeAttributes -> Listable,
   RuntimeOptions -> "Speed"];
| improve this answer | |
$\endgroup$
  • $\begingroup$ There is also the second solution in my post, countZAlt, which performs much better than my first one on your first test. Mind including it in your benchmarks? $\endgroup$ – Leonid Shifrin Oct 6 '13 at 16:41
  • $\begingroup$ Oh wow... I didn't mine was that fast! BTW, 0. for Leonid's doesn't seem right... I don't get that (it seems slower than mine). However, his countZAlt is faster. $\endgroup$ – rm -rf♦ Oct 6 '13 at 16:43
  • $\begingroup$ @Leonid Sure, sorry for the delay, I had to test some of my own solutions as well :) $\endgroup$ – István Zachar Oct 6 '13 at 16:54
  • $\begingroup$ Would you mind including @MichaelE2´s version Count[Times @@ Transpose[data], 0] in the timings? $\endgroup$ – Yves Klett Oct 6 '13 at 18:38
  • $\begingroup$ @Yves s0rce kindly did that, it definitely deserved the inclusion! Next time please feel free to edit in! $\endgroup$ – István Zachar Oct 7 '13 at 9:14
7
$\begingroup$

Here is a fast straight forward procedural implementation compiled to C, this requires all the sublists to have the same length but performs similar when interested in sublists containing an arbitrary integer, not just 0.

simpleC = 
  Compile[{{list, _Integer, 2}}, 
   Block[{count = 0}, 
    Do[If[MemberQ[sublist, 0], count++], {sublist, list}]; count], 
   Parallelization -> True, CompilationTarget -> "C", 
   RuntimeAttributes -> Listable, RuntimeOptions -> "Speed"];

and a faster parallel implementation

simpleCparallel = 
  Compile[{{sublist, _Integer, 1}}, Boole[MemberQ[sublist, 0]], 
   Parallelization -> True, CompilationTarget -> "C", 
   RuntimeAttributes -> Listable, RuntimeOptions -> "Speed"];

data = RandomInteger[{0, 9}, {100, 100000}];
simpleC[data] // AbsoluteTiming
Total@simpleCparallel[data] // AbsoluteTiming

{0.018001,100} 
{0.010001,100}

data = RandomInteger[{0, 9}, {10000000, 10}];
simpleC[data] // AbsoluteTiming
Total@simpleCparallel[data] // AbsoluteTiming

{0.554032,6513970}
{0.346020,6513970}

This simple solution seems to be reasonably quick:

Count[Min /@ Abs[data],  0| 0.]

and a slightly faster compiled version

countMinC = 
  Compile[{{d, _Integer, 2}}, Count[Min /@ Abs[d], 0], 
   Parallelization -> True, CompilationTarget -> "C", 
   RuntimeAttributes -> Listable, RuntimeOptions -> "Speed"];

and another option that is slightly faster for short sublists with inspiration from @Leonid

countMinC2 = 
  Compile[{{d, _Integer, 2}}, 
   Length@d - Total[Unitize[Min /@ Abs[d]]], Parallelization -> True, 
   CompilationTarget -> "C", RuntimeAttributes -> Listable, 
   RuntimeOptions -> "Speed"];
| improve this answer | |
$\endgroup$
  • $\begingroup$ Count is based on patterns, so the fully robust version will probably Count[Min /@ Abs[data], 0| 0.]. This probably won't affect the compiled version though. $\endgroup$ – Leonid Shifrin Oct 6 '13 at 17:12
  • $\begingroup$ Abs[] (see edit) should fix that. $\endgroup$ – s0rce Oct 6 '13 at 17:14
  • $\begingroup$ @Leonid Be fair, almost everyone (even OP) omitted real 0. or PossibleZeroQ :) $\endgroup$ – István Zachar Oct 6 '13 at 17:16
  • $\begingroup$ @IstvánZachar Well, fair enough. I did not, however :) $\endgroup$ – Leonid Shifrin Oct 6 '13 at 17:18
  • $\begingroup$ @LeonidShifrin fixed now. Thanks. Compiled version doesn't matter as it needs to be specific to be either Intergers or Reals. @IstvánZachar, timings added to your answer. $\endgroup$ – s0rce Oct 6 '13 at 17:21
6
$\begingroup$

Another solution:

Fold[Boole@Not@FreeQ[#2, 0] + # &, 0, list]
(* 3 *)
| improve this answer | |
$\endgroup$
  • $\begingroup$ There shall be a Microtutorial badge! BTW I like this frog better than the last one. $\endgroup$ – Yves Klett Oct 6 '13 at 16:22
  • $\begingroup$ @YvesKlett Me too! $\endgroup$ – rm -rf♦ Oct 6 '13 at 16:30
5
$\begingroup$

Here's my late entry using Select

Select[data, MemberQ[#, 0] &] // Length

OR

Select[data, Count[#, 0] != 0 &] // Length

With compiled version:

countzero = Compile[{{data, _Integer, 2}}, 
  Select[data, MemberQ[#, 0] &] // Length, Parallelization -> True,
   CompilationTarget -> "C", RuntimeAttributes -> Listable, RuntimeOptions -> "Speed"]
| improve this answer | |
$\endgroup$
5
$\begingroup$

Here's another set of timings based on the data structure of the problem as originally proposed. The count of lists with at least one zero appears right after the timing.

 r := RandomInteger[{0, 9}]
 data = Table[{r, r}, {i, 10^6}];
"Long list with short sublists"

{Count[Times @@ Transpose[data], 0] // AbsoluteTiming, "MichaelE2"}
{Fold[Boole@Not@FreeQ[#2, 0] + # &, 0, data] // 
  AbsoluteTiming, "rm-rf"}
{countzero[data] // AbsoluteTiming, "RunnyKine -compiled"}
{countC[data] // AbsoluteTiming, "István -compiled"}
{Count[data, {0, _} | {_, 0}] // 
  AbsoluteTiming, "Blackbird, using Count"}
{Length@Cases[data, {0, _} | {_, 0}] // AbsoluteTiming, "Blackbird"}   
{LengthWhile[Map[Sort, data], #[[1]] == 0 &] // 
  AbsoluteTiming, "lalmei"}    
{Count[Times @@@ data, 0] // AbsoluteTiming, "Yves Klett"}
{Count[data, {___, 0, ___}] // AbsoluteTiming, "jVincent"}
{Count[Sort /@ data, {0, _}] // AbsoluteTiming, "David Carraher"}
{countZ@data // AbsoluteTiming, "Leonid #1"}    
{Select[data, MemberQ[#, 0] &] // Length // 
  AbsoluteTiming, "RunnyKine"}
{Select[data, Count[#, 0] != 0 &] // Length // 
  AbsoluteTiming, "RunnyKine"}
{Total[Map[Total, 
     data /. {0 -> 1, _Integer -> 0}] /. {0 -> 0, _Integer -> 1}] // 
  AbsoluteTiming, "Ymareth"}
{Count[Simplify[And @@@ data], False] // AbsoluteTiming, "István?"}
{Count[Position[#, 0, 1, 1] & /@ data, Except@{}] // 
  AbsoluteTiming, "István?"}
{Count[data, a : {__, __} /; MemberQ[a, 0]] // 
  AbsoluteTiming, "Anon"}
{countZAlt@data // AbsoluteTiming, "Leonid #2"}

timings

Testing lists with sublists of varying lengths.

There were some anomalies when we tested sublists of varying lengths. Note that there are 2*10^6 random integers in each of the cases tested.

   Table[data[k] = RandomInteger[{0, 9}, {10^(6 - k), 2*10^k}], {k, 0, 
   6}];
"Long list with short sublists"
result = {
  {"SublistLength", 2, 20, 2*10^2, 2*10^3, 2*10^4, 2*10^5, 2*10^6},
  Prepend[
   Table[Count[Times @@ Transpose[data[j]], 0] // AbsoluteTiming, {j, 
     0, 6}], "MichaelE2"],
  Prepend[
   Table[Fold[Boole@Not@FreeQ[#2, 0] + # &, 0, data[j]] // 
     AbsoluteTiming, {j, 0, 6}], "rm-rf"],
  Prepend[Table[countzero[data[j]] // AbsoluteTiming, {j, 0, 6}], 
   "RunnyKine-compiled"],
  Prepend[Table[countC[data[j]] // AbsoluteTiming, {j, 0, 6}], 
   "István-compiled"],
  Prepend[
   Table[Count[Times @@@ data[j], 0] // AbsoluteTiming, {j, 0, 6}], 
   "Yves Klett"],
  Prepend[
   Table[Count[data[j], {___, 0, ___}] // AbsoluteTiming, {j, 0, 6}], 
   "jVincent"],
  Prepend[Table[countZ@data[j] // AbsoluteTiming, {j, 0, 6}], 
   "Leonid #1"],
  Prepend[Table[countZAlt@data[j] // AbsoluteTiming, {j, 0, 6}], 
   "Leonid #2"],
  Prepend[
   Table[Count[Simplify[And @@@ data[j]], False] // 
     AbsoluteTiming, {j, 0, 6}], "István"],
  Prepend[
   Table[Count[Position[#, 0, 1, 1] & /@ data[j], Except@{}] // 
     AbsoluteTiming, {j, 0, 6}], "István"],
  Prepend[
   Table[Total[
      Map[Total, 
        data[j] /. {0 -> 1, _Integer -> 0}] /. {0 -> 0, _Integer -> 
         1}] // AbsoluteTiming, {j, 0, 6}], "Ymareth"]}
Grid[result, Dividers -> {{1, 2}, {1, 2}}]

timings 2

| improve this answer | |
$\endgroup$
  • 1
    $\begingroup$ Did you by chance omit a definition for r? $\endgroup$ – Yves Klett Oct 7 '13 at 12:49
  • $\begingroup$ Could you kindly include my method countzero, I'm curious to see how well Select performs here. $\endgroup$ – RunnyKine Oct 7 '13 at 13:22
  • $\begingroup$ Yves. Yes, I did. Thanks for catching it. $\endgroup$ – DavidC Oct 7 '13 at 18:36
  • $\begingroup$ RunnyKine, I don't know how to run the compiled version. Simply running your code is clearly not enough. $\endgroup$ – DavidC Oct 7 '13 at 18:47
  • $\begingroup$ Just do countzero[data] after evaluating countzero $\endgroup$ – RunnyKine Oct 7 '13 at 19:08
3
$\begingroup$

By substitution...

Total[Map[Total, data /. {0 -> 1, _Integer -> 0}] /. {0 -> 0, _Integer -> 1}]
| improve this answer | |
$\endgroup$
0
$\begingroup$

If the sublists are always of length 2 then this is fast:

Length[data] - Dot @@ Transpose[Unitize @ data]
| improve this answer | |
$\endgroup$
0
$\begingroup$

Using a built in function called LengthWhile and Sort.

LengthWhile gives the length of all the continuous elements that meet a criteria. So in order to use it we have to first sort the list and sublists first.

LengthWhile[Sort@Map[Sort, data], #[[1]] == 0 &]

3

| improve this answer | |
$\endgroup$
  • $\begingroup$ Sorting is an overkill for the problem and it most probably is disastrous for long sublists. $\endgroup$ – István Zachar Oct 7 '13 at 14:27
  • $\begingroup$ @IstvanZachar I thought so too, but it is actually not that bad. It is actually faster then the uncompiled Times@ and Leonid's Sparse Array one, in the case of your large data test. $\endgroup$ – lalmei Oct 7 '13 at 14:32

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.