5
$\begingroup$

Suppose that I have two lists, list1 and list2, of ordered pairs $(x, y)$. The two lists are differently spaced in $x$; some ordered pairs in list1 and list2 have the same $x$ value, but some do not.

I would like to combine the two lists such that all ordered pairs are included in the resulting list, which I will call list. If two ordered pairs happen to have the same $x$ value, then their $y$ values are added. Otherwise, the ordered pairs are included as-is.

Here is an example. list1 and list2 are defined as follows:

list1 = {{0, 0}, {1, 1}, {2, 4}, {3, 9}, {4, 16}};
list2 = {{0, 0.5}, {0.4, 1}, {1, 2}, {1.5, 3}, {3.25, 8}, {4, 8}};

I would like to write a function addLists that takes list1 and list2 and returns the following list:

list = {{0, 0.5}, {0.4, 1}, {1, 3}, {1.5, 3}, {2, 4}, {3, 9}, {3.25, 8}, {4, 24}}

One way to write addLists is to use a rather long, complicated combination of SortBy, GatherBy, Map, Total, and Transpose:

addLists[list1_List, list2_List] := Module[{xList, yList, list},
  list = SortBy[Join[list1, list2], First];
  xList = DeleteDuplicates[list[[All, 1]]];
  list = GatherBy[list, First];
  yList = Map[Total[#[[All, 2]]] &, list];
  list = Transpose[{xList, yList}]
  ]

addLists[list1, list2]

which gives the desired output (matching list):

{{0, 0.5}, {0.4, 1}, {1, 3}, {1.5, 3}, {2, 4}, {3, 9}, {3.25, 8}, {4, 24}}

But, I think that there must be a simpler -- perhaps even built-in -- way to do this. Do you have any suggestions?

|improve this question
$\endgroup$
  • $\begingroup$ Hmm... I'm quite certain that this is a duplicate, but I can't seem to find the post. Can you explain why you're dissatisfied with your answer? Seems fine to me (although, it could be written cleaner) or why you think there should be a built-in function for your specific need? Are you not satisfied with the speed or do you think it is clumsy? I'm just trying to understand your reasoning. I tend to think that if something is clear enough (to the author and others), does not have terrible performance and does the job, it is good enough. Extremely terse code often leads to unmaintainable code :) $\endgroup$ – rm -rf♦ Sep 28 '13 at 17:57
  • $\begingroup$ @rm-rf Thanks. I just thought my way was clumsy, error-prone, and possibly even incorrect (for cases I hadn't tested). I thought maybe there would be a terse way to write it in one or two lines using Union or Intersection. Since my desired result is essentially adding two histograms, I thought maybe there would be something built-in like HistogramList to do the job. $\endgroup$ – Andrew Sep 28 '13 at 18:07
3
$\begingroup$

There might be a more generalized version of this question here, but I can't find it. In your specific example, I would've probably written it as 

f = Composition[Apply[{First@#, Total@#2} &, #] &, Transpose] /@ GatherBy[Join[##], First]&;

Then you can pass your lists (any number) to it:

f[list1, list2] // Sort
(* {{0, 0.5}, {0.4, 1}, {1, 3}, {1.5, 3}, {2, 4}, {3, 9}, {3.25, 8}, {4, 24}} *)

If you always want a sorted output, you can add it to the definition.

Since you say that you want to add two histograms, there are a couple of alternatives to doing the above (assuming you have control over the data set and the histogram generation)

  • Combine the data sets and then generate a histogram list for the combined set.
  • Use explicit bins and generate histogram lists for both sets using the same binning. Adding those two would be much simpler.
|improve this answer
$\endgroup$
  • 1
    $\begingroup$ Independently I got to a very similar construct, without Composition: ({First@#1, Total@#2} & @@ Transpose@#) & /@ GatherBy[Join[list1, list2], First]. $\endgroup$ – István Zachar Sep 28 '13 at 20:57
2
$\begingroup$

May be less elegant solution than rm -rf proposed but much more efficient

f2[list1_,list2_] := Sort@Join[
          Pick[Transpose@{Most[#1], Most[#2] + Rest[#2]}, 
           UnitStep[Most[#1] - Rest[#1]], 1],
          Pick[Transpose@{##}, 
           Append[#, 0] + Prepend[#, 0] &@UnitStep[Most[#1] - Rest[#1]], 0]
          ] & @@ Transpose@Sort@Join[list1,list2];

n = 100000;
list1 = Accumulate@RandomInteger[{1, 3}, {n, 2}];
list2 = Accumulate@RandomInteger[{1, 3}, {n, 2}];

res = Sort@f[list1, list2]; // AbsoluteTiming
res2 = f2[list1, list2]; // AbsoluteTiming
res == res2

1.847463
0.051440
True

This method is fast because it uses packed arrays.

Update:

More compact and fast solution which calculates sums with Accumulate, Pick, and Differences

f3[lists__] := Transpose@{Pick[#, #3, 1], 
 Prepend[Differences[#], First[#]] &@Pick[#2, #3, 1]} &[#, 
 Accumulate[#2], Append[#, 1] &@Sign@Differences[#]] & @@ Transpose@Sort@Join[lists];

res3 = f3[list1, list2]; // AbsoluteTiming
res3 == res

0.037432
True

Moreover, it can be applied to any number of lists!

|improve this answer
$\endgroup$
  • $\begingroup$ It's not very important, but I get a small amount of round-off error with f3 on the large example in my answer (which uses type Real instead of Integer). That's why I don't show resf2 == resf3, which returns False. $\endgroup$ – Michael E2 Sep 29 '13 at 1:25
  • $\begingroup$ @MichaelE2 This is to be expected. In such cases I use Max@Abs as upper limit of errors. I also noticed that for the real data f3 is slower than f2. $\endgroup$ – ybeltukov Sep 29 '13 at 2:09
  • $\begingroup$ @MichaelE2 I update f3. Now it works almost as fast as your mergeBin. The problem was that I prepend integer 0 to the real list. $\endgroup$ – ybeltukov Sep 29 '13 at 16:12
2
$\begingroup$

I like this one, similar to @rm-rf but a bit more compact and faster:

f4[lists__] := {#[[1, 1]], Total@#[[All, 2]]} & /@ Join[lists]~ GatherBy~First
|improve this answer
$\endgroup$
1
$\begingroup$

For speed, one could compile to C an adapted form of the standard merge of two sorted lists. (See Leonid's excellent answer to this question.) But most likely histogram bins are not going many, and unless one is combining such lists many times, speed is not essential. So I offer a second one, which is slow but appealing.

First: Compiled

This is more or less a standard C program and is even compiled to C. You don't get the speed advantage without compiling to C.

mergeBin = 
 Compile[{{first, _Real, 2}, {second, _Real, 2}}, 
  Module[{result = Table[0., {Length[first] + Length[second]}, {2}], 
    i = 0, fctr = 1, sctr = 1},

   While[fctr <= Length[first] && sctr <= Length[second],
    If[first[[fctr, 1]] < second[[sctr, 1]],
     result[[++i]] = first[[fctr++]],
     (*else*)
     If[first[[fctr, 1]] == second[[sctr, 1]],
      result[[++i]] = first[[fctr++]]; 
      result[[i, 2]] += second[[sctr++, 2]],
      (*else*)
      result[[++i]] = second[[sctr++]]]]];

   If[sctr <= Length[second],
    result[[++i ;; i + Length@second - sctr]] = second[[sctr ;; -1]];
    i += Length@second - sctr,
    (*else*)
    If[fctr <= Length[first],
     result[[++i ;; i + Length@first - fctr]] = first[[fctr ;; -1]];
     i += Length@first - fctr]];
   result[[;; i]]],

  CompilationTarget -> "C"]

OP's example:

mergeBin[list1, list2]
(* {{0., 0.5}, {0.4, 1.}, {1., 3.}, {1.5, 3.}, {2., 4.}, {3., 9.}, {3.25,8.}, {4., 24.}} *)

Timings

list1 = Transpose[{Sort@RandomSample[N@Range[10^6], 5 10^5], RandomReal[1, 5 10^5]}];
list2 = Transpose[{Sort@RandomSample[N@Range[10^6], 5 10^5], RandomReal[1, 5 10^5]}];

resMB = mergeBin[list1, list2];// AbsoluteTiming // First
resf2 = f2[list1, list2]; // AbsoluteTiming // First  (* ybeltukov *)
resf3 = f3[list1, list2]; // AbsoluteTiming // First  (* ybeltukov *)

0.118000
0.270230
0.303287

resMB == resf2
(* True *)

If the lists come unsorted, then all three slow down:

list1 = Transpose[{RandomSample[N@Range[10^6], 5 10^5], RandomReal[1, 5 10^5]}];
list2 = Transpose[{RandomSample[N@Range[10^6], 5 10^5], RandomReal[1, 5 10^5]}];

resMB = mergeBin[Sort@list1, Sort@list2]; // AbsoluteTiming // First
resf2 = f2[list1, list2]; // AbsoluteTiming // First
resf3 = f3[list1, list2]; // AbsoluteTiming // First

0.320650
0.454141
0.584872

Another solution

This seems to me to be a nice way to take advantage of Mathematica, and it works on an arbitrary number of lists. However, it's about 100 times slower than mergeBin on the large pre-sorted lists above (about twice as slow as rm-rf's), and about 5% slower on unsorted lists. It's only about 25 times slower on the OP's example. This approach always seems inefficient but easy to code.

mergeBin2[lists__] := Block[{bin},
  bin[_] = 0;
  Fold[bin[N@#[[1]]] += #[[2]] & /@ #2 &, {}, {lists}];
  Cases[DownValues[bin], HoldPattern[_[bin[x_Real]] :> y_] :> {x, y}]
  ]
|improve this answer
$\endgroup$
1
$\begingroup$

An approach using Reap and Sow:

Reap[Map[Sow @@ Reverse@# &, 
   SortBy[Join[list1, list2], #[[1]] &]], _, {#1, Total@#2} &][[2]]

yields:

{{0, 0.5}, {0.4, 1}, {1, 3}, {1.5, 3}, {2, 4}, {3, 9}, {3.25, 8}, {4, 
  24}}
|improve this answer
$\endgroup$
  • $\begingroup$ You have a cool blog!.. $\endgroup$ – Murta Sep 30 '13 at 1:40
  • $\begingroup$ @Murta thank you for the kind comment...a self-indulgence...I learn a lot from your answers and posts... $\endgroup$ – ubpdqn Sep 30 '13 at 7:12
1
$\begingroup$

TemporalData + ResamplingMethod

Much slower than posted alternatives but elegant?

ClearAll[tsAdd]
tsAdd = Total[TemporalData[#, ResamplingMethod -> {"Constant", 0}]& /@ {##}]["Path"]&;

tsAdd[list1, list2]

{{0.,0.5}, {0.4,1}, {1.,3}, {1.5,3}, {2.,4}, {3.,9}, {3.25,8}, {4.,24}}

|improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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