Merging the last columns of two lists under a rule

Question

If I have two lists whose first columns are identical, such as:

list1 = {{40., 7.50551*10^-10}, {40.,7.50557*10^-10}, {40.,7.50566*10^-10},
         {40.0001, 7.50578*10^-10}, {40.0001, 7.50591*10^-10},{40.0001, 7.50607*10^-10},
         {40.0002, 7.50625*10^-10}, {40.0002, 7.50645*10^-10},{40.0003, 7.50668*10^-10},
         {40.0003, 7.50692*10^-10}};

list2 = {{40., 0.0712996}, {40., 0.0712996}, {40.,0.0712996}, {40.0001, 0.0712996},
         {40.0001, 0.0712996}, {40.0001, 0.0712996}, {40.0002, 0.0712996},
         {40.0002, 0.0712996}, {40.0003, 0.0712996}, {40.0003, 0.0712996}};

How can I multiply corresponding elements of the last column and merge these lists? i.e. keep the first elements intact at each position and multiply the corresponding last elements to generate a new list. In other words, how can the last columns of the two lists be merged under multiplication?

Answer 1

Here is one way:

{list1[[All, 1]], (list1 list2)[[All, 2]]} // Transpose

Answer 2

list1 Inner[{#2,#1}&,list2,{0,1}, #2&]

In the example given by the OP (but not in the general case of the question title), all the second elements in list2 are also identical, and Dot may be used to 'multiply a matrix column by a factor', and get the same result:

list1.{{1,0},{0,list2[[1,2]]}}

And:

(list1 Inner[{#2,#1}&,list2,{0,1}, #2&])===(list1.{{1,0},{0,list2[[1,2]]}})

True

Yet another method is the following:

list1 ArrayFlatten[{{1, List/@list2[[All,2]]}}]

For this use of ArrayFlatten see this old SO answer by Janus

Original Answer

 list1 Inner[{1,#1}&,list2,{1,0}, #2&]

Answer 3

The same, but with Thread.

Thread[{list1[[All, 1]], list2[[All, 2]]*list1[[All, 2]]}]

Another way to get the product is

Table[list2[[i, 2]]*list1[[i, 2]], {i, 1, Length[list1]}]

Answer 4

Here is my version:

MapThread[{#[[1]], #[[2]] #2[[2]]} &, {list1, list2}]

Answer 5

a =
  {{40., 7.50551}, {40., 7.50557}, {40., 7.50566}, 
   {40.0001, 7.50578}, {40.0001, 7.50591}, {40.0001, 7.50607}, 
   {40.0002, 7.50625}, {40.0002, 7.50645}, {40.0003, 7.50668}, 
   {40.0003, 7.50692}};

b =
  {{40., 0.0712996}, {40., 0.0712996}, {40., 0.0712996}, 
   {40.0001, 0.0712996}, {40.0001, 0.0712996}, 
   {40.0001, 0.0712996}, {40.0002, 0.0712996}, {40.0002, 0.0712996}, 
   {40.0003, 0.0712996}, {40.0003, 0.0712996}};

Using SubsetMap (new in 12.0)

SubsetMap[Last /@ (a b) &, a, {All, 2}]

returns

{{40., 0.53514}, {40., 0.535144}, {40., 0.535151}, {40.0001, 0.535159}, 
 {40.0001, 0.535168}, {40.0001, 0.53518}, {40.0002, 0.535193}, 
 {40.0002, 0.535207}, {40.0003, 0.535223}, {40.0003, 0.53524}}

Answer 6

Perhaps the following, but it depends on the lists being identical in size and in their first elements.

MapThread[
    Merge[{#1, #2}, Apply[Times]] &, {Rule @@@ a, Rule @@@ b}] //
   Map[KeyValueMap[List]] //
  Map[Apply[Sequence]] //
 Grid

---

Answer 7

l1 = {{40., 7.50551}, {40., 7.50557}, {40., 7.50566}, {40.0001, 
    7.50578}, {40.0001, 7.50591}, {40.0001, 7.50607}, {40.0002, 
    7.50625}, {40.0002, 7.50645}, {40.0003, 7.50668}, {40.0003, 
    7.50692}};

l2 = {{40., 0.0712996}, {40., 0.0712996}, {40., 0.0712996}, {40.0001, 
    0.0712996}, {40.0001, 0.0712996}, {40.0001, 0.0712996}, {40.0002, 
    0.0712996}, {40.0002, 0.0712996}, {40.0003, 0.0712996}, {40.0003, 
    0.0712996}};

---

Using Thread and MapApply:

{#[[1]], #[[2]]  #2[[2]]} & @@@ Thread[{a, b}]

Result:

{{40., 0.53514}, {40., 0.535144}, {40., 0.535151}, {40.0001, 0.535159}, {40.0001, 0.535168}, {40.0001, 0.53518}, {40.0002, 0.535193}, {40.0002, 0.535207}, {40.0003, 0.535223}, {40.0003, 0.53524}}