Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I have 2 lists (of lists), where most of the contained lists match. That is, the lists contained in list1 mostly match the lists contained in list2. In this simplified example each of the inner lists has 3 elements. When a sub list of list1 and a sublist of list2 have their 1st 2 values the same, I want to compare the 3rd value. I have another list, "problems", that contains the first 2 elements of each sub list that creates a problem for me. My sample code follows:

problems = {{1, 2}, {1, 3}, {2, 2}};
list1 = {{1, 2, 12}, {1, 3, 13}, {1, 2, 14}, {4, 5, 11}};
list2 = {{1, 2, 22}, {1, 3, 23}, {2, 2, 26}, {4, 5, 11}, {1, 3, 13}};

want = {{1, 2, {12, 14}, {22}}, {1, 3, {13}, {13, 23}}, {2, 2, {}, {26}}};

list1a = Flatten[(Cases[list1, {#[[1]], #[[2]], __}] & /@ problems) /. {} -> {{}}, 1]
list1b = GatherBy[list1a, If[# == {}, True, {#[[1]], #[[2]]}] &] 

The list labelled "want" is what I'd like to get at the end of this. Actually, I just want to have something that will contain those 1st two elements, and then show the comparison of the 3rd elements. The GatherBy seems to be getting me closer to what I want, but I can't figure out how to correctly group it so that it looks like "want". I'm hoping that someone can suggest a better way to approach this.

share|improve this question
    
Why doesn't your want include the element {4,5,{11},{11}}? –  Jason B Nov 12 '13 at 19:57
    
@JasonB As I understand it, want only has those triplets from list1 and list2 whose first two elements are present in problems –  rm -rf Nov 12 '13 at 19:58
    
That's correct. problems already has the cases where the last elements don't match. So this isn't included because the {11}'s match. –  Mitchell Kaplan Nov 12 '13 at 20:01
    
@rm-rf, I get it, thanks. I posted an answer, though someone here could probably figure out how to do it without using Do loops. –  Jason B Nov 12 '13 at 20:01

9 Answers 9

up vote 5 down vote accepted
Function[{x, y}, {x, y, Sequence @@ (Last /@ Cases[#, {x, y, __}] & /@ {list1, list2})}] @@@ problems
(*
 {{1, 2, {12, 14}, {22}}, {1, 3, {13}, {23, 13}}, {2, 2, {}, {26}}}
*)
share|improve this answer
    
It's taken me until now to almost understand your previous solution, and now you've changed it! I'd like to ask a question about the previous one. It looks like the "a" and "b" are not really necessary - is this right, or were they there to handle some possible exception? Now I have to understand your new solution! –  Mitchell Kaplan Nov 13 '13 at 17:58
    
@MitchellKaplan I posted six different solutions. I think this one is the better. You can check all of them here mathematica.stackexchange.com/posts/36912/revisions . Sorry for the inconvenience –  belisarius Nov 13 '13 at 22:43
    
@MitchellKaplan Do you have a working version of the first incarnation without a and b? ... Post it here, perhaps you got a good one –  belisarius Nov 14 '13 at 2:01
    
@Balarius - no inconvenience at all. The solution that's currently posted above was easier for me to understand. I'll look at the revisions page next. –  Mitchell Kaplan Nov 14 '13 at 22:09
    
@Belasarius ({#} & /@ problems1) /. {x_} :> {Sequence @@ x, Sequence @@ (Select[#, #[[1 ;; 2]] == x &][[All, 3]] & /@ {list1, list2})} –  Mitchell Kaplan Nov 14 '13 at 22:18

Another rule based approach:

With[{rules = Map[Most@# -> Last@# &, {list1, list2}, {2}]}, 
 Sequence @@@ {#, ReplaceList[#, rules]} & /@ problems]

(*  {{1, 2, {12, 14}, {22}}, {1, 3, {13}, {23, 13}}, {2, 2, {}, {26}}}  *)
share|improve this answer
    
aaaah! I always forget ReplaceList! –  rm -rf Nov 12 '13 at 20:55
    
@rm-rf, I nearly did too. I spent a good couple of minutes staring at the screen thinking "if only there was a function that attempts to transform the entire expression by applying a rule or list of rules in all possible ways, and returns a list of the results obtained" :-) –  Simon Woods Nov 12 '13 at 21:01
    
Hm... very nice. I should go back to lurking. –  Mr.Wizard Nov 13 '13 at 21:26

Something like this?

problems = {{1, 2}, {1, 3}, {2, 2}};
list1 = {{1, 2, 12}, {1, 3, 13}, {1, 2, 14}, {4, 5, 11}};
list2 = {{1, 2, 22}, {1, 3, 23}, {2, 2, 26}, {4, 5, 11}, {1, 3, 13}};

MapThread[Join, {problems, 
  Thread[Last @ Reap[Sow[Last @ #, Hold @@ Most @ #] & /@ #, Hold @@@ problems, 
       Sequence @@ #2 &] & /@ {list1, list2}]}]

(* {{1, 2, {12, 14}, {22}}, {1, 3, {13}, {23, 13}}, {2, 2, {}, {26}}} *)

The Hold is merely because tags can't have the head List: Sow treats such an argument as a list of tags.

share|improve this answer

To solve list manipulation problems that are not large (i.e., you don't have lists that are millions and millions of elements long), but are carried out often and have a well defined structure, I prefer using rules and patterns, so that the series of transformations is clear. This helps when you want to return to the code months later to account for changes in requirements.

Here's how you can build it up (final module at the end). You'll need:

  • A function to group the triplets in each list into a pair (first two + third):

    pairUp = # /. {a_, b_, c_} :> {{a, b}, c} &;
    
    r1 = pairUp@list1
    (* {{{1, 2}, 12}, {{1, 3}, 13}, {{1, 2}, 14}, {{4, 5}, 11}} *)
    
  • A function that takes these pairs and groups the third elements corresponding to the same first two elements:

    group = GatherBy[#, First] /. l : {{h : {_, _}, _} ..} :> {h, Last /@ l} &;
    
    r2 = group@r1
    (* {{{1, 2}, {12, 14}}, {{1, 3}, {13}}, {{4, 5}, {11}}} *)
    
  • A function that takes the above groups and converts it to a list of rules. The "null rule" (default rule) is tacked on to the end of the list. This replacement will be made only if there isn't a rule for the pair earlier in the list.

    toRules = With[{null = # -> {} & /@ problems}, Rule @@@ #~Join~null] &;
    
    step3 = toRules@r2
    (* {{1, 2} -> {12, 14}, {1, 3} -> {13}, {4, 5} -> {11}, {1, 2} -> {}, {1,3} -> {}, {2, 2} -> {}} *)
    
  • A function that applies these rules for each list and merges them in the order you desire.

Combing it into a Module:

compare[lists_List, problems_] := Module[{pairUp, group, toRules},
    pairUp = # /. {a_, b_, c_} :> {{a, b}, c} &;
    group = GatherBy[#, First] /. l : {{h : {_, _}, _} ..} :> {h, Last /@ l} &;
    toRules = With[{null = # -> {} & /@ problems}, Rule @@@ # ~Join~ null] &;

    MapThread[Join,
        {problems, Transpose[Composition[problems /. # &, toRules, group, pairUp] /@ lists]}
    ]
]

Call this function as:

compare[{list1, list2}, problems]
(* {{1, 2, {12, 14}, {22}}, {1, 3, {13}, {23, 13}}, {2, 2, {}, {26}}} *)
share|improve this answer

Very similar to Michael's answer but I wrote it independently:

combine[p_, lists__] :=
  Last @ Reap[#3 ~Sow~ {{#, #2}} & @@@ #, p, ##& @@ #2 &] & /@ {lists} // 
    Join[p, #\[Transpose], 2] &

combine[problems, list1, list2]
{{1, 2, {12, 14}, {22}}, {1, 3, {13}, {23, 13}}, {2, 2, {}, {26}}}

Update for Mathematica 10, using Associations:

ascs = GroupBy[#, Most -> Last] & /@ {list1, list2};

Join[#, Lookup[ascs, #, {}]\[Transpose], 2] & @ problems
{{1, 2, {12, 14}, {22}}, {1, 3, {13}, {23, 13}}, {2, 2, {}, {26}}}
share|improve this answer
problems = {{1, 2}, {1, 3}, {2, 2}};
list1 = {{1, 2, 12}, {1, 3, 13}, {1, 2, 14}, {4, 5, 11}};
list2 = {{1, 2, 22}, {1, 3, 23}, {2, 2, 26}, {4, 5, 11}, {1, 3, 13}};

f[list_] := {Sequence @@ #[[1, 1 ;; 2]], #[[All, 3]]} & /@ GatherBy[list, #[[1 ;; 2]] &]

res[list1_, list2_] := First[{{}, f[list1], f[list2]} //. {{
       {r : ___},
       {r1 : ___, {a_, b_, x_}, r2 : ___},
       {r3 : ___, {a_, b_, y_}, r4 : ___}
       } /; MemberQ[problems, {a, b}] :> {{r, {a, b, x, y}}, {r1, r2}, {r3, r4}},
       {{r : ___}, {{a_, b_, x_}, r1 : ___}, {r2 : ___}
       } /; MemberQ[problems, {a, b}] :> {{r, {a, b, x, {}}}, r1, r2},
       {{r : ___}, {r1 : ___}, {{a_, b_, x_}, r2 : ___}
       } /; MemberQ[problems, {a, b}] :> {{r, {a, b, {}, x}}, r1, r2}
    }]

res[list1, list2]

(*
{{1, 2, {12, 14}, {22}}, {1, 3, {13}, {23, 13}}, {2, 2, {}, {26}}}
*)
share|improve this answer

f returns the information regarding problem p and lists l1, l2.

f[l1_,l2_,p_]:=Sequence@@@Append[p,Cases[#,x_/;(Most@x==p):> x[[-1]]]&/@{l1,l2}]

f[list1,list2,#]&/@problems

{{1, 2, {12, 14}, {22}}, {1, 3, {13}, {23, 13}}, {2, 2, {}, {26}}}

share|improve this answer
    
Nice one. Just a small detail: you need a Sequence@@ on the last component of each list to be compliant with the OP's desired format +1 –  belisarius Nov 13 '13 at 22:46
    
Good catch. I didn't look carefully enough at the format. btw, now I see that my answer follows the same general reasoning as yours. –  David Carraher Nov 14 '13 at 0:38

This is probably the ugly way to do this, but it gets to what you want.

problems = {{1, 2}, {1, 3}, {2, 2}};
list1 = {{1, 2, 12}, {1, 3, 13}, {1, 2, 14}, {4, 5, 11}};
list2 = {{1, 2, 22}, {1, 3, 23}, {2, 2, 26}, {4, 5, 11}, {1, 3, 13}};

third1 = third2 = Table[{}, {Length[problems]}];

Do[
  Do[
    If[list1[[n, ;; 2]] == problems[[m]], 
     AppendTo[third1[[m]], list1[[n, 3]]]]
    , {m, Length[third1]}];
  , {n, Length[list1]}];

Do[
  Do[
    If[list2[[n, ;; 2]] == problems[[m]], 
     AppendTo[third2[[m]], list2[[n, 3]]]]
    , {m, Length[third2]}];
  , {n, Length[list2]}];

Flatten[#, 1] & /@ Transpose[{problems, Transpose[{third1, third2}]}]
share|improve this answer
    
thanks that does work. I'm trying to become more comfortable by not using Do, etc., so I didn't even think of that. So I can solve my problem. My lists are pretty small, so a Do doesn't really hurt. Now I'll look at the more mind damaging suggestions. –  Mitchell Kaplan Nov 12 '13 at 20:33
        fun[pos_List, v_List, g_List] := 
         Block[{a, k, list1 = v, list2 = g, d1, problems = pos, b, c, h, j, d, d0, y, h1, j1, df1, 
           final}, {
           h = DeleteDuplicates[#] & /@ (Flatten[#, 1] & /@ 
           GatherBy[Join @@ {{#, {}} & /@ problems, list1} /. {a_, b_,c_} -> {{a,b}, c}, First] //. {y_, {}, c_, d___} -> {y, c, d}),
           h1 = MemberQ[problems, First[#], 2] & /@ h,
           h = Pick[h, h1, True],
           j = DeleteDuplicates[#] & /@ (Flatten[#, 1] & /@ 
                GatherBy[ Join @@ {{#, {}} & /@ problems, list2} /. {a_, b_, c_} -> {{a, b}, c}, First] //. {y_, {}, c_, d___} -> {y, c, d}),
           j1 = MemberQ[problems, First[#], 2] & /@ j,
           j = Pick[j, j1, True], d0 = {h, j}, 
           d1 = Table[{First[d0[[i, j]]], Rest[d0[[i, j]]]}, {i, 1, 
              Length[d0]}, {j, 1, Length[d0[[i]]]}], 
           df1 = Flatten[#, 1] & /@ 
              GatherBy[SortBy[Flatten[d1, 1], First], First] //. {{___, f_List, x_Integer, ___}} -> {x}, 
           final = Map[{Sequence @@ First[#], Sequence @@ Rest[#]} &, 
              DeleteDuplicates[#] & /@ df1, {1}] /. {___ {} ___} -> {}}; 
          final]

{{1, 2, {22}, {12, 14}}, {1, 3, {13}, {23, 13}}, {2, 2, {26}, {}}}

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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