# combining and comparing lists

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.

-
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 –  The Toad 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

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

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

-
aaaah! I always forget ReplaceList! –  The Toad 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}};

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.

-

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] &;

{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}}} *)

-

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

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

-

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

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

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

-