Skip to main content

list manipulation - How to use Reap and Sow instead of Append to


I have matrix and and i want to do increment in a do loop and and i want to store in list using append to. It works fine for less values, But when i want to do it for values around 1 million the program is slow.


 x = {{0.1},{0.2}};xm = {{0.4},{0.5}};
Do[datax[i] = {}; dataxm[i] = {};, {i, 1, 2}]


Do[
 x = x + t;
xm = xm + t;
 Do[AppendTo[datax[i], Flatten[{t, x[[i]]}]];, {i, 1, 2}];
Do[AppendTo[dataxm[i], Flatten[{t, xm[[i]]}]];, {i, 1, 2}], {t, 0, 1, 0.1}]


 datax[1]


 {{0., 0.1}, {0.1, 0.2}, {0.2, 0.4}, {0.3, 0.7}, {0.4, 1.1}, {0.5, 1.6}, {0.6, 2.2}, {0.7, 2.9}, {0.8, 3.7}, {0.9, 4.6}, {1., 5.6}}

datax[2]

{{0., 0.2}, {0.1, 0.3}, {0.2, 0.5}, {0.3, 0.8}, {0.4, 1.2}, {0.5, 
  1.7}, {0.6, 2.3}, {0.7, 3.}, {0.8, 3.8}, {0.9, 4.7}, {1., 5.7}}

dataxm[1]

 {{0., 0.4}, {0.1, 0.5}, {0.2, 0.7}, {0.3, 1.}, {0.4, 

  1.4}, {0.5, 1.9}, {0.6, 2.5}, {0.7, 3.2}, {0.8, 4.}, {0.9, 
  4.9}, {1., 5.9}}

 dataxm[2]

 {{0., 0.5}, {0.1, 0.6}, {0.2, 0.8}, {0.3, 1.1}, {0.4, 
  1.5}, {0.5, 2.}, {0.6, 2.6}, {0.7, 3.3}, {0.8, 4.1}, {0.9, 5.}, {1.,
   6.}}

Similar to the above I want to use reap and sow functions to speed it up but i can store only the last value. Why?



 x = {{0.1},{0.2}};xm = {{0.4},{0.5}};


Do[
x = x + t;xm = xm + t;

Do[datax[i] = Reap[Sow[{t, x[[i]]}]][[2, 1]], {i, 1, 2}];

Do[dataxm[i] = Reap[Sow[{t, xm[[i]]}]][[2, 1]], {i, 1, 2}];



, {t, 0, 1, 0.1}]

datax[1]
{{1., {5.6}}}

 datax[2]
{{1., {5.7}}}



datax[1]
{{1., {5.9}}}

datax[2]
{{1., {6.0}}

Can anyone help in fixing this issue? Thanks in advance



Answer



You need olny one Reap for all Sows -- that's primarily the advantage of using them.


Moreover, you may use tags to obtain datax[1] and datax[2]:



x = {{0.1}, {0.2}};
ClearAll[datax];
datax = Association@Reap[
    Do[
     x = x + t;
     Do[
      Sow[
       Flatten[{t, x[[tag]]}], 
       tag
       ],

      {tag, 1, 2}],
     {t, 0, 1, 0.1}],
    _, Rule][[2]]


<|1 -> {{0., 0.1}, {0.1, 0.2}, {0.2, 0.4}, {0.3, 0.7}, {0.4, 1.1}, {0.5, 1.6}, {0.6, 2.2}, {0.7, 2.9}, {0.8, 3.7}, {0.9, 4.6}, {1., 5.6}}, 2 -> {{0., 0.2}, {0.1, 0.3}, {0.2, 0.5}, {0.3, 0.8}, {0.4, 1.2}, {0.5, 1.7}, {0.6, 2.3}, {0.7, 3.}, {0.8, 3.8}, {0.9, 4.7}, {1., 5.7}}|>



Now you can access datax[1] and datax[2] as before.



Because the question changed: This should allow you to assemble more than one list in one go:



data = Merge[
   Reap[
     Do[
      x = x + t;
      xm = xm + t;
      Do[
       Sow[Flatten[{t, x[[i]]}], "datax" -> i];
       Sow[Flatten[{t, xm[[i]]}], "dataxm" -> i]
       ,
       {i, 1, 2}], {t, 0, 1, 0.1}],

     _, #1[[1]] -> Association[#1[[2]] -> #2] &][[2]]
   , Association
   ];

Now data["datax"] and data["dataxm"] should behave like datax and dataxm.



You can obtain essentially the same result much more efficiently with arrays produced by Table:


x = {0.1, 0.2};
xm = {0.4, 0.5};
{datax, dataxm} = Transpose[

   Table[{{{t, t}, x += t}, {{t, t}, xm += t}}, {t, 0, 1, 0.1}], 
   {3, 1, 4, 2}];

Now you have (notice the double brackets):


datax[[1]]
datax[[2]]
dataxm[[1]]
dataxm[[2]]



Even faster for this particular problem is to avoid cursive addition and to use vectorized operations.


The Reap/Sow method from above:


n = 1000000;

x = {0.1, 0.2};
xm = {0.4, 0.5};
First@AbsoluteTiming[
  data = Merge[
     Reap[
       Do[

        x = x + t;
        xm = xm + t;
        Do[
         Sow[Flatten[{t, x[[i]]}], "datax" -> i];
         Sow[Flatten[{t, xm[[i]]}], "dataxm" -> i]
         ,
         {i, 1, 2}], {t, 0., 1., 1./n}],
       _, #1[[1]] -> Association[#1[[2]] -> #2] &][[2]]
     , Association
     ];

  ]


11.4845



The Table method from above:


x = {0.1, 0.2};
xm = {0.4, 0.5};
First@AbsoluteTiming[
  {datax, dataxm} = 

    Transpose[
     Table[{{{t, t}, x += t}, {{t, t}, xm += t}}, {t, 0., 1., 
       1./n}], {3, 1, 4, 2}];
  ]


2.74062



Vectorized version:


x = {0.1, 0.2};

xm = {0.4, 0.5};
First@AbsoluteTiming[
  tlist = Subdivide[0., 1., n];
  slist = Accumulate[tlist];
  datax2 = {
    Transpose[{tlist, x[[1]] + slist}],
    Transpose[{tlist, x[[2]] + slist}]
    };
  dataxm2 = {
    Transpose[{tlist, xm[[1]] + slist}],

    Transpose[{tlist, xm[[2]] + slist}]
    };
  ]


0.061355



So, the latter is 44/187 time faster than the other methods. So you should take these considerations into account when using Reap and Sow.


Errors:


Max[Abs[data["datax"][1] - datax[[1]]]]

Max[Abs[data["datax"][2] - datax[[2]]]]
Max[Abs[data["dataxm"][1] - dataxm[[1]]]]
Max[Abs[data["dataxm"][2] - dataxm[[2]]]]
Max[Abs[datax - datax2]]
Max[Abs[dataxm - dataxm2]]


0.


0.


0.



0.


5.82077*10^-11


5.82077*10^-11



Comments

Post a Comment

Popular posts from this blog

functions - Get leading series expansion term?

Given a function f[x] , I would like to have a function leadingSeries that returns just the leading term in the series around x=0 . For example: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x)] x and leadingSeries[(1/x + 2 + (1 - 1/x^3)/4)/(4 + x)] -(1/(16 x^3)) Is there such a function in Mathematica? Or maybe one can implement it efficiently? EDIT I finally went with the following implementation, based on Carl Woll 's answer: lds[ex_,x_]:=( (ex/.x->(x+O[x]^2))/.SeriesData[U_,Z_,L_List,Mi_,Ma_,De_]:>SeriesData[U,Z,{L[[1]]},Mi,Mi+1,De]//Quiet//Normal) The advantage is, that this one also properly works with functions whose leading term is a constant: lds[Exp[x],x] 1 Answer Update 1 Updated to eliminate SeriesData and to not return additional terms Perhaps you could use: leadingSeries[expr_, x_] := Normal[expr /. x->(x+O[x]^2) /. a_List :> Take[a, 1]] Then for your examples: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x), x] leadingSeries[Exp[x], x] leadingSeries[(1/x + 2 + (1 - 1/x...
Post a Comment
Read more

mathematical optimization - Minimizing using indices, error: Part::pkspec1: The expression cannot be used as a part specification

I want to use Minimize where the variables to minimize are indices pointing into an array. Here a MWE that hopefully shows what my problem is. vars = u@# & /@ Range[3]; cons = Flatten@ { Table[(u[j] != #) & /@ vars[[j + 1 ;; -1]], {j, 1, 3 - 1}], 1 vec1 = {1, 2, 3}; vec2 = {1, 2, 3}; Minimize[{Total@((vec1[[#]] - vec2[[u[#]]])^2 & /@ Range[1, 3]), cons}, vars, Integers] The error I get: Part::pkspec1: The expression u[1] cannot be used as a part specification. >> Answer Ok, it seems that one can get around Mathematica trying to evaluate vec2[[u[1]]] too early by using the function Indexed[vec2,u[1]] . The working MWE would then look like the following: vars = u@# & /@ Range[3]; cons = Flatten@{ Table[(u[j] != #) & /@ vars[[j + 1 ;; -1]], {j, 1, 3 - 1}], 1 vec1 = {1, 2, 3}; vec2 = {1, 2, 3}; NMinimize[ {Total@((vec1[[#]] - Indexed[vec2, u[#]])^2 & /@ R...
Post a Comment
Read more

What is and isn't a valid variable specification for Manipulate?

I have an expression whose terms have arguments (representing subscripts), like this: myExpr = A[0] + V[1,T] I would like to put it inside a Manipulate to see its value as I move around the parameters. (The goal is eventually to plot it wrt one of the variables inside.) However, Mathematica complains when I set V[1,T] as a manipulated variable: Manipulate[Evaluate[myExpr], {A[0], 0, 1}, {V[1, T], 0, 1}] (*Manipulate::vsform: Manipulate argument {V[1,T],0,1} does not have the correct form for a variable specification. >> *) As a workaround, if I get rid of the symbol T inside the argument, it works fine: Manipulate[ Evaluate[myExpr /. T -> 15], {A[0], 0, 1}, {V[1, 15], 0, 1}] Why this behavior? Can anyone point me to the documentation that says what counts as a valid variable? And is there a way to get Manpiulate to accept an expression with a symbolic argument as a variable? Investigations I've done so far: I tried using variableQ from this answer , but it says V[1...
Post a Comment
Read more