Intersecting sublists in Mathematica

3
votes

I have the following two lists

l1 = {{{2011, 3, 13}, 1}, {{2011, 3, 14}, 1}, {{2011, 3, 15}, 
    1}, {{2011, 3, 16}, 2}, {{2011, 3, 17}, 3}};
l2 = {{{2011, 3, 13}, 40}, {{2011, 3, 16}, 50}, {{2011, 3, 17}, 60}};

and I need to extract items from l2 whose date (the first element of each l2 element) matches dates in l1 (so as to produce two lists of exactly the same length)

I don't see why something like:

Select[l1, MemberQ[Transpose[l2][[1]], #[[1]]]]

should produce an empty list. Am I missing something trivial?

5
wolfram-mathematicatranspose
Although my response is correct and was first, Sjoerd spotted the issue in your code (the missing ampersand) and thus gave a better answer to your question, in my view. So feel free to change your selection. - DavidC
radrat, I agree with David. Sjoerd is the one who answered your actual question, and I feel that it deserves your Accept. I posted what I feel is the cleanest method, and I hope it is helpful, but replies like David's and mine are ancillary to the matter. - Mr.Wizard

5 Answers

7
votes

You forgot the ampersand. It should be 

Select[l1, MemberQ[Transpose[l2][[1]], #[[1]]]&]
4
votes

Sjoerd shows you how to make your method work, but it is not optimal. The problem is that Transpose[l2][[1]] is evaluated again for every element in l1. David give a method which does that step only once. You could also use:

Cases[l1, {Alternatives @@ l2[[All, 1]], _}]
3
votes

A faster method for when your lists get bigger:

DeleteCases[GatherBy[Join[l1, l2], First], {_}][[All, 1]]

(*  Out= {{{2011, 3, 13}, 40}, {{2011, 3, 16}, 50}, {{2011, 3, 17}, 60}}  *)

If your list might contain duplicates, you can use the

l1 = GatherBy[l1, First][[All, 1]]

to remove the duplicates first.

2
votes

Is this possibly what you have in mind?

dates=Transpose[l2][[1]];
Cases[l1, {x_, _} /; MemberQ[dates, x]]
1
votes

Here is my non-sorting intersection code:

NonSortingIntersection[l1_, l2_, test_: SameQ] := 
 Module[{res = 
    Last@Reap[
      Scan[Extract[l1, 
         Position[l1, x_ /; test[x, #], {1}, 1, Heads -> False], 
         Sow] &, l2]]}, If[res === {}, res, First[res]]]

Here is the usage:

In[22]:= NonSortingIntersection[l1, l2, 
 Function[{x, y}, First[x] == First[y]]]

Out[22]= {{{2011, 3, 13}, 1}, {{2011, 3, 16}, 2}, {{2011, 3, 17}, 3}}

Notice that unlike other solutions the output is guaranteed to have length no longer that that of l2. For instance:

In[24]:= Cases[Join[l1, l1], {x_, _} /; MemberQ[Evaluate[Transpose[l2][[1]]], x]]

Out[24]= {{{2011, 3, 13}, 1}, {{2011, 3, 16}, 2}, {{2011, 3, 17}, 
  3}, {{2011, 3, 13}, 1}, {{2011, 3, 16}, 2}, {{2011, 3, 17}, 3}}

In[25]:= NonSortingIntersection[Join[l1, l1], l2, 
 Function[{x, y}, First[x] == First[y]]]

Out[25]= {{{2011, 3, 13}, 1}, {{2011, 3, 16}, 2}, {{2011, 3, 17}, 3}}

This may or may not be desirable, but this is up to radhat who knows his problem better.