Computing a map between two lists

What I want is a little difficult to explain. So I try to it with an example.

I have 2 lists, each of which has $(n-1)^2$ elements. Each element is an integer between 0 and $n-1$, inclusive.

For example for $n=4$:

L1 = {1,2,3,2,0,2,3,2,1}
L2 = {2,3,0,3,0,1,0,1,2}

From these lists I want to compute possible elements of L2 that correspond to an element of L1. The result is an ordered list with $n$ elements:

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

This means:

• If you select 0 from L1, the corresponding elements in L2 are {0}.
• If you select 1 from L1, the corresponding elements in L2 are {2}.
• If you select 2 from L1, the corresponding elements in L2 are {1,3}.
• If you select 3 from L1, the corresponding elements in L2 are {0}.
• for n=3 max element must be 2? In your exmaple L1:={1,2,3,2,0,2,3,2,1} with n=3max element is 3. – molekyla777 Oct 31 '14 at 8:18
• Thank you. I corrected the typo. – user21814 Oct 31 '14 at 8:20
• Does L1 always contains whole range 0 to n-1? – Kuba Oct 31 '14 at 8:43
• Good question! No, it does not. Some of the result elements could very well be empty: {}. In particular, for $n$ a large prime, there could be many empty sets. – user21814 Oct 31 '14 at 8:50

GatherBy[Union@Transpose@{L1, L2}, First][[;; , ;; , 2]]
• Forget a day or 2. Good enough. Thank you. – user21814 Oct 31 '14 at 9:07
Sort@Thread[L1 -> L2] ~Merge~ Union // Values
{{0}, {2}, {1, 3}, {0}}

After reading Kuba's answer I realize this could also be written:

Values @ Merge[Union @ Thread[L1 -> L2], # &]
• This is a nice representation of the problem, especially (imo) without the Values, in which it actually is a mapping instead of the OP's stripped down representation of one. (+1) – Michael E2 Oct 31 '14 at 12:44

With MMA10 this can be done by this code:

DeleteDuplicates /@ GroupBy[Transpose@{L1, L2}, First -> Last]
(*<|1 -> {2}, 2 -> {3, 1}, 3 -> {0}, 0 -> {0}|>*)
n = 4;
(* {{0}, {2}, {1, 3}, {0}} *)

Faster than I thought it would be, but not as fast as Kuba's when L1 and L2 are packed arrays.

The graph itself is a nice representation of the problem.

You can also use Nearest for this purpose:

r = Union /@ Nearest[L1 -> L2, Range[0, 3]]

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

A timing comparison with @Kuba's answer:

L1 = RandomInteger[1000,10^6];
L2 = RandomInteger[1000,10^6];

r1 = GatherBy[Union @ Transpose@{L1,L2}, First][[;; , ;; , 2]]; //AbsoluteTiming
r2 = Union /@ Nearest[L1 -> L2, Range[0, 1000]]; //AbsoluteTiming

r1===r2

{0.299931, Null}

{0.191812, Null}

True

So, a little bit faster.

Another approach:

Values[KeySort[Merge[Thread[L1 -> L2], Union]]]

Alternatively DeleteDuplicates could be used.

Union[Pick[L2, L1, #]] & /@ Range[0, 3]

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