9
$\begingroup$

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.

Improve this question
$\endgroup$
4
  • $\begingroup$ Why doesn't your want include the element {4,5,{11},{11}}? $\endgroup$
    – Jason B.
    Nov 12, 2013 at 19:57
  • $\begingroup$ @JasonB As I understand it, want only has those triplets from list1 and list2 whose first two elements are present in problems $\endgroup$
    – rm -rf ♦
    Nov 12, 2013 at 19:58
  • $\begingroup$ 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. $\endgroup$
    – Mitchell Kaplan
    Nov 12, 2013 at 20:01
  • $\begingroup$ @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. $\endgroup$
    – Jason B.
    Nov 12, 2013 at 20:01

9 Answers 9

Reset to default
6
$\begingroup$ 
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}}}
*)
Improve this answer
$\endgroup$
6
  • $\begingroup$ 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! $\endgroup$
    – Mitchell Kaplan
    Nov 13, 2013 at 17:58
  • $\begingroup$ @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 $\endgroup$
    – Dr. belisarius
    Nov 13, 2013 at 22:43
  • $\begingroup$ @MitchellKaplan Do you have a working version of the first incarnation without a and b? ... Post it here, perhaps you got a good one $\endgroup$
    – Dr. belisarius
    Nov 14, 2013 at 2:01
  • $\begingroup$ @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. $\endgroup$
    – Mitchell Kaplan
    Nov 14, 2013 at 22:09
  • $\begingroup$ @Belasarius ({#} & /@ problems1) /. {x_} :> {Sequence @@ x, Sequence @@ (Select[#, #[[1 ;; 2]] == x &][[All, 3]] & /@ {list1, list2})} $\endgroup$
    – Mitchell Kaplan
    Nov 14, 2013 at 22:18
8
$\begingroup$

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}}}  *)
Improve this answer
$\endgroup$
3
  • $\begingroup$ aaaah! I always forget ReplaceList! $\endgroup$
    – rm -rf ♦
    Nov 12, 2013 at 20:55
  • $\begingroup$ @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" :-) $\endgroup$
    – Simon Woods
    Nov 12, 2013 at 21:01
  • $\begingroup$ Hm... very nice. I should go back to lurking. $\endgroup$
    – Mr.Wizard
    Nov 13, 2013 at 21:26
6
$\begingroup$

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.

Improve this answer
$\endgroup$
5
$\begingroup$

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}}} *)
Improve this answer
$\endgroup$
3
$\begingroup$

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}}}
Improve this answer
$\endgroup$
2
$\begingroup$ 
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}}}
*)
Improve this answer
$\endgroup$
2
$\begingroup$

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}}}

Improve this answer
$\endgroup$
2
  • $\begingroup$ 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 $\endgroup$
    – Dr. belisarius
    Nov 13, 2013 at 22:46
  • $\begingroup$ 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. $\endgroup$
    – DavidC
    Nov 14, 2013 at 0:38
1
$\begingroup$

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}]}]
Improve this answer
$\endgroup$
1
  • $\begingroup$ 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. $\endgroup$
    – Mitchell Kaplan
    Nov 12, 2013 at 20:33
0
$\begingroup$ 
        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}, {}}}

Improve this answer
$\endgroup$

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.