9
$\begingroup$

In ruby ,

1.upto(10).to_a.group_by{|x| x%3}

gives

{1=>[1, 4, 7, 10], 2=>[2, 5, 8], 0=>[3, 6, 9]}

I would like use patten replace as a hash table in Mathematica. For example:

{1 -> {1, 4, 7, 10}, 2 -> {2, 5, 8}, 0 -> {3, 6, 9}}

I know I can use GatherBy, but it only contains the value. I tried to solve and I feel it isn't efficient for a large list.

fun = Mod[#, 3] &;
Thread[fun /@ #[[All, 1]] -> #] &@GatherBy[Range[10], fun]
$\endgroup$
2
  • 1
    $\begingroup$ I don't know why you don't like GatherBy... I would probably write the second line as With[{fun = Mod[#, 3] &}, MapIndexed[fun@First@#2 -> # &, GatherBy[Range@10, fun]]] On my machine, it does 10^7 integers in under a second. $\endgroup$
    – rm -rf
    Nov 26, 2012 at 15:16
  • $\begingroup$ So it seems not slow indeed. $\endgroup$
    – chyanog
    Nov 26, 2012 at 15:57

6 Answers 6

6
$\begingroup$

You can use MapIndexed:

With[{fun = Mod[#, 3] &}, MapIndexed[fun@First@#2 -> # &, GatherBy[Range@10, fun]]]
(* {1 -> {1, 4, 7, 10}, 2 -> {2, 5, 8}, 0 -> {3, 6, 9}} *)

On my machine, this runs for $10^7$ integers in under a second, roughly on the same order as your own approach.


It can be made faster by noting that if you're using Mod[#, n]& as the function, your keys will be Range[0, n-1]. Hence, we don't really need to Thread or use MapIndexed when we can simply generate this list, do a ragged transpose using Flatten and apply Rule at the very end:

Rule @@@ With[{n = 3}, 
    {RotateLeft@Range[0, n - 1], GatherBy[Range[10], Mod[#, n] &]} ~Flatten~ {2}
]
(* {1 -> {1, 4, 7, 10}, 2 -> {2, 5, 8}, 0 -> {3, 6, 9}} *) 
$\endgroup$
1
  • $\begingroup$ Thinking about the nature of the problem itself vs. brute forcing it, always a +1 in my book. $\endgroup$
    – rcollyer
    Nov 26, 2012 at 19:07
7
$\begingroup$

I would use Reap and Sow for this, or more specifically a re-packaging of them, originally posted here:

SelectEquivalents[x_List,f_:Identity, g_:Identity, h_:(#2&)]:=
 Reap[Sow[g[#],{f[#]}]&/@x, _, h][[2]];

where the second argument is the (f) is the equivalence function, the third argument (g) transforms the data prior to being gathered, and the fourth argument (h) outputs the collection. Note, two arguments are passed to h, the first is the equivalence key and the second is the list of elements that match that key.

Then,

SelectEquivalents[Range@10, Mod[#,3]&, #&, #1 -> #2&]
(*{1 -> {1, 4, 7, 10}, 2 -> {2, 5, 8}, 0 -> {3, 6, 9}}*)

It should be noted, that this isn't a speed demon by any stretch of the imagination; clocking in at 24 secs on my machine, while RM's suggestion takes under a second.

$\endgroup$
12
  • 1
    $\begingroup$ +1 you really like 'SelectEquivalents[]', don't you? :) $\endgroup$ Nov 26, 2012 at 15:27
  • $\begingroup$ @belisarius yes I do, and it moves it from the ToolBag. $\endgroup$
    – rcollyer
    Nov 26, 2012 at 15:29
  • $\begingroup$ While it isn't necessarily fast, it is extremely flexible. Now we just need a packed form of Reap and Sow. $\endgroup$
    – rcollyer
    Nov 26, 2012 at 15:31
  • 2
    $\begingroup$ @belisarius Could you be so kind to explain what it means +1 since you haven't upvoted yet any answer today ??? $\endgroup$
    – Artes
    Nov 26, 2012 at 16:12
  • 2
    $\begingroup$ @Rojo I'm like the government. Always to blame, notwithstanding I do good or evil $\endgroup$ Nov 26, 2012 at 16:43
4
$\begingroup$
 fun = Mod[#, 3] &;
 selector = fun /@ Range[10];
 (# -> Pick[Range@10, selector, #]) & /@ DeleteDuplicates[selector]
 (* {1 -> {1, 4, 7, 10}, 2 -> {2, 5, 8}, 0 -> {3, 6, 9}}*) 

More generally,

 ClearAll[pickEquivalents];
 pickEquivalents[domain_, fun_] :=  With[{selector = fun /@ domain},
  With[{range = DeleteDuplicates[selector]},
 (# -> Pick[domain, selector, #]) & /@  range]]
 pickEquivalents[Range[10], Mod[#, 4] &]
 (* {1 -> {1, 5, 9}, 2 -> {2, 6, 10}, 3 -> {3, 7}, 0 -> {4, 8}} *)
$\endgroup$
1
  • $\begingroup$ I always forget about Pick. $\endgroup$
    – rcollyer
    Nov 27, 2012 at 12:28
3
$\begingroup$

Mathematica 10 introduced GroupBy which does exactly what you want:

a = GroupBy[Range@10, Mod[#, 3] &]
<|1 -> {1, 4, 7, 10}, 2 -> {2, 5, 8}, 0 -> {3, 6, 9}|>

The result is an Association which among other things can be used for replacement:

foo[2, bar[0, 1]] /. a
foo[{2, 5, 8}, bar[{3, 6, 9}, {1, 4, 7, 10}]]

Also:

a[2]
{2, 5, 8}
Lookup[a, {2, 1}]
{{2, 5, 8}, {1, 4, 7, 10}}
$\endgroup$
2
$\begingroup$
With[{fun = Mod[#, 3] &},
   Rule[fun[#1], {##}] & @@@ GatherBy[Range[10^6], fun]
   ]; // Timing

A neat way,but not fast.

GatherBy[Range[10^6], Mod[#, 3] &][[All, 1]] // Timing
(*{0.093, {1, 2, 3}}*)
#1 & @@@ GatherBy[Range[10^6], Mod[#, 3] &] // Timing
{0.234, {1, 2, 3}}
$\endgroup$
0
$\begingroup$

Not very efficient, but I like it:

Reap[# ~Sow~ fun@# & ~Scan~ Range@10, _, Rule][[2]]
{1 -> {1, 4, 7, 10}, 2 -> {2, 5, 8}, 0 -> {3, 6, 9}}
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.