Alternative ways to AppendTo and Delete in a While loop

Question

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
   ]
  ]

Answer 1

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]

Answer 2

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]];

Answer 3

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
)*