# Sum only third element for two tables of data

I have

J = Table[{x10, y10, x10*y10}, {x10, 0, 1, 0.5}, {y10, 0, 1, 0.5}]
L = Table[{x10, y10, 2.0*x10*y10}, {x10, 0, 1, 0.5}, {y10, 0, 1, 0.5}]


I want the third elements of J and L to be added and the first and second elements are as they are (as they are the same in both cases) for an example.

• Never use upper-case letters, or strings with an initial upper-case letter to name a variable in Mathematica as it can conflict with internal names. Commented Dec 17, 2017 at 20:08

result = J;
result[[All, All, 3]] += L[[All, All, 3]]

tJ = Table[{x10, y10, x10*y10}, {x10, 0, 1, 0.5}, {y10, 0, 1, 0.5}];
tL = Table[{x10, y10, 2.0*x10*y10}, {x10, 0, 1, 0.5}, {y10, 0, 1, 0.5}];


Several alternatives:

tK1 = Map[{0, 0, 1} # &, tJ, {-2}] + tL;
tK2 = MapAt[2 # &, Mean[{tJ, tL}], {{All, All, -1}}];
tK3 = Mean[{tJ, tL}]; tK2[[All, All, -1]] = 2 tK2[[All, All, -1]];

Grid[tK1, Dividers -> All] // TeXForm


$\begin{array}{|c|c|c|} \hline \{0.,0.,0.\} & \{0.,0.5,0.\} & \{0.,1.,0.\} \\ \hline \{0.5,0.,0.\} & \{0.5,0.5,0.75\} & \{0.5,1.,1.5\} \\ \hline \{1.,0.,0.\} & \{1.,0.5,1.5\} & \{1.,1.,3.\} \\ \hline \end{array}$

tK1 == tK2 == tK3


True

Something like:

MapThread[{#1[[1]], #1[[2]], #1[[3]] + #2[[3]]} &, {J, L}, 2]


do the job.

Another possibility

t3 = Map[(# /. {a_, b_, c_} -> {0, 0, c}) &, t1, {2}] + t2

j = Table[{x10, y10, x10*y10}, {x10, 0, 1, 0.5}, {y10, 0, 1, 0.5}];
l = Table[{x10, y10, 2.0*x10*y10}, {x10, 0, 1, 0.5}, {y10, 0, 1, 0.5}];

Partition[
Transpose[{Partition[Flatten[j], 3], Partition[Flatten[l], 3]}] /.
{{x1_, y1_, r1_}, {x2_, y2_, r2_}} :> {x1, y1, r1 + r2}
, 3]

{{{0., 0., 0.}, {0., 0.5, 0.}, {0., 1., 0.}},
{{0.5, 0., 0.}, {0.5, 0.5, 0.75}, {0.5, 1., 1.5}},
{{1., 0., 0.}, {1., 0.5, 1.5}, {1., 1., 3.}}}

a = Table[{x10, y10, x10*y10}, {x10, 0, 1, 0.5}, {y10, 0, 1, 0.5}];

b = Table[{x10, y10, 2.0*x10*y10}, {x10, 0, 1, 0.5}, {y10, 0, 1, 0.5}];


If we replace the 1st and 2nd elements of b with 0, it's a simple addition

a + MapAt[0 &, b, {;; , ;; , ;; 2}


returns

{{{0., 0., 0.}, {0., 0.5, 0.}, {0., 1., 0.}},
{{0.5, 0., 0.}, {0.5, 0.5, 0.75}, {0.5, 1., 1.5}},
{{1., 0., 0.}, {1., 0.5, 1.5}, {1., 1., 3.}}}


We get the same result with

a + Replace[b, {__, x_} :> {0, 0, x}, {2}];

tJ = Table[{x10, y10, x10*y10}, {x10, 0, 1, 0.5}, {y10, 0, 1, 0.5}];

tL = Table[{x10, y10, 2.0*x10*y10}, {x10, 0, 1, 0.5}, {y10, 0, 1, 0.5}];


We can also use new-in-Version-13.1 Threaded:

tK = tL + Threaded[{0, 0, 1}] tJ;

Column[Labeled[
Grid[ToExpression @ #, Dividers -> All, ItemSize -> {10, 1}], #, Left] & /@
{"tL", "tJ", "tK"}]