7
$\begingroup$

I have two 2D arrays where some of the x-values are identical,

L={{1,1},{2,2},{3,3}};
J={{0,1},{2,2},{4,4}};

I want to add these lists in the following way

{{0,1}, {1,1},{2,4},{3,3},{4,4}};

In other words, that y-values of the data points that have the same x are added. How can I achieve this?


Please note that the arrays are not necessarily of the same length

Two arrays for test:

first = {{0.15, 0.000470185}, {0.16, 0.000521784}, {0.17, 0.000580663}, {0.18,
   0.000648083}, {0.19, 0.000725569}, {0.2, 0.000814968}, {0.21, 
  0.000918532}, {0.22, 0.00103901}, {0.23, 0.0011798}, {0.24, 
  0.00134508}, {0.25, 0.00154005}, {0.26, 0.00177121}, {0.27, 
  0.00204667}, {0.28, 0.00237667}, {0.29, 0.00277409}, {0.3, 
  0.00325523}, {0.31, 0.00384059}, {0.32, 0.00455591}, {0.33, 
  0.00543312}, {0.34, 0.00651098}, {0.35, 0.00783476}, {0.36, 
  0.00945361}, {0.37, 0.0114133}, {0.38, 0.0137402}, {0.39, 
  0.0164132}, {0.4, 0.0193217}, {0.41, 0.0222235}, {0.42, 
  0.0247384}, {0.43, 0.0264243}, {0.44, 0.0269371}, {0.45, 
  0.0261818}, {0.46, 0.024341}, {0.47, 0.0217652}, {0.48, 
  0.0188176}, {0.49, 0.0157753}, {0.5, 0.0128044}, {0.51, 
  0.00998009}, {0.52, 0.00731676}, {0.53, 0.00479353}, {0.54, 
  0.00237078}, {0.55, 0}}


second = {{-0.04, -0.0000547619}, {-0.03, -0.000405238}, {-0.02, -0.00207438}, \
{-0.01, -0.00878929}, {0, -0.0154401}, {0.01, -0.0178195}, {0.02, \
-0.0180879}, {0.03, -0.0173267}, {0.04, -0.0157714}, {0.05, \
-0.014605}, {0.06, -0.0131757}, {0.07, -0.0119764}, {0.08, \
-0.010695}, {0.09, -0.00946286}, {0.1, -0.00849357}, {0.11, \
-0.00708071}, {0.12, -0.00578286}, {0.13, -0.00468214}, {0.14, \
-0.00306119}, {0.15, -0.00146214}, {0.16, 0.00061881}, {0.17, 
  0.00194733}, {0.18, 0.00376762}, {0.19, 0.00509833}, {0.2, 
  0.00625381}, {0.21, 0.00762286}, {0.22, 0.00918905}, {0.23, 
  0.0105964}, {0.24, 0.0118067}, {0.25, 0.0134238}, {0.26, 
  0.0149774}, {0.27, 0.0163519}, {0.28, 0.017469}, {0.29, 
  0.0167517}, {0.3, 0.0102788}, {0.31, 0.00253876}, {0.32, 
  0.000314333}, {0.33, 0.000038881}, {0.34, 0.0000224524}}

first array is here: http://www.datafilehost.com/d/731a267e.

The second array I generate from this code:

factor = 11.0;
second = Table[{(38 - i)*0.01, 0}, {i, 0, 38}] - 0.04;
tempData = (1/10000) (factor/21) {
    0.41,
    0.71,
    5.74,
    46.36,
    187.70,
    305.90,
    319.0,
    298.60,
    273.50,
    245.13,
    215.60,
    193.50,
    167.80,
    139.20,
    114.20,
    93.10,
    68.80,
    35.56,
    11.30,
    -26.70,
    -55.90,
    -85.50,
    -105.60,
    -129.30,
    -155.10,
    -172.80,
    -195.30,
    -218.70,
    -240.60,
    -266.70,
    -288.00,
    -316.4,
    -330.3,
    -325.4,
    -281.95,
    -160.50,
    -37.88,
    -7.4,
    -1.0
    };

For[i = 1, i < Length[tempData] + 1, i++,
  second[[i, 2]] = tempData[[i]]];
second = second // Reverse;
$\endgroup$
8
  • $\begingroup$ In your second example 0.17 ~= .16999999999999998. So it doesn't merge them. $\endgroup$
    – Öskå
    Aug 5, 2014 at 13:51
  • $\begingroup$ @Öskå Is it possible to fix this? $\endgroup$
    – BillyJean
    Aug 5, 2014 at 13:52
  • $\begingroup$ Everything is possible ;) $\endgroup$
    – Öskå
    Aug 5, 2014 at 13:52
  • 1
    $\begingroup$ @BillyJean Quick and dirty first = N@Round[first, 10^-15];. Same for second and you are all good :) $\endgroup$
    – Öskå
    Aug 5, 2014 at 13:57
  • 1
    $\begingroup$ Since people keep answering duplicates we now have good answers spread across numerous Q&A's including: (4332) (16507) (26574) (43683) I encourage people to move any unique answers to the original. (Delete and repost.) $\endgroup$
    – Mr.Wizard
    Aug 5, 2014 at 20:18

8 Answers 8

4
$\begingroup$

Once again not very fancy but it does the job:

L = {{1, 1}, {2, 2}, {3, 3}};
J = {{0, 1}, {2, 2}, {4, 4}};
Sort@With[{g = GatherBy[Join[L, J], First]}, 
  Thread@{DeleteDuplicates[Flatten@Map[First, g, {2}]], 
          Plus @@@ Map[Last, g, {2}]}]
{{0, 1}, {1, 1}, {2, 4}, {3, 3}, {4, 4}}

With the data provided by the OP and res = Sort[With[{..., Join[first, second]...] one can have:

ListPlot[{res, first, second}, 
  PlotStyle -> {Directive[{[email protected], Red}], Blue, Green},
  Filling -> Axis, Axes -> {False, True}]

Mathematica graphics

$\endgroup$
9
  • $\begingroup$ When I try this method with the two arrays in the OP, the points around 0.15 are not added $\endgroup$
    – BillyJean
    Aug 5, 2014 at 13:10
  • $\begingroup$ @BillyJean They are. See here. $\endgroup$
    – Öskå
    Aug 5, 2014 at 13:12
  • $\begingroup$ But if I use ListLinePlot on the array, I can see that there are multiple values. But if I show the array using MatrixForm, then I can see there aren't multiple values?! $\endgroup$
    – BillyJean
    Aug 5, 2014 at 13:15
  • $\begingroup$ @BillyJean Try with a new kernel? Works like a charm for me and all the data seems to be added. $\endgroup$
    – Öskå
    Aug 5, 2014 at 13:20
  • $\begingroup$ It's at 0.17 and 0.18, I see it in both the plot and the data $\endgroup$
    – BillyJean
    Aug 5, 2014 at 13:22
8
$\begingroup$

You can also use the V10 function Merge:

List @@@ Normal @ Merge[Total][Rule @@@ Join[L, J]]

or

List @@@ Normal @ Merge[Rule @@@ Join[L, J], Total]

or (a variant of @Carlo's answer using GroupBy with a different syntax)

List @@@  Normal @ GroupBy[Join[L,J], First -> Last, Total]

to get

(* {{1, 1}, {2, 4}, {3, 3}, {0, 1}, {4, 4}}  *)

Update: Some timings using Wolfram Programming Cloud:

tstdata=RandomInteger[10,{2,100000,2}];

mergeLists[x_, y_] := Module[{f, g, l3}, f[{a_, b_}] /; NumericQ[g@a] := 
  (g[a] += b);
  f[{a_, b_}] := (g[a] := b);l3 = Join[x, y];f /@ l3;{#, g@#} & /@ Union[First /@ l3]]

(res1=mergeLists@@tstdata)//Timing //First
(* 1.889713 *)
(res2=Sort@With[{g = GatherBy[Join@@tstdata, First]},
            Thread@{DeleteDuplicates[Flatten@Map[First, g, {2}]],
            Plus @@@ Map[Last, g, {2}]}])//Timing//First
(* 0.423935 *)
(res2b=With[{g = GatherBy[Join@@tstdata, First]},
            Thread@{DeleteDuplicates[Flatten@Map[First, g, {2}]],
            Plus @@@ Map[Last, g, {2}]}])//Timing//First
(* 0.378943 *)
(res3=List @@@  Normal @ GroupBy[Join@@tstdata, First -> Last, Total])//Timing//First
(* 0.033994  *)
(res4=List@@@Normal[Total /@ GroupBy[Join@@tstdata, First -> Last]])//Timing//First
(* 0.033994 *)
(res5=List @@@ Normal @ Merge[Rule @@@ Join@@tstdata,Total])//Timing//First
(* 9.465561 *)
(res6=List @@@ Normal @ Merge[Total][Rule @@@ Join@@tstdata])//Timing//First
(* 9.496556 *)
Sort@res1==Sort@res2==Sort@res2b==Sort@res3==Sort@res4==Sort@res5==Sort@res6
(* True *)
$\endgroup$
9
  • $\begingroup$ Nice! Could you provide some comparison indicator for those of us without v10 available? Perhaps just comparing with any other answer to this question... $\endgroup$ Aug 5, 2014 at 14:38
  • $\begingroup$ @eldo, thanks!! $\endgroup$
    – kglr
    Aug 5, 2014 at 14:48
  • $\begingroup$ @belisarius, good idea -- I will update with some timings. $\endgroup$
    – kglr
    Aug 5, 2014 at 14:50
  • $\begingroup$ @kguler When will you update with some timings? :P $\endgroup$
    – Öskå
    Aug 11, 2014 at 11:50
  • $\begingroup$ @Oska, apologies for the delay to post timings -- I do not have the desktop version of V10 yet; I have been using Wolfram Programming Cloud and my internet connection has been too slow recently to do a decent timing experiment. BTW, if you have desktop V10 i would appreciate it very much if you could post your timing results. $\endgroup$
    – kglr
    Aug 11, 2014 at 11:58
5
$\begingroup$

Just showing some tricks:

l1 = {{1, 1}, {8, 2}, {3, 3}};
l2 = {{0, 1}, {8, 3}, {4, 4}};

mergeLists[x_, y_] := Module[{f, g, l3},

  f[{a_, b_}] /; NumericQ[g@a] := (g[a] += b);
  f[{a_, b_}] := (g[a] := b);

  l3 = Join[x, y];
  f /@ l3;
  {#, g@#} &/@ Union[First /@ l3]
  ]

(*{{0, 1}, {1, 1}, {3, 3}, {4, 4}, {8, 5}}*)
$\endgroup$
15
  • $\begingroup$ wow, this is fast. You time 0.298017, eldo's time 4.371250 $\endgroup$ Aug 5, 2014 at 12:51
  • $\begingroup$ @molekyla777 eldo's answer uses Replacement rules, which are usually slow $\endgroup$ Aug 5, 2014 at 12:52
  • $\begingroup$ This only works if the arrays are of the same size $\endgroup$
    – BillyJean
    Aug 5, 2014 at 12:54
  • 1
    $\begingroup$ @Öskå Could you please try it now again? $\endgroup$ Aug 5, 2014 at 13:30
  • 1
    $\begingroup$ @belisarius Perfect. Or we are both wrong :P $\endgroup$
    – Öskå
    Aug 5, 2014 at 13:35
4
$\begingroup$

A somewhat shorter way of achieving the same on V10:

merge = Total /@ GroupBy[Join[first, second], First -> Last]

This would return an Association, but you can still use it in ListPlot. If you don't want an Association

List @@@ Normal[merge]
$\endgroup$
3
$\begingroup$
L = {{1, 1}, {2, 2}, {3, 3}};
J = {{0, 1}, {2, 2}, {4, 4}};

Sort@Flatten[Transpose[{J, L}] /. {{a_, b_}, {a_, c_}} :> {{a, b + c}}, 1]

{{0, 1}, {1, 1}, {2, 4}, {3, 3}, {4, 4}}

$\endgroup$
7
  • $\begingroup$ That's fancy :) and smarter :P $\endgroup$
    – Öskå
    Aug 5, 2014 at 12:41
  • $\begingroup$ @Öskå Thanks - shouldn't be the fastest though for large lists :) $\endgroup$
    – eldo
    Aug 5, 2014 at 12:43
  • $\begingroup$ Only works for two list with no duplicate first entries. $\endgroup$
    – John McGee
    Aug 5, 2014 at 12:44
  • $\begingroup$ @John Could you give an example? $\endgroup$
    – eldo
    Aug 5, 2014 at 12:56
  • $\begingroup$ l = {{1, 1}, {2, 2}, {2, 7}, {3, 3}}; j = {{0, 1}, {2, 5}, {4, 5}, {4, 1}}; $\endgroup$
    – John McGee
    Aug 5, 2014 at 13:02
2
$\begingroup$

Sow, Reap implementation

t = Join[L, J];
tags = DeleteDuplicates[t[[All, 1]]];
res = Reap[t /. {x_, y_} :> {Sow[y, x]}][[2]];
MapThread[{#1, Total@#2} &, {tags, res}]
(*{{1, 1}, {2, 4}, {3, 3}, {0, 1}, {4, 4}}*)
$\endgroup$
1
  • $\begingroup$ More terse: Reap[Sow@@@Join[J,L],_,{#1,Total@#2}&]//Last $\endgroup$ Aug 5, 2014 at 17:23
2
$\begingroup$

One-liner:

Sort@Join[L,J]//.{a___,{x_,y1_},{x_,y2_},b___}:>{a,{x,y1+y2},b}

Testing it on your 2 lists (took about 0.001 in AbsoluteTiming)

merge=Sort@Join[first,second]//.{a___,{x_,y1_},{x_,y2_},b___}:>{a,{x,y1+y2},b};
ListPlot[{merge,first,second},
PlotLegends->{"merge","first","second"},PlotStyle->AbsolutePointSize/@{8,4,4}]

Mathematica graphics

$\endgroup$
1
$\begingroup$

Here is an optional approach with more details. First merge the lists then gather the first coordinates

t = Flatten[{l, j}, 1]; f = Union[First[[Transpose[t]]];

Next form a ragged array, collecting by the first element.

r = Cases[t, {#, _}] & /@ f;

Finally collapse the ragged array by summing

Total[#[[All, 2]]] & /@ r; rstl=Transpose[{f,s}];

I hope that you find this helpful.

$\endgroup$
1
  • $\begingroup$ Thanls, but this only works if the arrays are of the same size $\endgroup$
    – BillyJean
    Aug 5, 2014 at 12:55

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