6
$\begingroup$

I am creating some simple graphs of functions defined by ordered pairs. Students are learning about "operations on functions", in this case, adding functions.

If I have two functions defined by ordered pairs, how do I add them? I know this must be a simple list processing thing, I would appreciate any help.

I.E.

functiong = {{-5, -5}, {-3, -3}, {1, 1}, {2, 2},  {5, 5}};
functionf = {{-5, 4}, {-3, 2}, {1, 2}, {2, 5}, {5, 5}};

I want to have the sum....

sum = {{-5, -1}, {-3, -1}, {1, 3}, {2, 7}, {5, 10}};

Easy to do manually, but if I modify the lists to create new examples, I'd like to have Mathematica "add" those lists for me....

Edit

Below, an example of the kind of question I see in the textbooks the students are using. They are told that what they see is function $f$ (red) and function $g$ (blue) and asked to draw $(f+g)(x)$

enter image description here

My question is answered, but now that the context is clear, I would of course welcome any further suggestions on ways to easily create similar (and perhaps more interesting , but not harder!) problems.

Improve this question
$\endgroup$
3
  • $\begingroup$ Can you post an example using symbols so one can see more easily what is being added to what? Something like : functiong = {{k1, k2}, {k3, k4}}; functionf = {{c1, c2}, {c3, c4}}; what should the sum be? $\endgroup$
    – Nasser
    Sep 14, 2013 at 8:01
  • $\begingroup$ Hi, I'm sorry I wasn't clear. yes, the "functions" are always simple, discrete domains. They are often just simple piecewise functions on a limited domain, just to see if the students realize that the result is as shown below, (input1, output1 + output2) and so on $\endgroup$
    – Tom De Vries
    Sep 14, 2013 at 10:18
  • $\begingroup$ Do the functions always have the same domain as shown or do you need to account for the possibility of regions without overlap? $\endgroup$
    – Mr.Wizard
    Sep 15, 2013 at 19:01

7 Answers 7

Reset to default
6
$\begingroup$

One way :

MapThread[{#1[[1]], #1[[2]] + #2[[2]]} &, {functiong, functionf}]
(* {{-5, -1}, {-3, -1}, {1, 3}, {2, 7}, {5, 10}} *)
Improve this answer
$\endgroup$
1
  • $\begingroup$ I appreciated everyone's answers, I learned a lot, and I appreciated all the input. I found this answer the easiest to understand and use, but all the other answers had things that taught me more about using Mathematica. $\endgroup$
    – Tom De Vries
    Sep 25, 2013 at 22:03
9
$\begingroup$

Besides standard approach like MapThread which appears to be slow for long lists, one should consider more efficient ones, these two ways should be the most efficient (because Transpose is the way to go, there were many posts demonstrating its efficiency): 

Transpose[{ First @ #1, Total[Last /@ {#1, #2}]}]& @@( Transpose /@ 
{functionf, functiong})

or

Transpose[{ First @ #1, Plus @@ Last /@ {#1, #2}}]& @@ ( Transpose /@ 
{functionf, functiong})

{{-5, -1}, {-3, -1}, {1, 3}, {2, 7}, {5, 10}}

The above can be also rewrittren more concisely using a shorthand Esc tr Esc or \[Transpose]:

enter image description here

Edit

Let's compare efficiency of the various methods, e.g.:

arg = RandomInteger[{-100, 100}, 10^6];
fg = Transpose[{arg, RandomInteger[{-100, 100}, 10^6]}];
ff = Transpose[{arg, RandomInteger[{-100, 100}, 10^6]}];

bgatessucks[g_, f_] := First[MapThread[{#1[[1]], #1[[2]] + #2[[2]]} &, {g, f}]
// AbsoluteTiming]

kuba[f_, g_] := First[+##/{2, 1} & @@@ GatherBy[f~Join~g, First] // AbsoluteTiming]

nasser[f_, g_] := First[ Transpose[{g[[All, 1]], g[[All, 2]] + f[[All, 2]]}]
// AbsoluteTiming]  

artes1[f_, g_] := First[Transpose[{First @ #1, Plus @@ Last /@ {#1, #2}}] & @@
(Transpose /@ {f, g}) // AbsoluteTiming]

artes2[f_, g_] := First[Transpose[{First @ #1, Total[ Last /@ {#1, #2}]}] & @@
(Transpose /@ {f, g}) // AbsoluteTiming]

Now 

  bgatessucks[fg, ff]
  kuba[ff, fg]
  nasser[ff, fg]
  artes1[ff, fg]
  artes2[ff, fg]   

4.671000
3.153000
0.175000
0.092000
0.063000

We can see that Transpose with Total is the fastest approach, i.e. artes1. It is faster roughly 70 times for these lists.

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

A linear algebra approach

c = functiong[[All, 1]];
d = functiong[[All, 2]] + functionf[[All, 2]];
Transpose[{c, d}]

Mathematica graphics

Improve this answer
$\endgroup$
2
  • $\begingroup$ @Kuba, humm... everyone seems to be getting different result then when the first set is changed from identity. It would be easier if it was put in terms of symbols so one can see better that is being added to what. Your method gives different result to gatessucks as well. See: !Mathematica graphics $\endgroup$
    – Nasser
    Sep 14, 2013 at 8:00
  • $\begingroup$ You can't test my approach for symbols. The part with GatherBy will fail as it is looking for values for the same arguments. @b.gatessucks 's way will work with the assumption that first elements o each pair are the same for each 'function' $\endgroup$
    – Kuba ♦
    Sep 14, 2013 at 8:04
5
$\begingroup$ 
+##/{2, 1} & @@@ GatherBy[functionf~Join~functiong, First]

or for more functions: set = {f1, f2, ...}, also with different domains:

+##/{Length[{##}], 1} & @@@ GatherBy[Join@@set, First]

Edit reffering to your edit:

g = {{-5, -5}, {-3, -3}, {1, 1}, {2, 2}, {5, 5}};
f = {{-5, 4}, {-3, 2}, {1, 2}, {2, 5}, {5, 5}};
int = Interpolation[#, InterpolationOrder -> 1] &

Plot[{int[g][x], int[f][x], int[g][x] + int[f][x]}, {x, -5, 5}]

enter image description here

Improve this answer
$\endgroup$
0
4
$\begingroup$

  1. Approach with compact notation

    functiong + functionf /. {x_, y_} -> {x/2, y}

  2. Fast (the fastest?) approach

    res = fg + ff; res[[All, 1]] = fg[[All, 1]];

    Timings (2*10^7 elements):

    my: 1.794889

    artes1: 1.893763

    artes2: 1.894489

Both can be easily generalized to any number of functions.

Edit: on different system timings can vary. In some cases my solution is faster, in some -- not.

Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ I like it (+1) but I found artes1 and artes2 faster. More reliable for timing should be timeAvg function: timeAvg = Function[func, Do[If[# > 0.3, Return[#/5^i]] & @@ AbsoluteTiming@Do[func, {5^i}], {i, 0, 15}], HoldFirst];. Now artes1[ff, fg] yields 1.332000 while ybeltukov[fg, ff] yields 1.569000 for ybeltukov[f_, g_] := timeAvg[(res = fg + ff; res[[All, 1]] = fg[[All, 1]];)] for lists of 2 10^7 lengths. $\endgroup$
    – Artes
    Sep 15, 2013 at 12:52
  • $\begingroup$ @Artes It turns out it depend on the system. The timings above I get on Core 2 Quad. On Core i7 I get my: 0.971060, artes1: 0.807833, artes2: 0.809121. You too +1 :) $\endgroup$
    – ybeltukov
    Sep 15, 2013 at 13:06
4
$\begingroup$

I think this question is a duplicate of Elegant operations on matrix rows and columns unless functions do not share identical domains. Nevertheless for the time being I'll join in the fun. This is essentially the same are Artes's method but in my own style:

add = {#, #2 + #4}\[Transpose] & @@ Join[#\[Transpose], #2\[Transpose]] &;

Which displays as:

enter image description here

Test:

add[functionf, functiong]

{{-5, -1}, {-3, -1}, {1, 3}, {2, 7}, {5, 10}}
Improve this answer
$\endgroup$
3
$\begingroup$

Just for fun:

{1, 0}.{functionf, functiong}.{{1, 1}, {0, 1}}
Improve this answer
$\endgroup$

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.