How to sum up large number of elements in a table quickly?

Question

I have been using Mathematica for some time now but I have a feeling that I am not using it as efficiently as it could be.

I have the following problem which I am unable to figure out and it would be great if someone could point me in the right direction:

I have a function which is of the following form:

f[x_]:= Total[A1/(A2+x),Infinity]; 

where A1 and A2 are very large arrays (2500x2500 real numbers) (Sorry for the way I wrote the function but I haven't figured out how to insert code into the question (not very good at this type of typesetting))

The problem is when I want to create another list (large list) of values of f[x]. It seems that Total is what slows things down here and I was wondering if there is a way to replace Total with something faster.

Any clues?

Answer 1

ClearAll[f];
f[x_, a1_, a2_] := Total[a1/(a2 + x), Infinity];
{a1, a2} = RandomReal[{0, 1}, {2, 2000}];
Timing[f[#, a1, a2] & /@ RandomReal[{0, 1}, 2000]][[1]]

Takes under one second in my machine

Answer 2

Have you tried Table instead of ParallelTable?

Anyway, here's an ugly way to get f a bit faster:

a1 = RandomReal[{0.1, 10}, 10000];
a2 = RandomReal[{0.1, 10}, 10000];

Original definition:

f[x_] := Total[a1/(a2 + x), Infinity]

slightly faster:

fc = Compile[
   {{x, _Real}, {a1, _Real, 1}, {a2, _Real, 1}},
   Module[{t = 0.},
    Do[t = t + a1[[i]]/(a2[[i]] + x), {i, 1, Length[a1]}];
    t
    ],
   CompilationTarget -> "C"
   ];

Table[f[N@x], {x, 1, 2000}]; // Timing
Table[fc[N@x, a1, a2], {x, 1, 2000}]; // Timing
(*
{0.370212, Null}
{0.164774, Null}
*)

One possibility as to why ParallelTable is slower: it unpacks. Try:

SetSystemOptions[
  "PackedArrayOptions" -> "UnpackMessage" -> True];

a1 = RandomReal[{0.1, 10}, 10000];
a2 = RandomReal[{0.1, 10}, 10000];

ParallelTable[f[x], {x, 1, 2000}]; // AbsoluteTiming
Table[f[x], {x, 1, 2000}]; // AbsoluteTiming

There is also added overhead when using ParallelTable. As tkott mentions in a comment, it would be helpful to know what a1 and a2 actually are (their dimensions).

Answer 3

I suspect that your arrays a1 and a2 are not packed, which would case a considerable slow-down.

Observe:

f[x_] := Total[a1/(a2 + x), -1]

n = Ceiling @ Sqrt @ 2000;

a1 = RandomReal[{-99, 99}, {n, n}];
a2 = RandomReal[{-99, 99}, {n, n}];

Developer`PackedArrayQ /@ {a1, a2}

{True, True}

Table[f[i], {i, 1, 50000}] // AbsoluteTiming // First

1.0296018

{a1, a2} = Developer`FromPackedArray /@ {a1, a2};

Table[f[i], {i, 1, 50000}] // AbsoluteTiming // First

66.1285161