4
$\begingroup$

I have large array of some functions (mainly polynomials). I need to evaluate them at a set of discrete points. Is there any faster way than this? ParallelTable is not helping since this part of code is already inside parallel loop.

First[
  Timing[
    Table[
      Table[
        i/t^3 + Sqrt[j]*Sin[t] + i*j*s^12 - j*Cos[t*s], 
        {i, 1, 300}, {j, 1, 300}], 
      {t, Table[RandomReal[], {10}]}, {s, Table[RandomReal[], {10}]}]]]

This piece of code returns 1.279 s on my i5 4570.

$\endgroup$
2
$\begingroup$

Your code runs on my computer at about the same speed as your, namely 1.25 sec. However, with four processors my computer provides almost a factor of four speed-up with ParallelTable, applied to the outer loops.

First[Timing[ParallelTable[Table[i/t^3 + Sqrt[j]*Sin[t] + i*j*s^12 - j*Cos[t*s], 
{i, 1, 300}, {j, 1, 300}], {t, RandomReal[{0, 1}, 10]}, {s, RandomReal[{0, 1}, 10]}]]]
(* 0.34375 *)

Applying ParallelTable to the inner loops is counterproductive, because the parallel overhead more than offsets the savings from parallelization. I had hoped that moving some function evaluations out of the inner loops would increase the speed, but it does not.

First[Timing[ParallelTable[cts = Cos[t*s]; s12 = s^12; st = Sin[t]; 
    Table[i/t^3 + Sqrt[j]*st + i*j*s12 - j*cts, {i, 1, 300}, {j, 1, 300}], 
    {t, RandomReal[{0, 1}, 10]}, {s, RandomReal[{0, 1}, 10]}]]]
(* 0.359375 *)

Incidentally, replacing Table[RandomReal[], {10}] by RandomReal[{0, 1}, 10] has no noticeable impact on speed, as would be expected. It just seemed cleaner too me.

$\endgroup$
1
$\begingroup$

Using the listability of the involved functions can speed the inner part of the loop quite a bit! The deeper indices i and j are also the most important to optimize, since t and s only run over 10 values each.

First, my timings of OP and bbgodfrey (quad-core MacBook Pro i7):

s1 = RandomReal[{0,1}, 10];
t1 = RandomReal[{0,1}, 10];

(* OP *)
First[AbsoluteTiming[
  Table[Table[
    i/t^3 + Sqrt[j]*Sin[t] + i*j*s^12 - j*Cos[t*s], {i, 1, 300}, {j, 
     1, 300}], {t, t1}, {s, s1}]]]
(* 2.820927 *)

(* bbgodfrey *)
First[AbsoluteTiming[ParallelTable[cts = Cos[t*s]; s12 = s^12; st = Sin[t]; 
    Table[i/t^3 + Sqrt[j]*st + i*j*s12 - j*cts, {i, 1, 300}, {j, 1, 300}], 
    {t, t1}, {s, s1}]]]
(* 1.101128 *)

The last timing is from running bbgodfrey's code a second time, so that it is not penalized from the time it takes to launch the parallell kernels.

Here is my suggestion:

First[AbsoluteTiming[
  jvec = N@Range[300];
  sqrtjvec = Sqrt[jvec];
  Table[
   indepOfi = sqrtjvec*Sin[t] - jvec*Cos[t*s];
   Table[
    i/t^3 + i*jvec*s^12 + indepOfi
    , {i, 1, 300}
    ]
   , {t, t1}
   , {s, s1}
   ]
  ]
 ]
(* 0.296427 *)

My solution uses vectorized operations over the innermost index j, and also the fact that Sqrt is usually faster for machine-precision input, which is what we will end up with anyway since t and s are machine precision. It also makes a difference that I pull indepOfi out of the inner Table, as bbgodfrey expected.

Probably it does not make sense to use a ParallelTable with my solution, as the overhead would swallow the gains from vectorization. There might be ways to vectorize over other dimensions here as well, and build up the answer using Outer or similar, but probably only vectorizing over the larger dimensions i and j is worth it.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.