14
$\begingroup$

I'm looking for the best function to apply the product of the last two elements of sublist elements to each element:

Example:

(*Input:*)
 {{x1, y1, z1}, {x2, y2, z2}, ...}  

(*Desired output:*)
{{x1, y1, z1, y1 z1}, {x2, y2, z2, y2 z2}, ...}  

I know I could just use a Do loop with an index k and do it element by element with AppendTo, but I guess there is a faster method.

$\endgroup$

12 Answers 12

11
$\begingroup$

My proposition:

list = RandomReal[1., {100000, 3}];

newlist = Transpose[{Sequence @@ Transpose[list],
    list[[All, 2]] list[[All, 3]]}];

A little benchmark using other answers:

In[51]:= list = RandomReal[1., {1000000, 3}];

In[52]:= newlist = 
   Transpose[{Sequence @@ Transpose[list], 
     list[[All, 2]] list[[All, 3]]}]; // AbsoluteTiming

Out[52]= {0.056405, Null}

In[53]:= newlist2 = {##, Times[##2]} & @@@ list; // AbsoluteTiming

Out[53]= {0.970229, Null}

In[54]:= newlist3 = 
   Append[#, #[[2]] #[[3]]] & /@ list; // AbsoluteTiming

Out[54]= {0.454465, Null}

In[55]:= insertHereThis[list_List, here_Integer, this_] := 
 Insert[#, this[#], here] & /@ list

In[56]:= newlist4 = 
   insertHereThis[list, 2, #[[2]] #[[3]] &]; // AbsoluteTiming

Out[56]= {0.438192, Null}

In[57]:= func = Join[#, Partition[#[[All, -1]] #[[All, -2]], 1], 2] &;

In[58]:= newlist5 = func[list]; // AbsoluteTiming

Out[58]= {0.053084, Null}

In[60]:= newlist6 = 
   ArrayFlatten[{{#, Transpose[{times[#, 2, 3]}]}}] &[
    list]; // AbsoluteTiming

Out[60]= {0.022477, Null}

EDIT: Added new answer (Mr.Wizard's), which now is the fastest in my machine.

EDIT2: Added Leonid's compiled version, and he is right, it is twice faster!

$\endgroup$
10
$\begingroup$

You could use Apply for this, e.g.

list = Transpose[{Range[10], RandomInteger[10, 10], RandomReal[1, 10]}];

{##, Times[##2]} & @@@ list
$\endgroup$
1
  • 2
    $\begingroup$ Note that Apply does not in general benefit from auto-compilation, in contrast to Map (I mention this since efficiency was mentioned in the question's title). $\endgroup$ Commented Mar 7, 2012 at 15:41
8
$\begingroup$

I propose:

func = Join[#, Partition[#[[All, -1]] #[[All, -2]], 1], 2] &;

func @ {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}}
{{1, 2, 3, 6}, {4, 5, 6, 30}, {7, 8, 9, 72}}
$\endgroup$
1
  • $\begingroup$ I edited my answer to include yours in my benchmarks, now yours is the winner :). $\endgroup$
    – FJRA
    Commented Mar 7, 2012 at 15:55
7
$\begingroup$

If you are looking for the ultimate speed, you can use a custom compiled multiplication function, such as

times  = 
  Compile[{{lst, _Real, 2}, {indi, _Integer}, {indj, _Integer}},
     Module[{res = Table[0., {Length[lst]}]},
       Do[res[[i]] = 
           Compile`GetElement[lst, i, indi]*
           Compile`GetElement[lst, i, indj], 
         {i, Length[lst]}
       ];
       res],
     CompilationTarget -> "C", RuntimeOptions -> "Speed"]

Then,

ArrayFlatten[{{#, Transpose[{times[#, 2, 3]}]}}] &[list]

will do the job. My benchmarks on large lists show that this is about twice faster than the much more elegant version of @Mr.Wizard, which is the fastest of the already posted solutions. The reason it is faster is that I save on one column extraction (such as list[[All,2]]), which is a costly operation, by doing multiplication in-place.

$\endgroup$
2
  • $\begingroup$ Leonid, how does this compare to Rojo's method on your system? $\endgroup$
    – Mr.Wizard
    Commented Mar 8, 2012 at 7:53
  • $\begingroup$ @Mr.Wizard Mine is still about 1.5 - 2x faster. The idea on double-Transpose did cross my mind, but I somehow dismissed it without even trying. Mat be that was a mistake. $\endgroup$ Commented Mar 8, 2012 at 10:28
7
$\begingroup$

Here's my innocent but quite efficient

mifunc = Transpose[Append[#, #[[-1]] #[[-2]]]&[Transpose[#]]] &;

Which can also be written:

Append[#, #[[-1]] #[[-2]]] &[#\[Transpose]]\[Transpose] &

Which appears in a Notebook as:

Mathematica graphics

$\endgroup$
1
  • $\begingroup$ Wow, that's a lot faster than I expected. Nicely done! $\endgroup$
    – Mr.Wizard
    Commented Mar 8, 2012 at 7:52
7
$\begingroup$

Can use ReplaceAll:

   list = {{a, b, c}, {e, f, g}};
   list /. {Except[_List, x_], y_, z_} -> {x, y, z, y z}
   

Or Insert:

   ins=Insert[#, #[[2]] #[[3]], -1]&;
   ins/@list

Both give

 {{a, b, c, b c}, {e, f, g, f g}} 

For inserting a function of the data in a row in a column of your choice, define

  insertHereThis[list_List, here_Integer, this_] := 
   Insert[#, this[#], here] & /@ list

and use it as:

  insertHereThis[list, 2, #[[[2]]#[[3]]&]

to get

{{a, b c, b, c}, {e, f g, f, g}}

or as

  insertHereThis[list, 3, 5 &]

to get

{{a, b, 5, c}, {e, f, 5, g}}
$\endgroup$
1
  • $\begingroup$ @Rabbit, good point; thank you. I updated with a fix. $\endgroup$
    – kglr
    Commented May 13 at 21:26
6
$\begingroup$

For example

list = RandomInteger[100, {15, 3}]
{{93, 38, 76}, {72, 28, 8}, {4, 51, 96}, {52, 28, 26},
   {37, 73, 93}, {33, 32, 61}, {11, 64, 96}, {28, 97, 11}, 
   {74, 76, 0}, {83, 4,  9}, {31, 85, 15}, {38, 34, 27}, 
   {42, 54, 75}, {47, 45, 78}, {87, 27, 94}}
Append[#, #[[2]] #[[3]]] & /@ list
{{93, 38, 76, 2888}, {72, 28, 8, 224}, {4, 51, 96, 4896}, 
   {52, 28, 26, 728}, {37, 73, 93, 6789}, {33, 32, 61, 1952}, 
   {11, 64, 96, 6144}, {28, 97, 11, 1067}, {74, 76, 0, 0}, 
   {83, 4, 9, 36}, {31, 85, 15, 1275}, {38, 34, 27, 918}, 
   {42, 54, 75, 4050}, {47, 45, 78, 3510}, {87, 27, 94, 2538}}
$\endgroup$
2
$\begingroup$

This is basically the same as Rojo's idea, but it appears to be 10% faster on my system (M1 Max):

result = Block[{x, y, z},
   {x, y, z} = Transpose[list];
   Transpose[{x, y, z, y z}]
   ];
$\endgroup$
2
$\begingroup$

Using Cases:

lst = {{x1, y1, z1}, {x2, y2, z2}, {x3, y3, z3}};

Cases[lst, x_ :> {Sequence @@ x, Times @@ Rest[x]}]

(*{{x1, y1, z1, y1 z1}, {x2, y2, z2, y2 z2}, {x3, y3, z3, y3 z3}}*)

Or using Internal`PartitionRagged:

{Sequence @@ #, Times @@ Last@Internal`PartitionRagged[#, {1, 2}]} & /@ lst

(*{{x1, y1, z1, y1 z1}, {x2, y2, z2, y2 z2}, {x3, y3, z3, y3 z3}}*)
$\endgroup$
2
$\begingroup$
lst={{x1, y1, z1}, {x2, y2, z2},{x3,y3,z3}}

MapThread[Append,{#,#[[All,2]] #[[All,3]]}]&@lst

(*{{x1,y1,z1,y1 z1},{x2,y2,z2,y2 z2},{x3,y3,z3,y3 z3}} *)

Somewhat simpler:

MapThread[Append[#,#[[2]] #[[3]] ]&,{lst}]

(* {{x1,y1,z1,y1 z1},{x2,y2,z2,y2 z2},{x3,y3,z3,y3 z3}} *)
$\endgroup$
2
$\begingroup$
list = {{a, b, c}, {e, f, g}};

Using Comap (new in 14.0)

Comap[{Splice, Apply[Times] @* Rest}] /@ list

{{a, b, c, b c}, {e, f, g, f g}}

Using MapThread

MapThread[Append[#1, Times @@ #2] &, {list, Rest /@ list}]

{{a, b, c, b c}, {e, f, g, f g}}

$\endgroup$
2
$\begingroup$
list = {{a, b, c}, {e, f, g}};

Using Query and Splice (new in 12.1)

Query[All, {Splice, Apply[Times] @* Rest}] @ list

{{a, b, c, b, c}, {e, f, g, f g}}

$\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.