13
$\begingroup$

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!

Improve this question
$\endgroup$
4
  • 5
    $\begingroup$ You could do Outer[Count, myData, {1, 2, 3, 4}, 1] $\endgroup$ Commented Feb 9, 2013 at 22:02
  • 1
    $\begingroup$ @jVincent That's not at all efficient computationally, but it is efficient with keystrokes which you know I like! $\endgroup$ Commented Feb 10, 2013 at 16:54
  • 1
    $\begingroup$ @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. $\endgroup$ Commented Feb 10, 2013 at 19:52
  • 1
    $\begingroup$ @Mr.Wizard Also, my quick testing has it being faster than your posted solution and Leonids. Care to elaborate your claim of inefficiency? $\endgroup$ Commented Feb 10, 2013 at 20:01

8 Answers 8

Reset to default
9
$\begingroup$

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

Mathematica graphics

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]

Mathematica graphics

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}]

Mathematica graphics

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."

Improve this answer
$\endgroup$
2
  • $\begingroup$ 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. $\endgroup$ Commented Feb 10, 2013 at 22:06
  • $\begingroup$ 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. $\endgroup$ Commented Feb 11, 2013 at 4:51
12
$\begingroup$

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.

Improve this answer
$\endgroup$
7
  • $\begingroup$ 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. $\endgroup$ Commented Feb 10, 2013 at 22:05
  • $\begingroup$ @Mr.Wizard Have a look at my new version. $\endgroup$ Commented Feb 11, 2013 at 5:37
  • $\begingroup$ @jVincent You seem to not be getting it, even after both myself and Mr.Wizard tried our best to explain. Your tests via running the code 10000 times on the small toy lists are meaningless, because at that scale what you measure is determined not by the true complexity of an algorithm, but by things that become irrelevant for real list samples. Have a look at Mr.Wizard's benchmarks, for more or less real benchmarking. So, to reiterate once again: your statement is correct, but is only meaningful if the OP will only ever be interested in speeding up code consisting of 10000 iterations of a ... $\endgroup$ Commented Feb 11, 2013 at 10:22
  • 1
    $\begingroup$ @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. $\endgroup$ Commented Feb 11, 2013 at 12:09
  • 1
    $\begingroup$ @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. $\endgroup$ Commented Feb 11, 2013 at 12:15
10
$\begingroup$ 
 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}}} *)
Improve this answer
$\endgroup$
10
$\begingroup$

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.

Answer

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):

Profiling at representative input

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.

Profiling at large input

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.

Profiling with respect to sublist length

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
Improve this answer
$\endgroup$
6
  • 1
    $\begingroup$ 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? $\endgroup$ Commented Feb 10, 2013 at 20:52
  • 1
    $\begingroup$ 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 :-)). $\endgroup$ Commented Feb 10, 2013 at 20:56
  • $\begingroup$ Please see the rebuttal in my answer for an explanation of my statement. :^) $\endgroup$ Commented Feb 10, 2013 at 21:58
  • $\begingroup$ That's actually a really nice method, one I should have thought of myself. +1 $\endgroup$ Commented Feb 10, 2013 at 22:19
  • $\begingroup$ Wait, shouldn't Join[#, {1, 2, 3, 4}] be Join[{1, 2, 3, 4}, #]? $\endgroup$ Commented Feb 10, 2013 at 22:20
8
$\begingroup$

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}}} *)
Improve this answer
$\endgroup$
1
$\begingroup$ 
list = {{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}};

These Association - related functions, introduced 2014 with V 10.0

Sort @* KeyValueMap[List] /@ KeyUnion[Counts /@ list, 0 &]

give the expected result:

{{{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}}}
Improve this answer
$\endgroup$
1
$\begingroup$

Another possibility:

MapIndexed[{#2[[2]],#1}&,BinCounts[#,{1,5,1}]& /@ myData,{2}] (*{ {{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}} }*)
Improve this answer
$\endgroup$
1
$\begingroup$

This has a lot of answers already, but here's an obvious (to me) solution that hasn't been mentioned:

inds = Range[4]; Map[Transpose[{inds, #}]&] @ Lookup[ Counts /@ myData, inds, 0 ]
Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.