2
$\begingroup$

Is there an alternative way to do AppendTo and Delete and also replace k0 during every update? I want to avoid the 3- CopyTensors in the following code which probably are the reason behind the memory and performance problems for large values of n.

f = Compile[{{n, _Integer}},
   Module[{Fk = Table[RandomReal[{0, 1}], {5}, {n}], k0 = Table[RandomReal[{0, 1}], {n}], TT = 0.1, ksum, i = 0},
    While[TT > 0 ,
     ksum = Total@Fk;
     k0 = MapThread[Min[#1, #2 RandomReal[{0, 1}]] &, {k0, ksum}];
     TT = Round[Total@k0, 0.01]; i++;
     Fk = Delete[Fk, {1}];
     AppendTo[Fk, k0];
    ]; i
   ]
  ]
$\endgroup$
8
  • $\begingroup$ Related: Something faster than Do loops with AppendTo $\endgroup$
    – jkuczm
    Commented Jun 12, 2014 at 18:58
  • $\begingroup$ I have seen it before, where the AppendTo in each iteration is independent of results from previous iterations unlike in this case. $\endgroup$
    – brama
    Commented Jun 12, 2014 at 19:06
  • 2
    $\begingroup$ To what extent is your code dependent on ordering? You might try just using Fk[[1]] = k0 without the deletion, if there is no order dependency (I cannot tell for certain although i suspect it has no such dependency). If there is a dependency on the ordering then you could maintain a "current" index and iterate from there modulo the length e.g. if length is 6 and current is 4 one would iterate over elements 4,5,6,1,2,3 in that order. Standard trick. $\endgroup$ Commented Jun 12, 2014 at 20:50
  • 1
    $\begingroup$ Daniel have written how to iterate using "current" index. You have it already in your code it's i. I think using Fk[[Mod[i, 5] + 1]] = k0; instead of Fk = Delete[Fk, {1}]; AppendTo[Fk, k0]; would do the trick. $\endgroup$
    – jkuczm
    Commented Jun 12, 2014 at 22:25
  • 1
    $\begingroup$ RotateLeft and then set the last element (previously the first) to the new value. Or the other way around, if you like. Dan's suggestion is more efficient if you don't mind keeping track of where you're supposed to start from. $\endgroup$ Commented Jun 13, 2014 at 0:05

3 Answers 3

6
$\begingroup$

I have one improvement to suggest. Instead of finding the minimums with MapThread, use a compiled version that threads itself over the lists:

mappedmin = Compile[{{x, _Real, 1}},
   Min[x],
   RuntimeAttributes -> {Listable}, Parallelization -> True];

We can compare using this with the OP's and with Daniel Lichtblau's improvement.

fmm = Compile[{{n, _Integer}}, 
   Module[{Fk = Table[RandomReal[{0, 1}], {5}, {n}], 
     k0 = Table[RandomReal[{0, 1}], {n}], TT = 0.1, ksum, i = 0}, 
    While[TT > 0,
     ksum = Total@Fk;
     k0 = mappedmin[Transpose@{k0, RandomReal[{0, 1}, n] ksum}];
     TT = Round[Total@k0, 0.01]; i++;
     Fk = Delete[Fk, {1}];
     AppendTo[Fk, k0];]; i],
   CompilationOptions -> {"InlineExternalDefinitions" -> True}];

f[10^6]   // AbsoluteTiming
fmm[10^6] // AbsoluteTiming
(*
  {30.814108, 193}
  {18.011360, 193}
*)

If Parallelization is turned off, it runs about 1+ sec. slower.

Here is an implementation of Daniel's suggestion, similar to rasher's f2c, without and with mappedmin. (I also got rid of the intermediate variable ksum, since that was a source of one of the CopyTensor calls, and used vectorized multiplication.)

dl = Compile[{{n, _Integer}}, 
   Module[{Fk = RandomReal[{0, 1}, {5, n}], 
     k0 = RandomReal[{0, 1}, n], TT = 0.1, i = 0},
    While[TT > 0,
     i++;
     k0 = MapThread[Min[#1, #2 RandomReal[{0, 1}]] &, {k0, Total@Fk}];
     TT = Round[Total@k0, 0.01];
     Fk[[Mod[i, 5, 1]]] = k0;
     ]; i]
   ];
dlmm = Compile[{{n, _Integer}}, 
   Module[{Fk = RandomReal[{0, 1}, {5, n}], 
     k0 = RandomReal[{0, 1}, n], TT = 0.1, i = 0},
    While[TT > 0,
     i++;
     k0 = mappedmin[Transpose@{k0, RandomReal[{0, 1}, n] Total@Fk}];
     TT = Round[Total@k0, 0.01];
     Fk[[Mod[i, 5, 1]]] = k0;
     ]; i],
   CompilationOptions -> {"InlineExternalDefinitions" -> True}];

dl[10^6]   // AbsoluteTiming
dlmm[10^6] // AbsoluteTiming
(*
  {25.698229, 193}
  {13.146244, 193}
*)

Again mappedmin saves about 12 sec. (40% of the timing of the OP's f).

If we compare mappedmin with MapThread, we see it takes about 55% of the time that a compiled MapThread takes, which does not completely account for the 12 sec. saving above:

mapthreadmin = Compile[{{x1, _Real, 1}, {x2, _Real, 1}},
   MapThread[Min, {x1, x2}]
   ];

data = RandomReal[1, {2, 10^6}];
Do[mapthreadmin[data[[1]], data[[2]]], {18}] // AbsoluteTiming // First
Do[mappedmin[Transpose@data], {18}]          // AbsoluteTiming // First
(*
  1.010342
  0.549180
)*
$\endgroup$
3
  • $\begingroup$ +1 for the analysis (this deserves more votes!). Interestingly, I tested second here, slower than I expected (caveat: on loungebook). My hunch (lacking an OP explanation of goal) is instead of the machinations, this problem can be represented as a compound distribution sum, and just pull random variates from that, which I'd venture would be quite fast. $\endgroup$
    – ciao
    Commented Jun 14, 2014 at 22:53
  • 1
    $\begingroup$ @rasher Weekends can be slow, especially if the weather is nice or there's a World Cup on. Yours deserves more votes, too. (I already upvoted.) $\endgroup$
    – Michael E2
    Commented Jun 14, 2014 at 23:03
  • $\begingroup$ @MichaelE2. Excellent analysis and a nice idea to Parallelize Min. +1 $\endgroup$
    – brama
    Commented Jun 16, 2014 at 14:46
8
$\begingroup$

Table is unnecessary with RandomReal and just adds additional time

n = 10; m = 10^6;

(SeedRandom[100];
   Table[RandomReal[{0, 1}], {5}, {n}]) ==
 (SeedRandom[100];
   Fk = RandomReal[{0, 1}, {5, n}])

True

(SeedRandom[100];
   Table[RandomReal[{0, 1}], {n}]) ==
 (SeedRandom[100];
   k0 = RandomReal[{0, 1}, n])

True

Alternate ways of deleting first list in Fk

Delete[Fk, {1}] == Drop[Fk, 1] == Rest[Fk]

True

Timing[Do[Delete[Fk, {1}], {m}];]

{3.029095, Null}

Timing[Do[Drop[Fk, 1], {m}];]

{1.079259, Null}

Timing[Do[Rest[Fk], {m}];]

{1.084052, Null}

Faster alternative to AppendTo

Off[Set::write]

Timing[Do[e1 = AppendTo[Rest[Fk], k0], {m}];]

{11.440818, Null}

On[Set::write]

Timing[Do[e2 = Flatten[{Rest[Fk], {k0}}, 1], {m}];]

{6.973775, Null}

e1 == e2

True

f = Compile[{{n, _Integer}}, Module[{Fk = RandomReal[{0, 1}, {5, n}], k0 = RandomReal[{0, 1}, n],
 TT = 0.1, ksum, i = 0}, While[TT > 0, ksum = Total@Fk;
 k0 = MapThread[Min[#1, #2 RandomReal[{0, 1}]] &, {k0, ksum}];
 TT = Round[Total@k0, 0.01]; i++;
 Fk = Flatten[{Rest[Fk], {k0}}, 1]];]; i]
$\endgroup$
4
  • $\begingroup$ I like the alternatives for Delete and AppendTo, but using Flatten[{Rest[Fk], {k0}}, 1] in the pace of Fk = Delete[Fk, {1}]; AppendTo[Fk, k0]; is giving an error during execution. Weird!!. It says "CompiledFunction::cflist: Nontensor object generated; proceeding with uncompiled evaluation. >>" $\endgroup$
    – brama
    Commented Jun 12, 2014 at 21:58
  • $\begingroup$ @brama The function f above appears to compile without an error. $\endgroup$
    – Bob Hanlon
    Commented Jun 12, 2014 at 22:52
  • $\begingroup$ Agree. Thank you. I like your alternative ways. But, your code gives 2 copytensors and 1 MainEvaluate (my code had 3 copytensor). I am basically looking for a way to get rid of those, because, my original code (I only show a sample test code here) has 38 copytensor and I was trying to find ways to get rid of them. $\endgroup$
    – brama
    Commented Jun 13, 2014 at 1:56
  • 1
    $\begingroup$ I think you really ought to test the timings with each of the three methods inside Compile. I see only a small difference between them. $\endgroup$
    – Michael E2
    Commented Jun 13, 2014 at 23:07
7
$\begingroup$

Sticking with the machinations of your code (might be worthwhile to explain what you're trying to accomplish and the over-arching problem, might be an elegant way to realize it), here's a modification that does away with one of the CopyTensor, and is 50-100% faster:

f = Compile[{{n, _Integer}},
  Module[{Fk = RandomReal[1, {5, n}], k0 = RandomReal[1, n], TT = 0.1, ksum, i = 0},
   While[TT > 0,
       ksum = Total@Fk;
       Fk = RotateLeft[Fk];
       k0 = Fk[[-1]] = MapThread[Min, {k0, ksum RandomReal[1, n]}];
       TT = Round[Total@k0, 0.01];
       i++;];i]]

Updates:

This cuts down to only one CopyTensor, and is about 25%+ faster again than above solution:

f2c = Compile[{{n, _Integer}},
   Module[{Fk = RandomReal[1, {5, n}], k0 = RandomReal[1, n], TT = 0.1, ksum, i = 0},
    While[TT > 0,
     k0 = Fk[[Mod[i, 5, 1]]] = MapThread[Min, {k0, Total@Fk  RandomReal[1, n]}];
     TT = Round[Total@k0, 0.01];
     i++;];i]];

And this has no CopyTensor operations. Seems slightly faster than first above, not quite as fast as second, did not check memory utilization. Note this internally shuffles things - result is the same, but if you need to poke at internals, take that into account:

f2d = Compile[{{n, _Integer}},
   Module[{Fk = RandomReal[1, {6, n}], TT = 0.1, i = 0},
    While[TT > 0,
     Fk[[-1]] = 
      Fk[[Mod[i, 5, 1]]] = 
       MapThread[
        Min, {Fk[[-1]], (Total@(Fk[[;; -2]]))  RandomReal[1, n]}];
     TT = Round[Total@Fk[[-1]], 0.01];
     i++;];i]];
$\endgroup$
2
  • $\begingroup$ The original code is posted at mathematica.stackexchange.com/questions/50599/… I will make these changed in that code, but will it be possible to getrid of even those two copytensors? $\endgroup$
    – brama
    Commented Jun 13, 2014 at 15:33
  • $\begingroup$ @brama: Did not look at the "original code" - again, I'd rather an explanation of goal than to "decode" someone's code. In any case, see updates to my answer. $\endgroup$
    – ciao
    Commented Jun 13, 2014 at 22:43

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.