4
$\begingroup$

I have a list of the following form:

l = {{"label1", {1, 2, 3}}, {"label2", {4, 5}},
       {"label3", {3, 6, 9, 8}}, {"label4", {11, 25, 24, 14}}, {"lable5", {4, 5}}}

I would like to retrieve only those labels whose corresponding list has an intersection with the corresponding list of another label, along with the intersecting elements. So, for l I would get

{{"label1", "label2", "label3", "label5"}, {3, 4, 5}}

(I'll add my answer, but I'd like to see if someone can come up with a simpler one)

$\endgroup$
3
  • $\begingroup$ What are the constraints, if any, on contents? Is the list target always of the example format? Are the sublist values always positive integer, and if so, is there some reasonable limit on max values? Do you envision huge lists, or are the problem sizes small (like the example)? $\endgroup$
    – ciao
    Jun 15, 2014 at 23:25
  • $\begingroup$ @rasher The list is always in the example format and the problem size is relatively small (no more than 10 or 20 labels, with few elements in each sublist), but the sublist values could be integers or strings $\endgroup$
    – Daniel
    Jun 16, 2014 at 2:16
  • $\begingroup$ In that case, other than a terse code war, your solution is fine - plenty fast for such short lists. Interesting problem, nonetheless, when thinking about large lists. +1 on the question! $\endgroup$
    – ciao
    Jun 16, 2014 at 2:27

2 Answers 2

4
$\begingroup$

Perhaps a little "simpler", and a little quicker for smallish lists (it will blow up time-wise as list lengths grow, as does the OP method,) :

With[{i = Intersection @@@ Subsets[#[[All, 2]], {2}]}, {Union @@ 
       Pick[Subsets[#[[All, 1]], {2}], # != {} & /@ i], Union @@ i}] &@l

I'll throw this done while lounging quickie into the ring. It assumes the constraints I asked about in the comments hold (sublist values are positive integers) though if that's not the case it could be easily adapted to handle it. Not simpler, but certainly faster as list size grows.

intersectionInfo=
   Module[{s = SparseArray[Join @@ Thread /@ Transpose[{Range@Length@#, #[[All, 2]]}] -> 1],
           vals, lbls},
   vals = Pick[Range@Max@#[[All, 2]], UnitStep[Subtract[Total[s], 2]], 1];
   lbls = #[[All, 1]][[Pick[Range@Length@s, Unitize[Total /@ s[[All, vals]]], 1]]];
   {lbls, vals}] &;

(* use your example l *)
intersectionInfo@l

(* {{"label1", "label2", "label3", "lable5"}, {3, 4, 5}} *)

A quick run using a 5000 length list generated with

len = 5000;
l = Range@len;
subs = DeleteDuplicates /@ RandomInteger[{1, 10000}, {len, 5}];
l = Transpose[{l, subs}];

shows about a 700:1 performance advantage (grows as list size grows). N.B.: I used integer labels for convenience in the test, should have no material effect on timing differences.

$\endgroup$
0
$\begingroup$

The solution I've come up with is to first do

l = {{"label1", {1, 2, 3}}, {"label2", {4, 5}},
       {"label3", {3, 6, 9, 8}}, {"label4", {11, 25, 24, 14}}, {"lable5", {4, 5}}}

x = Select[l, MemberQ[#[[2]],
     Alternatives @@ Flatten[DeleteCases[l, #][[All, 2]]]] &]

to get the elements with intersections, then using

{ x[[All, 1]], Select[Gather@Flatten@x[[All, 2]], Length[#] > 1 &][[All, 1]] }

to get the correct format

$\endgroup$
2
  • $\begingroup$ What is z in the second block? Is that supposed to be x? $\endgroup$
    – ciao
    Jun 15, 2014 at 23:17
  • $\begingroup$ oh, yeah, thanks $\endgroup$
    – Daniel
    Jun 15, 2014 at 23:22

Your Answer

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

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