# Counting certain elements in lists

I have the following data set:

n1 = 1000;
data1 = {#, {RandomInteger[3, 20]}} & /@ Range[n1];

Dimensions@data1
{1000, 2}


I want to count how often data1[[All, 2]] == 1.

My solution:

result1 = Table[
Count[Flatten@(data1[[i, 2]]), u_ /; u == 1],
{i, 1, n1}
];

Dimensions@result1
{1000}


Now I have 50 appended lists of data1 (= data2).

n3 = 50;

data2 = Array[0 &, n3];

Do[
data2[[i]] = {#, {RandomInteger[3, 20]}} & /@ Range[n1];
, {i, 1, n3}
];

Dimensions@data2
{50, 1000, 2}


I want to count how often data2[[j, i, 2]] == 1, where {i, 1, n1} and {j, 1, n3}.

My solution for this more complicated list:

result2 = Array[0 &, n3];

Do[
result2[[j]] =
Table[
Count[Flatten@(data2[[j, i, 2]]), u_ /; u == 1],
{i, 1, n1}
];
, {j, 1, n3}
];

Dimensions@result2
{50, 1000}


How can I replace the Do loops in both cases and improve the performance?

r1 = Total[1 - Unitize[data1[[All, 2, 1]] - 1], {2}]

Short @ %


{5,5,4,6,5,8,5,6,5,4,8,6,3,3,2,7,2,9,5,6,4,5,3,8,7,6,8,3,7,5,9,4,7,6,5,4,5,5,<<925>>,7,5,6,6,3,5,4,6,6,9,7,9,5,6,4,3,8,4,4,6,6,9,6,6,3,8,3,4,1,8,4,4,4,5,7,8,5}

r2 = Join @@@ Total[1 - Unitize[data2[[All, All, 2]] - 1], {4}];
r2 // Dimensions


{50, 1000}

Timings: Timing comparison with OP's Do loop and MarcoB's Map[Count,...] for data2:

n1 = 1000;
n3 = 50;
data2 = Array[0 &, n3];
SeedRandom[1]
Do[data2[[i]] = {#, {RandomInteger[3, 20]}} & /@ Range[n1];, {i, 1, n3}];

result2a = Join @@@ Total[1 - Unitize[data2[[All, All, 2]] - 1], {4}]; //
RepeatedTiming // First


0.037

result2b = Map[Count[1], data2[[All, All, 2, 1]], {2}]; // RepeatedTiming // First


0.12

(result2 = Array[0 &, n3];
Do[result2[[j]] = Table[Count[Flatten@(data2[[j, i, 2]]), u_ /; u == 1],
{i, 1, n1}];, {j, 1, n3}];) // RepeatedTiming // First


7.8

result2 == result2a == result2b


True

• Great ... what do you think about result2. Now the Indices in the result2 double loop are correct.
– lio
Mar 14 '19 at 20:12
• @lio, please see the update.
– kglr
Mar 14 '19 at 20:21
• Since especially n3 in my real problems is much larger than 50 I vote for your fast solution. Thank you for the timings. May I ask you something: how can the creation of data2 also be expressed instead of using the do loop Do[data2[[i]] = {#, {RandomInteger[3, 20]}} & /@ Range[n1];, {i, 1, n3}];?
– lio
Mar 15 '19 at 9:45
• @li, thank you for the accept. You can do data2b = Table[ Transpose[{Range[n1], RandomInteger[3, {n1, 20}]}], {i, 1, n3}]
– kglr
Mar 15 '19 at 10:16

For your result1:

Count[1] /@ data1[[All, 2, 1]]


For your result2:

Map[Count[1], data2[[All, All, 2, 1]], {2}];

• This is great ...
– lio
Mar 14 '19 at 19:57
• Do you have an idea for result2 improvement?
– lio
Mar 14 '19 at 20:10
• @lio Yes, I've added something for result2 as well. You can check that they give the same output as your result1 and result2 respectively. Mar 14 '19 at 20:17