Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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
   ]
  ]
share|improve this question
    
Related: Something faster than Do loops with AppendTo –  jkuczm Jun 12 at 18:58
    
I have seen it before, where the AppendTo in each iteration is independent of results from previous iterations unlike in this case. –  brama Jun 12 at 19:06
2  
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. –  Daniel Lichtblau Jun 12 at 20:50
1  
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. –  jkuczm Jun 12 at 22:25
1  
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. –  Oleksandr R. Jun 13 at 0:05

3 Answers 3

up vote 6 down vote accepted

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
)*
share|improve this answer
    
+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. –  rasher Jun 14 at 22:53
    
@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.) –  Michael E2 Jun 14 at 23:03
    
@MichaelE2. Excellent analysis and a nice idea to Parallelize Min. +1 –  brama Jun 16 at 14:46

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]
share|improve this answer
    
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. >>" –  brama Jun 12 at 21:58
    
@brama The function f above appears to compile without an error. –  Bob Hanlon Jun 12 at 22:52
    
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. –  brama Jun 13 at 1:56
    
+1 for your response –  brama Jun 13 at 15:34
1  
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. –  Michael E2 Jun 13 at 23:07

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]];
share|improve this answer
    
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? –  brama Jun 13 at 15:33
    
@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. –  rasher Jun 13 at 22:43

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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