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$

11 Answers 11

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$ 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
    Mar 7, 2012 at 15:55
7
$\begingroup$

Can use ReplaceAll:

   list = {{a, b, c}, {e, f, g}};
   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$
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
    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$ 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
    Mar 8, 2012 at 7:52
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$
list = {{a, b, c}, {e, f, g}};

Splice came with V 12.1

{Splice @ #, Splice @ Rest @ #} & /@ list

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

Or slot-free with Query

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

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

$\endgroup$
1
$\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$
1
$\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$
1
$\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$

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.