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?
Mathematica Stack Exchange is a question and answer site for users of Wolfram Mathematica. It only takes a minute to sign up.
Sign up to join this communityUsing 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
Count[Times @@ Transpose[data], 0]
$\endgroup$
Oct 6, 2013 at 15:42
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}]] &
SparseArray
:)
$\endgroup$
Oct 6, 2013 at 16:02
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"];
countZAlt
, which performs much better than my first one on your first test. Mind including it in your benchmarks?
$\endgroup$
Oct 6, 2013 at 16:41
countZAlt
is faster.
$\endgroup$
Count[Times @@ Transpose[data], 0]
in the timings?
$\endgroup$
Oct 6, 2013 at 18:38
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"];
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$
Oct 6, 2013 at 17:12
PossibleZeroQ
:)
$\endgroup$
Oct 6, 2013 at 17:16
Intergers
or Reals
. @IstvánZachar, timings added to your answer.
$\endgroup$
Another solution:
Fold[Boole@Not@FreeQ[#2, 0] + # &, 0, list]
(* 3 *)
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"]
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"}
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}}]
r
?
$\endgroup$
Oct 7, 2013 at 12:49
countzero
, I'm curious to see how well Select
performs here.
$\endgroup$
Oct 7, 2013 at 13:22
countzero[data]
after evaluating countzero
$\endgroup$
Oct 7, 2013 at 19:08
By substitution...
Total[Map[Total, data /. {0 -> 1, _Integer -> 0}] /. {0 -> 0, _Integer -> 1}]
If the sublists are always of length 2 then this is fast:
Length[data] - Dot @@ Transpose[Unitize @ data]
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
Cases[data, {0, _} | {_, 0}] // Length
$\endgroup$Count[data, a : {__, __} /; MemberQ[a, 0]]
$\endgroup$Count[data, {___, 0, ___}]
$\endgroup$