8
$\begingroup$

I have two lists: 

list1 = {{1, A, AA}, {2, B, BB}, {3, C, CC}, {4, D, DD}, {6, F, FF}};

list2 = {{1, a, aa}, {1, b, bb}, {1, c, cc}, {2, d, dd}, {2, e, ee}, {3, f, ff}, 
         {3, g, gg}, {3, h, hh}, {4, i, ii}, {4, j, jj}, {4, k, kk}, {4, l, ll}, 
         {4, m, mm}, {5, n, nn}, {5, o, oo}, {7, p, pp}};

I want to merge these two lists. While merging list1 to list2, elements of list1 should be repeated or missing as shown below:

result = {{1, a, aa, A, AA}, {1, b, bb, A, AA}, {1, c, cc, A, AA}, {2, d, dd, B, BB}, 
          {2, e, ee, B, BB}, {3, f, ff, C, CC}, {3, g, gg, C, CC}, {3, h, hh, C, CC}, 
          {4, i, ii, D, DD}, {4, j, jj, D, DD}, {4, k, kk, D, DD}, {4, l, ll, D, DD}, 
          {4, m, mm, D, DD}, {5, n, nn, Missing[], Missing[]}, 
          {5, o, oo, Missing[], Missing[]}, {6, Missing[], Missing[], F, FF}, 
          {7, p, pp, Missing[], Missing[]}};

Any help is greatly appreciated. Similarly, if we can merge above two lists plus the following list in a similar manner in one step, please help me. 

list3 = {{2, .2, 20}, {3, .3, 30}, {4, .4, 40}, {5,.5, 50}, {6, .6, 60}};

Thank you all in advance.

Improve this question
$\endgroup$
1
  • $\begingroup$ Thanks Karsten 7 for editing my question. I wanted to put my question as you edited but I don't know. I am very new user of Mathematica. Just two months since I started Mathematica. $\endgroup$
    – ramesh
    Commented Sep 19, 2014 at 0:58

6 Answers 6

Reset to default
4
$\begingroup$

Approach using v10 functions:

CustomMerge1[lists__] := Module[{assocList, keys, vals, res},
   assocList = GroupBy[#, First -> Rest] & /@ {lists};
   keys = Sort@DeleteDuplicates[Flatten[Keys /@ assocList]];
   res = Table[
     vals = #[k] /. Missing[___] -> {{Missing[], Missing[]}} & /@ 
       assocList;
     Flatten /@ Tuples[{{k}, Sequence @@ vals}]
     , {k, keys}];
   Flatten[res, 1]
   ];
CustomMerge1[list1, list2, list3]
(*{{1, A, AA, a, aa, Missing[], Missing[]}, {1, A, AA, b, bb, Missing[],
   Missing[]}, {1, A, AA, c, cc, Missing[], Missing[]}, {2, B, BB, d, 
  dd, 0.2, 20}, {2, B, BB, e, ee, 0.2, 20}, {3, C, CC, f, ff, 0.3, 
  30}, {3, C, CC, g, gg, 0.3, 30}, {3, C, CC, h, hh, 0.3, 30}, {4, D, 
  DD, i, ii, 0.4, 40}, {4, D, DD, j, jj, 0.4, 40}, {4, D, DD, 4, kk, 
  0.4, 40}, {4, D, DD, l, ll, 0.4, 40}, {4, D, DD, m, mm, 0.4, 
  40}, {5, Missing[], Missing[], n, nn, 0.5, 50}, {5, Missing[], 
  Missing[], o, oo, 0.5, 50}, {6, F, FF, Missing[], Missing[], 0.6, 
  60}, {7, Missing[], Missing[], p, pp, Missing[], Missing[]}}*)

As you see this function work with any number of input lists

Improve this answer
$\endgroup$
3
  • $\begingroup$ @@molekyla Thanks for your answer . $\endgroup$
    – ramesh
    Commented Sep 19, 2014 at 13:15
  • $\begingroup$ simple and fast. $\endgroup$
    – ramesh
    Commented Sep 19, 2014 at 14:20
  • $\begingroup$ Works for two lists as well as three lists. $\endgroup$
    – ramesh
    Commented Sep 19, 2014 at 14:33
3
$\begingroup$

First augment each list to fill in any Missing items. Then work through fulllist2 to insert matching items from fulllist1. To complete the extra credit part of your question you could use a similar method to join corresponding elements of your list1 and list3 before before or after doing the augmentation and use this result in the join process with fulllist1.

list1 = {{1, A, AA}, {2, B, BB}, {3, C, CC}, {4, D, DD}, {6, F, FF}};
list2 = {{1, a, aa}, {1, b, bb}, {1, c, cc}, {2, d, dd}, {2, e, ee}, {3, f, ff},
  {3, g, gg}, {3, h, hh}, {4, i, ii}, {4, j, jj}, {4, k, kk}, {4, l, ll},
  {4, m, mm}, {5, n, nn}, {5, o, oo}, {7, p, pp}};

u = Union[Map[First, Join[list1, list2]]];
fulllist1 = Join[list1, Map[{#,Missing[], Missing[]}&, Complement[u, Map[First, list1]]]];
fulllist2 = Join[list2, Map[{#, Missing[], Missing[]}&, Complement[u, Map[First, list2]]]];
Sort[Map[Join[#, Rest[First[Cases[fulllist1, {First[#], __}]]]] &, fulllist2]]

 {{1, a, aa, A, AA}, {1, b, bb, A, AA}, {1, c, cc, A, AA}, {2, d, dd, B, BB},
  {2, e, ee, B, BB}, {3, f, ff, C, CC}, {3, g, gg, C, CC}, {3, h, hh, C, CC},
  {4, i, ii, D, DD}, {4, j, jj, D, DD}, {4, k, kk, D, DD}, {4, l, ll, D, DD},
  {4, m, mm, D, DD}, {5, n, nn, Missing[], Missing[]},
  {5, o, oo, Missing[], Missing[]}, {6, Missing[], Missing[], F, FF},
  {7, p, pp, Missing[], Missing[]}}

Edit

Code to merge your three lists

list1 = {{1, A, AA}, {2, B, BB}, {3, C, CC}, {4, D, DD}, {6, F, FF}};
list2 = {{1, a, aa}, {1, b, bb}, {1, c, cc}, {2, d, dd}, {2, e, ee}, {3, f, ff},
  {3, g, gg}, {3, h, hh}, {4, i, ii}, {4, j, jj}, {4, k, kk}, {4, l, ll},
  {4, m, mm}, {5, n, nn}, {5, o, oo}, {7, p, pp}};
list3 = {{2, .2, 20}, {3, .3, 30}, {4, .4, 40}, {5, .5, 50}, {6, .6, 60}};

u = Union[Map[First, Join[list1, list2, list3]]];
fulllist1 = Join[list1, Map[{#, Missing[], Missing[]} &, Complement[u, Map[First, list1]]]];
fulllist2 = Join[list2, Map[{#, Missing[], Missing[]} &, Complement[u, Map[First, list2]]]];
fulllist3 = Join[list3, Map[{#, Missing[], Missing[]} &, Complement[u, Map[First, list3]]]];
Sort[Map[Join[#, Rest[First[Cases[fulllist1, {First[#], __}]]], 
  Rest[First[Cases[fulllist3, {First[#], __}]]]] &, fulllist2]]

As always there are at least a dozen different ways of writing anything in Mathematica.

Improve this answer
$\endgroup$
5
  • $\begingroup$ Bill thank you for your time. Your example codes works perfectly for my sample question. However, when I applied it to my big data set in which I have list1 is 21630 by 29 and lsit2 is 3749733 by 10, it breaks down. It does not work. $\endgroup$
    – ramesh
    Commented Sep 19, 2014 at 2:26
  • $\begingroup$ "it breaks down. It does not work." is somewhat vague, similar to questions a few people post: "I typed some stuff in, some stuff came out, it's wrong. what do I do?" Learning how to track down and identify the key details that will lead you to pinpointing the problem is a critical skill to learn. At least you provided a concrete example problem. That is very good. All too often the result is "that works, but that isn't what my real problem was." So go through your real result, identify the errors, look for a pattern in them. Then was each fulllist correct? The rest is a single line of code. $\endgroup$
    – Bill
    Commented Sep 19, 2014 at 2:37
  • $\begingroup$ Are you sure you have no "duplicate keys" in list1? In other words, is Length[list1] == Length[Union[Map[First, list1]]] True? or False? Duplicate keys in list1 could break my code. I assumed unique keys in list1 based on your example. $\endgroup$
    – Bill
    Commented Sep 19, 2014 at 2:45
  • $\begingroup$ Bill thanks for for your suggestion. By the way, I don't have duplicate key in list1 and my data it too big. Therefore, it takes time to figure out. I also have missing data all over. I don't know the exact position of missing data. I will get back to you tomorrow as soon as I figure out. Thanks again. $\endgroup$
    – ramesh
    Commented Sep 19, 2014 at 2:49
  • $\begingroup$ @ Bill I was able to run your code to my big data. It took long time to complete. Thank you again. From speed point of view, molekyla777's answer is faster. $\endgroup$
    – ramesh
    Commented Sep 19, 2014 at 14:18
2
$\begingroup$

The new JoinAcross essentially gives you a SQL join if you convert the lists to Key-> Value pairs.

  lists = {list1, list2, list3};

  kys = Map[StringReplace[#, {__ ~~ "Col1" -> "KeyCol"}] &, 
  Table[StringJoin["Lst", ToString@iLst, "Col", ToString@kCol], {iLst,
     Length@lists}, {jRow, Length@lists[[iLst]]}, {kCol, 
    Length@lists[[iLst, jRow]]}], {2}];

  kv = Map[Association, 
   Table[kys[[iLst, jRow, kCol]] -> lists[[iLst, jRow, kCol]], {iLst, 
     Length@lists}, {jRow, Length@lists[[iLst]]}, {kCol, 
     Length@lists[[iLst, jRow]]}], {2}];

  mkv = JoinAcross[
  JoinAcross[kv[[1]], kv[[2]], Key[kys[[1, 1, 1]]], "Left"], kv[[3]],
   Key[kys[[1, 1, 1]]], "Left"];

 merged = SortBy[Values[Normal[mkv]], #[[1]] &];
Improve this answer
$\endgroup$
2
  • $\begingroup$ Thank you, rivercfd, for your time. I tried to implement your codes with my data. However, I could not make it run. $\endgroup$
    – ramesh
    Commented Sep 19, 2014 at 14:29
  • $\begingroup$ There was a typo. The Keys are in "kys" not "keys". Anyways, also needs version 10. $\endgroup$
    – rivercfd
    Commented Sep 19, 2014 at 15:15
2
$\begingroup$

This seems to me cleaner than other options presented:

listMerge[a_List, b_List, pad_: Missing[]] :=
  Lookup[
    # -> {##2} & @@@ a,
    b[[All, 1]],
    pad & /@ a[[1, 2 ;;]]
  ] // Join[b, #, 2] &

Test:

{{1, a, aa, A, AA}, {1, b, bb, A, AA}, {1, c, cc, A, AA}, {2, d, dd, B, BB},
 {2, e, ee, B, BB}, {3, f, ff, C, CC}, {3, g, gg, C, CC}, {3, h, hh, C, CC},
 {4, i, ii, D, DD}, {4, j, jj, D, DD}, {4, k, kk, D, DD}, {4, l, ll, D, DD},
 {4, m, mm, D, DD}, {5, n, nn, Missing[], Missing[]}, {5, o, oo, Missing[],
   Missing[]}, {7, p, pp, Missing[], Missing[]}}

You can use the third parameter to specify a different padding element.

Improve this answer
$\endgroup$
3
  • $\begingroup$ @ Mr. Wizard, thank you for your time and answer. Its short and sweet but I think it is not justifiable to change the accepted answer at this time. $\endgroup$
    – ramesh
    Commented Jan 20, 2015 at 19:14
  • $\begingroup$ @ramesh Whatever you do with the Accept is entirely your prerogative. However I am curious what you mean by "not justifiable" -- do you feel this answer came too late, or that it is not a significant improvement, or that it has limitations you don't like, or...? $\endgroup$
    – Mr.Wizard
    Commented Jan 20, 2015 at 20:31
  • $\begingroup$ @ Mr. Wizard, "not justifiable" does not have any implied meaning. I can not imagine how much this community has benefited from your contribution. I duly respect your contribution to this community. I wish I could do it. I simply like to be nice to the person whose answer I have accepted in the past. Thank you for getting back to me. $\endgroup$
    – ramesh
    Commented Jan 22, 2015 at 2:31
1
$\begingroup$ 
list1 = {{1, A, AA}, {2, B, BB}, {3, C, CC}, {4, D, DD}, {6, F, FF}};

list2 = {{1, a, aa}, {1, b, bb}, {1, c, cc}, {2, d, dd}, {2, e, ee}, {3, f, ff}, {3, g, gg}, {3, h, hh}, {4, i, ii}, {4, j, jj}, {4, k, kk}, {4, l, ll}, {4, m, mm}, {5, n, nn}, {5, o, oo}, {7, p, pp}};

asso1 = GroupBy[list1, First, #[[All, 2 ;; -1]] &]

(*
    <|1->{{A,AA}},2->{{B,BB}},3->{{C,CC}},4->{{D,DD}},6->{{F,FF}}|>
*)

asso2 = GroupBy[list2, First, #[[All, 2 ;; -1]] &]

(*
    <|1->{{a,aa},{b,bb},{c,cc}},2->{{d,dd},{e,ee}},3->{{f,ff},{g,gg},{h,hh}},4->{{i,ii},{j,jj},{k,kk},{l,ll},{m,mm}},5->{{n,nn},{o,oo}},7->{{p,pp}}|>
*)

(*Opt point 1*)clean = ReplaceAll[#, {{Missing[], Missing[]}}[___] :> {{Missing[],        Missing[]}}] &;

result = clean /@   Merge[KeyUnion[{asso2, asso1}, {{Missing[], Missing[]}} &],    Flatten[#, 1] &]

(*
    <|1->{{a,aa},{b,bb},{c,cc},{A,AA}},2->{{d,dd},{e,ee},{B,BB}},3->{{f,ff},{g,gg},{h,hh},{C,C
C}},4->{{i,ii},{j,jj},{k,kk},{l,ll},{m,mm},{D,DD}},5->{{n,nn},{o,oo},Missing[],Missing[]}
},7->{{p,pp},{Missing[],Missing[]}},6->{{Missing[],Missing[]},{F,FF}}|>
*)

group1 = GroupBy[#, #[[1]] &, Identity] &;

(*Opt point2*)Flatten /@ Flatten[#,1] &@(Flatten /@ ((Thread /@ Normal[KeySort@((last = Last@#; Values[Flatten /@ group1@List[#, last] & /@ # // Most]) & /@ result)])) /. Rule -> List)

(*
    {{1,a,aa,A,AA},{1,b,bb,A,AA},{1,c,cc,A,AA},{2,d,dd,B,BB},{2,e,ee,B,BB},{3,f,ff,C,CC},{3,g,
gg,C,CC},{3,h,hh,C,CC},{4,i,ii,D,DD},{4,j,jj,D,DD},{4,k,kk,D,DD},{4,l,ll,D,DD},{4,m,mm,D,D
D},{5,n,nn,Missing[],Missing[]},{5,o,oo,Missing[],Missing[]},{6,Missing[],Missing[],F,FF},
{7,p,pp,Missing[],Missing[]}}
*)

Since the KeyUnion Function has some Union feature...I detoured a little to avoid.

Well, I should optimize the process above,,,

Optimal version:

result = (# /. f[___] -> {{Missing[], Missing[]}}) & /@ 
Merge[KeyUnion[{asso2, asso1}, f], Flatten[#, 1] &];
 group1 = GroupBy[#, #[[1]] &, Identity] &;
  Partition[Flatten@#, 
     5] & /@ ((Thread /@ Normal[KeySort@((last = Last@#;
                  Values[group1@List[#, last] & /@ # // Most]) & /@ 
               result)]) /. Rule -> List)

The main idea is trying to use KeyUnion and Merge.

Improve this answer
$\endgroup$
1
  • $\begingroup$ Thank you HyperGroups for taking to answer this question. $\endgroup$
    – ramesh
    Commented Jan 20, 2015 at 19:15
0
$\begingroup$ 
(* combine[expr_, l_] := 
  With[{matches = Select[l, First[#] == First[expr] &]},
    If[Length[matches] == 0, {Append[expr, Missing[]]},
                             Map[Join[expr, Rest[#]] &, matches]]] *)

combine[expr_, l_] := 
  With[{matches = Select[l, First[#] == First[expr] &], 
   len = Length[l[[1]]] - 1}, 
  If[Length[matches] == 
    0, {Join[expr, ConstantArray[Missing[], len]]}, 
   Map[Join[expr, Rest[#]] &, matches]]]

frobulate[l1_, l2_] := Join @@ Map[combine[#, l2] &, l1]

Now do frobulate[list2, list1]]

Improve this answer
$\endgroup$
3
  • $\begingroup$ Pretty close but not exact. Thank you for your time. If you test your codes, you will see the difference. $\endgroup$
    – ramesh
    Commented Sep 19, 2014 at 1:56
  • $\begingroup$ @rka First, the change to make the require output is trivial (see above). Second, you are being completely obnoxious. Good luck getting people to do your work for you in the future. $\endgroup$
    – Igor Rivin
    Commented Sep 19, 2014 at 3:04
  • 2
    $\begingroup$ Prof. Igor, I am so sorry. I did not mean to disrespect you. I was just responding as friend before knowing you. Thank you for your time though. $\endgroup$
    – ramesh
    Commented Sep 19, 2014 at 3:38

Your Answer

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

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