8
$\begingroup$

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}.
$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – molekyla777 Oct 31 '14 at 8:18
  • $\begingroup$ Thank you. I corrected the typo. $\endgroup$ – user21814 Oct 31 '14 at 8:20
  • 1
    $\begingroup$ Does L1 always contains whole range 0 to n-1? $\endgroup$ – Kuba Oct 31 '14 at 8:43
  • $\begingroup$ 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. $\endgroup$ – user21814 Oct 31 '14 at 8:50
8
$\begingroup$
GatherBy[Union@Transpose@{L1, L2}, First][[;; , ;; , 2]]
$\endgroup$
  • $\begingroup$ Forget a day or 2. Good enough. Thank you. $\endgroup$ – user21814 Oct 31 '14 at 9:07
8
$\begingroup$
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], # &]
$\endgroup$
  • $\begingroup$ 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) $\endgroup$ – Michael E2 Oct 31 '14 at 12:44
5
$\begingroup$

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}|>*)
$\endgroup$
4
$\begingroup$
n = 4;
AdjacencyMatrix[Graph[Range[0, n - 1], Thread@DirectedEdge[L1, L2]]]["AdjacencyLists"] - 1
(* {{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.

$\endgroup$
3
$\begingroup$

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.

$\endgroup$
1
$\begingroup$

Another approach:

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

Alternatively DeleteDuplicates could be used.

$\endgroup$
0
$\begingroup$
Union[Pick[L2, L1, #]] & /@ Range[0, 3]

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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy