# More efficient way of generating list of occurrence counts?

Given a list, e.g., target = {a, b, c, b, c, d, c, d, e, f, a, h, g}, I want to generate a list containing the occurrence count of the corresponding element of the target list, e.g., {1, 1, 1, 2, 2, 1, 3, 2, 1, 1, 2, 1, 1} for the example target. Target elements can be pretty much anything: atoms, sublists, etc. I'm using result = Module[{c}, c[_] = 0; ++c[#] & /@ #] &[target] which works fine, but wonder if the wizards have a more efficient way.

Update: Came up with this while 'cigar thinking':

result = Module[{ordarg, ord},
ordarg[[ord]] =
Flatten[Range /@ (Tally[ordarg = #[[ord = Ordering[#]]]][[All, 2]])];
ordarg] &[target];


On numeric/symbol/etc. items, this clobbers my original method by orders of magnitude with large lists. It is also 2-3+ times faster even then the most excellent compiled example provided below by L.S. Interestingly, my original method is faster than this or the compiled version for string/character data. (L.S./M.W. et al, perhaps you can illuminate this?)

This is plenty fast for my needs, though I'm still of course interested in the real masters' ideas.

• If you know what head the elements have I have found the rule-based version of your method to be a tiny bit faster: Module[{count}, count[_] = 0; List @@ (target /. a_String :> ++count[a])]. Versions that work for any head that I could find is tiny bit slower. Jan 14, 2014 at 4:39
• @Anon: Yep, I've done that, but as said in OP, elements can be pretty much anything that would make sense, and be mixed. Thanks for commenting in any case!
– ciao
Jan 14, 2014 at 4:50
• Nice update. I was thinking in this direction too, but didn't have the time to really track it to the end (looks like I am getting old :)). As to why your original method is faster on your tests for strings, I can't really comment on that with certainty, since my benchmarks give the opposite results. One possibility is that you have low average repetition count (close to 1), then it might be that Dispatch in my solution becomes slower and consumes most of run time. Jan 14, 2014 at 10:22
• Also, you may consider posting your solution from the edit, and perhaps accepting it later, if this ends up the best one for you. Self-answering is a normal practice here. Jan 14, 2014 at 10:24
• I'd also like to know why manipulating downvalues seems to be faster when the argument/key (however you want to call it) is a string rather than a symbol. I noticed this before myself, but couldn't imagine why it could be and then forgot all about it until you brought it up again. Perhaps some time is saved by not having to check for possible upvalues? Jan 15, 2014 at 4:28

I think that c[_] = 0; ++c[#] & /@ list is a perfectly good method and one that I make use of myself. There is an advantage in the fact that it can be interrupted or continued at any time, and it keeps a running count of the elements in the DownValues of c. (If not using Module that is.) Therefore I think it is a nice general method. One may alternately use either Scan or Map as needed in these incremental uses.

Nevertheless, your Ordering approach is quite clever and makes use of lower-level System functions and well optimized vector operations to do the work. (I imagine I'll starting using it myself; thanks!) General methods are often not optimal, especially in numeric cases, because often numeric data must be unpacked and handled at the top level rather than being operated on at a lower level by specialized functions. Even when data is not unpacked the low level code behind most system function (such as Ordering) can be expected to be faster than top-level code. See Leonid's answer to How are MemberQ and FreeQ so fast? for some interesting notes about this, especially a kind of middle ground.

Your code looks good and I don't see much room for improvement, except that Join is faster than Flatten on packed arrays (as produced by Range), and that I would write it a little differently:

f3 =
Module[{ord = Ordering @ #},
ord[[ord]] = Join @@ Range /@ Tally[ #[[ord]] ][[All, 2]];
ord
] &;


Compared to your own functions as f1 and f2:

f1 = Module[{c}, c[_] = 0; ++c[#] & /@ #] &;

f2 =
Module[{ordarg, ord},
ordarg[[ord]] =
Range /@ Tally[ordarg = #[[ord = Ordering[#]]]][[All, 2]] // Flatten;
ordarg
] &;

list = RandomInteger[99999, 3500000];

First @ Timing @ #[list] & /@ {f1, f2, f3}

{6.646, 1.107, 0.593}

• Thank you for the analysis! As usual, I learn something new from you, L.S., and the rest (join > flatten for this). It would be nice were there a single 'cheat card' where such info was condensed.
– ciao
Jan 15, 2014 at 0:00
• @rasher You're welcome. A "cheat card" as you call it has been discussed before, but my memory fails me as to when and where. I think it could be very helpful too. It would be important for it not to turn into a book-length document as there are already a number of good books on Mathematica programming, yet it would also need to be both extensive and descriptive enough to genuinely be of value. Let me think about this. Jan 15, 2014 at 10:32

Well, you can trade memory for speed and use Compile, as follows:

accumC =
Compile[{{l, _Integer, 1}, {max, _Integer}},
Module[{accum = Table[0, {max}], res = Table[0, {Length[l]}]},
Do[res[[i]] = ++accum[[l[[i]]]], {i, Length[l]}];
res
]
]

ClearAll[occurrences];
occurrences[lst_List] :=
With[{rules =  Thread[# -> Range[Length[#]]] &@Union[lst]},
accumC[ lst /. Dispatch[rules],Length[rules]]
]


Basically, this is the same idea that you are using, but I use an array for counters instead of a hash table, so this is faster because array lookup is much faster than a hash lookup (objective matter), and also because I avoid explicit top-level looping (Mathematica-specific matter). The bottleneck in this solution is in the lst /. Dispatch[rules] and Dispatch itself, but this is rather fast because no explicit looping is needed.

Benchmarks:

(result = Module[{c}, c[_] = 0; ++c[#] & /@ #] &[target]); // AbsoluteTiming

(* {0.030085, Null} *)

(result1 = occurrences[target]); // AbsoluteTiming

(* {0.006266, Null} *)

result1 == result

(* True *)


Compilation to C is unlikely to dramatically improve matters (because, as I said, the bottleneck is now not in accumC), but still may give another 1.5 - 2x speedup.

• Neat solution - see my update to OP (typing now...).
– ciao
Jan 14, 2014 at 9:57
• Was thinking along these lines as I went to bed but you beat me to it by the morning. +1 Jan 14, 2014 at 14:20

Here are a few possibilities:

MapThread[Count, {Take[target, #] & /@ Range@Length@target, target}]


{1, 1, 1, 2, 2, 1, 3, 2, 1, 1, 2, 1, 1}

MapThread[Count, {Reverse@NestList[Most, target, Length@target - 1], target}]


{1, 1, 1, 2, 2, 1, 3, 2, 1, 1, 2, 1, 1}

And my favorite:

MapThread[Coefficient, {Accumulate[target], target}]


{1, 1, 1, 2, 2, 1, 3, 2, 1, 1, 2, 1, 1}

Although possibly more "mathematica-esque" these approaches are all quite a bit slower than yours.

f1[target_] := Module[{c}, c[_] = 0; ++c[#] & /@ #] &[target]
f2[target_] :=
MapThread[Count, {Take[target, #] & /@ Range@Length@target, target}]
f3[target_] :=
Count, {Reverse@NestList[Most, target, Length@target - 1], target}]

target = RandomChoice[CharacterRange["a", "z"], 10000];

f1[target]; // AbsoluteTiming
f2[target]; // AbsoluteTiming
f3[target]; // AbsoluteTiming
f4[target]; // AbsoluteTiming


{0.031002, Null}

{1.700097, Null}

{1.700097, Null}

{0.134008, Null}

• The last one is clever!
– ciao
Jan 14, 2014 at 4:09

Fast, but still not as fast as the code in the question:

f5[target_] := Module[{n = Length[target], res},
res = ConstantArray[0, n];
Scan[(res[[#]] = Range@Length@#) &,
res]


Perhaps:

q[u_] := Count[{u}, u];
q[#]++ & /@ target


This yields:

{1, 1, 1, 2, 2, 1, 3, 2, 1, 1, 2, 1, 1}

Testing a larger example:

tgt = RandomChoice[CharacterRange["a", "z"], 100]


yields:

{"j", "z", "g", "l", "d", "r", "o", "v", "n", "s", "h", "r", "v", \
"y", "f", "n", "g", "y", "l", "u", "v", "c", "n", "a", "y", "y", "g", \
"v", "g", "d", "d", "h", "s", "b", "f", "r", "n", "j", "u", "b", "d", \
"z", "p", "q", "o", "j", "g", "p", "y", "d", "p", "r", "s", "g", "v", \
"f", "k", "v", "z", "b", "g", "k", "n", "p", "l", "o", "d", "i", "b", \
"w", "k", "t", "t", "b", "n", "e", "y", "g", "w", "l", "x", "t", "b", \
"n", "x", "a", "c", "u", "s", "a", "w", "l", "q", "u", "n", "p", "f", \
"z", "o", "j"}


Now,

q[#]++ & /@ tgt


yields:

{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 1, 1, 2, 2, 2, 2, 1, 3, 1, 3, \
1, 3, 4, 3, 4, 4, 2, 3, 2, 2, 1, 2, 3, 4, 2, 2, 2, 4, 2, 1, 1, 2, 3, \
5, 2, 5, 5, 3, 4, 3, 6, 5, 3, 1, 6, 3, 3, 7, 2, 5, 4, 3, 3, 6, 1, 4, \
1, 3, 1, 2, 5, 6, 1, 6, 8, 2, 4, 1, 3, 6, 7, 2, 2, 2, 3, 4, 3, 3, 5, \
2, 4, 8, 5, 4, 4, 4, 4}


and Tally[tgt]:

Confirms:

{{"j", 4}, {"z", 4}, {"g", 8}, {"l", 5}, {"d", 6}, {"r", 4}, {"o",
4}, {"v", 6}, {"n", 8}, {"s", 4}, {"h", 2}, {"y", 6}, {"f",
4}, {"u", 4}, {"c", 2}, {"a", 3}, {"b", 6}, {"p", 5}, {"q",
2}, {"k", 3}, {"i", 1}, {"w", 3}, {"t", 3}, {"e", 1}, {"x", 2}}


Note: need to clear each time else will continue to increment.

• I'm scratching my head here, perhaps I'm missing something, but the Count... does nothing but eat time. Just making it q[u_] := 1 gives the identical result.
– ciao
Jan 14, 2014 at 10:15
• @rasher Yes the point of the q[x] is 1 but when mappeed with the Increment, each time it encounters, e,g, a it incerements the prvenious value of q[a] and so forth. I have closed kernel and rerun and this produces the desired result as far as I can see. Just to be explicit first time q[a]=1 (as you state), second time it increments q[a], i.e. counts Jan 14, 2014 at 10:22
• NVM - had a brain-fart: I'd cut-n-pasted your code to test, neglected to clear the q definitions, so it appeared replacing the count with 1 made a difference, which had me puzzled. DOH! Thanks for the answer and comment reply!
– ciao
Jan 14, 2014 at 10:32
• @rasher...there is no problem:) Jan 14, 2014 at 10:36