Counting the population of integers

Suppose that myData is a list of sublists. Each sublist has a length of one or greater and contains any number of replicates of the integers 1, 2, 3, and 4. I would like to create a function myFun that counts the number of each integer in the sublist.

As an example, suppose that I have the following myData:

myData = {{2, 3, 3, 1, 1, 3, 2, 2, 4, 1, 1, 1, 2, 2, 2, 2, 2, 1, 1, 1},
{2, 2, 3, 1, 1, 3, 2, 2, 3, 1, 1, 1, 2, 2, 1, 2, 2, 1, 1, 1},
{1, 2, 2, 1, 1, 3, 2, 1, 3, 1, 1, 2, 2, 2, 2, 3, 1, 1},
{2, 3, 3, 1, 1, 2, 3, 2, 3, 1, 2, 1, 2, 1, 2, 2, 2, 1, 1, 1}};


I would like myFun /@ myData to return the output:

{{{1, 8}, {2, 8}, {3, 3}, {4, 1}},
{{1, 9}, {2, 8}, {3, 3}, {4, 0}},
{{1, 8}, {2, 7}, {3, 3}, {4, 0}},
{{1, 8}, {2, 8}, {3, 4}, {4, 0}}}


In other words, sublist 1 has eight 1s, eight 2s, three 3s, and one 4, and similarly for the other three sublists. The key feature here is that all of 1, 2, 3, and 4 are listed, even if one or more of them have zero population.

Using the following (taking advantage of Tally) gets me close:

myFun[sublist_] := SortBy[Tally[sublist], First]
myFun /@ myData

{{{1, 8}, {2, 8}, {3, 3}, {4, 1}},
{{1, 9}, {2, 8}, {3, 3}},
{{1, 8}, {2, 7}, {3, 3}},
{{1, 8}, {2, 8}, {3, 4}}}


But Tally does not list members with zero population, so the above does not satisfy the key feature.

On the other hand, the following (using Count) seems to accomplish my goal:

myFun[sublist_] := Map[{#, Count[sublist, #]} &, {1, 2, 3, 4}]
myFun /@ myData

{{{1, 8}, {2, 8}, {3, 3}, {4, 1}},
{{1, 9}, {2, 8}, {3, 3}, {4, 0}},
{{1, 8}, {2, 7}, {3, 3}, {4, 0}},
{{1, 8}, {2, 8}, {3, 4}, {4, 0}}}


But, is there a more succinct, more elegant way to do this? Thanks for your time!

-
You could do Outer[Count, myData, {1, 2, 3, 4}, 1] – jVincent Feb 9 '13 at 22:02
@jVincent That's not at all efficient computationally, but it is efficient with keystrokes which you know I like! – Mr.Wizard Feb 10 '13 at 16:54
@Mr.Wizard It might not be the best way to achieve this goal, but I would argue that it's the "right" way to make the double mapping that Andrew wrote in the last part of his question. It's also slightly faster then that solution. – jVincent Feb 10 '13 at 19:52
@Mr.Wizard Also, my quick testing has it being faster than your posted solution and Leonids. Care to elaborate your claim of inefficiency? – jVincent Feb 10 '13 at 20:01

Though it is not typically as fast as Tally I am fond of Sow and Reap for this kind of problem:

countBy[dat_, bins_] :=
{bins, Tr /@ Reap[Sow[1, #], bins, Tr@#2 &][[2]]}\[Transpose] & /@ dat

countBy[myData, {1, 2, 3, 4}] // List // MatrixForm


Since Tally is probably better in the long run despite my enjoyment of Sow and Reap here is a way to use that efficiently:

countBy2[dat_, bins_] :=
{bins, Replace[bins, Dispatch @ Append[Rule @@@ Tally @ #, _ -> 0], {1}]}\[Transpose] & /@ dat


Performance

I commented that while a method that jVincent proposed (also in a comment) was short and elegant that it was "not at all efficient computationally." He rebuts this in an answer, to which I will now reply. I was of course not speaking about the absolute performance on this tiny example but rather about algorithmic complexity and the way the method scales to a larger problem. The issue with using Count is that each list must be scanned as many times as there are unique elements. When the list is long and contains a large number of such elements this becomes a very slow process.

I shall use the faster Tally method (countBy3) rather than the playful Sow and Reap method while comparing performance. I will use the following functions:

SetAttributes[timeAvg, HoldFirst]

timeAvg[func_] := Do[If[# > 0.3, Return[#/5^i]] & @@ Timing@Do[func, {5^i}], {i, 0, 15}]

myFun[sublist_] := SortBy[Tally[sublist], First]
myFun[sublist_, elems_] :=
Replace[myFun[sublist~Join~elems], {el : Alternatives @@ elems, n_} :> {el, n - 1}, 1];
leonid[dat_, bins_] := myFun[#, bins] & /@ dat

jV[dat_, bins_] :=
Outer[{#2, Count[#1, #2]} &, dat, bins, 1]


First, using an array of fixed size but varying the number bins to tally:

times =
Table[
With[{dat = RandomInteger[{1, n}, {1000, 1000}]},
timeAvg[#[dat, Range@n]] & /@ {jV, leonid, countBy2}
],
{n, 3^Range@6}
]

{{0.1028, 0.01312, 0.007608},
{0.2776, 0.01996, 0.012104},
{0.811, 0.0418, 0.02372},
{2.371, 0.1216, 0.05616},
{7.161, 0.593, 0.2246},
{21.45, 3.573, 0.468}}

ListPlot[times\[Transpose], PlotRange -> All, AxesOrigin -> {1, -1}, Joined -> True]


The blue line is the timing of jVincent's Count method, the purple line Leonid's, and the yellow line mine. Clearly Count does not scale well with regard to an increasing number of unique elements.

Here is a run-off between Leonid's code an my own (not that he wrote it with peak efficiency in mind), using much longer sublists to allow for more unique elements:

times2 =
Table[
With[{dat = RandomInteger[{1, n}, {20, 25000}]},
timeAvg[#[dat, Range@n]] & /@ {leonid, countBy2}
],
{n, 3^Range@9}
]

{{0.0011728, 0.0009232},
{0.0012976, 0.0009984},
{0.0017712, 0.001248},
{0.003368, 0.001872},
{0.011352, 0.003744},
{0.0688, 0.009608},
{0.561, 0.03304},
{4.914, 0.156},
{43.462, 0.39}}

ListPlot[times2\[Transpose], PlotRange -> All, AxesOrigin -> {1, -1}, Joined -> True,
PlotStyle -> ColorData[1] /@ {2, 3}]


So once again at the extremes Leonid's code "blows up" while mine does not.

That is what I meant by "not at all efficient computationally."

-
Nice update. I would however like to add that one should never take the train to work because "It would be faster if going across the country!" when it's slower and more expensive than taking the bus. For this case the question the becomes if the small number of unique elements was part of the usage case or not, and if it was, then my answer seems to be of sound computational complexity with respect to input scaling. This however is only because I can't seem to get the the "resorting" of Tallys output done in less then the performance cost of running count 4 times. – jVincent Feb 10 '13 at 22:06
Thanks for this comparison. My method "blows up"not because of Tally, but because of Alternatives@@elems pattern in my post-processing. This was an oversight from my side and can be improved. I will post faster code soon and ping you then. – Leonid Shifrin Feb 11 '13 at 4:51

You can still use your original strategy, just add a list of unique elements you wish to track, to your sublists, and then adjust the counts. You can add a second definition to your original myFun, which would take a list of tracked elements as a second parameter, as follows:

ClearAll[myFun];
myFun[sublist_] := SortBy[Tally[sublist], First]
myFun[sublist_, elems_] :=
Replace[myFun[sublist~Join~elems],
{el : Alternatives @@ elems, n_} :> {el, n - 1}, 1];


Then,

myFun[#, {1, 2, 3, 4}] & /@ myData


produces the result you desire.

EDIT

Since the performance issue came up, I have to mention that the above solution is suboptimal, but not due to Tally, but rather due to the use of Alternatives @@ elems, which makes its complexity to be O(Length[elems] * Length[sublist]). Here is a much faster one:

ClearAll[myFun1,leonid1];
myFun1[sublist_, elems_] :=
Module[{tallyT = Transpose@Tally[elems ~ Join ~ sublist],
range = Range[Length[elems]]},
tallyT[[2, range ]] = tallyT[[2, range ]] - 1;
SortBy[Transpose[tallyT], First]
];
leonid1[dat_, bins_] := myFun1[#, bins] & /@ dat


from what I could see, it is the fastest so far. I save big because I put elems in front, and so, since Tally does its counts in the order it meets the elements, I know precisely the positions of elements where I need to adjust the counts. And I sort the result afterwards.

-
+1 for not abandoning Tally. – VF1 Feb 10 '13 at 0:46
Leonid, I know that you did not write this for ultimate speed or you would be compiling to C (and blowing the door off mine to be sure) but I think you might be interested in the timings I added to my answer. – Mr.Wizard Feb 10 '13 at 22:05
@Mr.Wizard Have a look at my new version. – Leonid Shifrin Feb 11 '13 at 5:37
@jVincent "If you have a loop that constantly performs operation f[input,100], it doesn't matter if f[x,n] is O(n) and g[x,n] is O(n^2), you might still have f be the faster solution." - right, this is the core of why I find your approach problematic. The statement is correct, but why do you think that this is the main use case for this function? Had the OP faced a problem having this in a large loop, he'd say so in the question. This is not what most people imply when ask to optimize a function. If they need to optimize code in a loop, they would say so. – Leonid Shifrin Feb 11 '13 at 12:09
@jVincent To summarize - and this is my last comment on this matter: the beef I have with your approach to benchmarking is that you present benchmarks which are accurate only for a very narrow subset of all possible cases where functions in question can be used (namely, functions used on smallish toy lists, but in a large loop). To my mind, such benchmarks are of limited utility. Also, if you present them / argue about efficiency, you have to always state under which conditions your conclusions are correct - which you did not do, as far as I am concerned. – Leonid Shifrin Feb 11 '13 at 12:15
 Thread[{Range[Max@myData], BinCounts[#, {1, 1 + Max@myData, 1}]}] & /@ myData


or

 Thread[{Most@#[[1]], #[[2]]}] & /@ (HistogramList[#, {1, 1 + Max@myData, 1}] & /@ myData)


or

myTally[data_, elems_:{}] :=
Composition[# /. {e_, n_} :> {e, n - Boole[MemberQ[elems, e]]} &, Sort, Tally, Join][#, elems] & /@ data;
myTally[myData, {1, 2, 3, 4}]


All give:

 (* {{{1, 8}, {2, 8}, {3, 3}, {4, 1}},
{{1, 9}, {2, 8}, {3, 3}, {4, 0}},
{{1, 8}, {2, 7}, {3, 3}, {4, 0}},
{{1, 8}, {2, 8}, {3, 4}, {4, 0}}} *)

-

Side note

I have performed a larger revision on this answer to reflect input from Leonid and further testing to highligh points raised in our discussion, it still contains the initial solutions and benchmarks, however leonids code was updated to his newest version as it behaves similarly to his original yet scales better with respect to number of unique elements.

My initial comment and naive solution posted was to simply perform andrews already stated double loop over the (subslists,uniqe) element pais using Outer:

Outer[{#2, Count[#1, #2]} &, myData, {1, 2, 3, 4}, 1]


This elegang solution performs quite well in the regime of the given example data compared to other solutions given to this answer as will be documented, however given large number of unique elements or very long sublists, this solution will scale better:

quickCount[data_,elms_] :=
Transpose@{elms, #} & /@ (Map[Tally[Join[elms, #]] &, myData][[1 ;;, 1 ;;, 2]] - 1)


The above also outperforms any other answer (as of writing) and the naive solution for the regime of the example data. It's assumed that the data only contains elements found in elms.

The performance testing

The last solution above was added after Mr. wizard in response to the original solution raised concerns regarding computational efficiency for larger lists. The issue in short is that when we loop over the sublists elements performing n iterations and then for each iteration perform m comparisons taking the time T = (n*(loopT+m*checkT)) while for the count-based algorithm we carry out a loop for each unique element throughout the lists and then iterate through the sublist, thus: T=m*(n*(loopT+checkT)). Thus the latter has an additional temporal cost of (m-1)*loopT. Owing to the fact that loopT is small and that indeed in the question m was fixed at 4, I did not take issue with this scaling, but Mr.wizard is indeed correct that the asymtotic computational efficiency with respect to number of unique elements is worse for the Count-based solution than for the Tally based solution. If we assume that we are dealing with the 4 fixed unique elements listed in the myData test example, both solutions have the same asymptotic complexity in sublists lengths and number of subslist namely O(n) in both (verified below).

Now while it's nice to look at bigO, the real discussion arose because I had the aduacity to include test that showed that for the given usage case the naive algorithm outperformed Leonids Tally based solution. The performance meassurements are given below using two different input data, a randomized dataset of same dimensionality as myData, and a set containing much larger sublists (generation method is detailed at the end of the answer):

testdata was generated using SeedRandom[7529127];myData=RandomInteger[{1,4},{40,20}].

It is true however that Leonids solution will become better if we use many more unique elements. My testing shows that starting from the myData sizes we see that Leonids solution outperforms the naive when (numElms>16,lengthList=20). Now a different consideration is the length of the input sublists. Even though both algorithms have the same asymptotic bigO scaling does not mean that they will both follow that scaling for small n, and the exact prefactor needs to be know before any conclusion can be drawn.

testdata was generated using SeedRandom[7529127];myData=RandomInteger[{1,4},{40,500}];.

Looking at actual timings we see however that arguments based on asymptotic scaling don't really apply to Leonids solution until we reach lists that are more then 10^5 elements long, at which point we still can argue which is better since they all scale as O(n). The actual performance comparison becomes a question of finding the prefactors which is seen to be much much larger for the Count-based solution, specifically we see that in the regime of (numList=4,numList>~100) Leonids solution beats the naive, below the the naive outperforms his.

The above shows nicely Leonids objections, he was upset that the simpler solution was shown to be faster in the region of input similar to the example, (region between 10-100), even though it scales better. I would characterize it as a case of "You pay for everything not just for what scales". His solution shows a nice scaling with respect to input list size, however it is still slower for the testing cases because of slow handling of the nicely scaling output of Tally. When dealing with actual usage such considerations should be taken into account, and it is not generally the case that a method exists that will outperform another in all regimes.

Concluding remarks

BigO scale reasoning is a great tool for improving algorithms, but should be backed up by actual testing with representative data in order to verify that indeed performs better. In particular when dealing with functions typically called with small input.

And on second note, one should never argue that timings based on actual use-cases aren't meaningful because they are not "general" with the implied assumption that the "general" means representative of very large inputs, simply for the sake of letting better scaling algorithms win the race. A timing showing MethodA faster than methodB for a given dataset means just that, even if the ordering would hot have been the same for a different use-case.

For completeness the profiled code bits

I chose originally not to post this since it' s just repeating the code of other answers, but since Leonid asked, here it is :

andrewMap[sublist_] := Map[{#,Count[sublist,#]}&,{1,2,3,4}]
andrew := andrewMap/@myData

myFun1[sublist_, elems_] :=
Module[{tallyT = Transpose@Tally[elems ~ Join ~ sublist],
range = Range[Length[elems]]},
tallyT[[2, range ]] = tallyT[[2, range ]] - 1;
SortBy[Transpose[tallyT], First]
];
leonid := myFun1[#, {1,2,3,4}] & /@ myData;

countBy[dat_, bins_] := {bins, Tr /@ Reap[Sow[1, #], bins, Tr@#2 &][[2]]}\[Transpose] & /@ dat
wizard := countBy[myData, {1, 2, 3, 4}];

myTally[data_, elems_:{}] := Composition[# /. {e_, n_} :> {e, n - Boole[MemberQ[elems, e]]} &, Sort, Tally, Join][#, elems] & /@ data;
kguler := myTally[myData, {1, 2, 3, 4}];


All the numbers for the timeings where found by looping many times over the code in order to get measurable timing per call. The random data was generated from SeedRandom[7529127].

1/10000*First[Do[jvincOuter, {10000}]; // AbsoluteTiming]


The asymptotic timing graph was created using(note the number of calls is larger when testing quicker calls):

testing=Hold[jvincOuter,jVquickCount,leonid2];
Table[
myData=RandomInteger[{1,4},{20,10^n}];
{10^n,timePerCall[Max[1,10^(4-n+1)]][testing[[i]]]}
,{i,1,3},{n,1,6}]//ListLogLogPlot

-
What is code? Without knowing it, the timings are IMO largely meaningless. If you repeat 10000 times a function call on a small (toy) list, it tells you nothing about the computational complexity of some solution for sizable lists, meaning that you are benchmarking applications to toy lists only. This is, of course, fine, if one is only interested in being ultra-fast on very small lists, but then chances are that bottlenecks will be elsewhere anyway. Normally, one is more interested in larger lists though, for benchmarking. Perhaps, you used large lists in your code, but how would we know? – Leonid Shifrin Feb 10 '13 at 20:52
This is not to detract from the beauty of your solution. However, it simply can not be generically as fast as Tally, because it repeats Count for any element in the list and any sublist, so is based on a fundamentally worse complexity algorithm. This is a second time I see rather meaningless benchamrks coming from you. I have a very high opinion of you as a Mma programmer, but please pay more attention when posting benchmarks - this is a sensitive topic and we want full objectiveness here. Thanks. And +1 for your solution ( but not benchmarks :-)). – Leonid Shifrin Feb 10 '13 at 20:56
Please see the rebuttal in my answer for an explanation of my statement. :^) – Mr.Wizard Feb 10 '13 at 21:58
That's actually a really nice method, one I should have thought of myself. +1 – Mr.Wizard Feb 10 '13 at 22:19
Wait, shouldn't Join[#, {1, 2, 3, 4}] be Join[{1, 2, 3, 4}, #]? – Mr.Wizard Feb 10 '13 at 22:20

Here is a semi-imperative solution:

a = Array[{#, 0}&, 4];
myFun[sublist_] := Block[{a = a}, Scan[++a[[#, 2]]&, sublist]; a]

myFun /@ myData
(*
{{{1, 8}, {2, 8}, {3, 3}, {4, 1}},
{{1, 9}, {2, 8}, {3, 3}, {4, 0}},
{{1, 8}, {2, 7}, {3, 3}, {4, 0}},
{{1, 8}, {2, 8}, {3, 4}, {4, 0}}}
*)

-