Search All of the Math Forum:

Views expressed in these public forums are not endorsed by NCTM or The Math Forum.

Notice: We are no longer accepting new posts, but the forums will continue to be readable.

Topic: Alternative to Table
Replies: 2   Last Post: Mar 7, 2013 10:47 PM

 Messages: [ Previous | Next ]
 daniel.lichtblau0@gmail.com Posts: 20 Registered: 7/23/12
Re: Alternative to Table
Posted: Mar 7, 2013 3:58 AM

On Tuesday, March 5, 2013 9:13:02 PM UTC-6, Iv=E1n Lazaro wrote:
> Dear group:
>

> I'm trying to build a code that evolves a grid of dimension 2gridDim+1
> over a time timeDim. I managed to build such a code using Table with
> only one problem: when the value of timeDim is of thousands, the time
> it takes to evaluate is absurd. I tried to find an alternative way to
> write this code, using NestList withouth success. NestList is able to
> have an interator if I write it like #[[1]]+1, but it doesn't work
> when I use it as an element of a list.
>
> I let here a toy working example. Any input would be most appreciated.
>
> Iv=E1n.
>
>
> gridDim = 2; timeDim = 3;
> list = ConstantArray[0, {2, 2*gridDim + 1, timeDim}];
>
> Table[list[[1, i, 1]] = Sin[-(gridDim + 1.) + i], {i, 1,
> 2*gridDim + 1}];
> Table[list[[2, i, 1]] = RandomReal[{0, 2*Pi}], {i, 1, 2*gridDim + 1}];
>
>
> zUpdate[list_, t_] := Module[{lista},
> lista = {};
> lista = list;
> Table[If[i + 1 > 2*gridDim + 1,
> lista[[1, i, t + 1]] = list[[1, i, t]] (list[[2, 1, t]] -
> list[[2, i - 1, t]]), If[
> i - 1 == 0,
> lista[[1, i, t + 1]] = list[[1, i, t]] (list[[2, i + 1, t]] -
> list[[2, 2*gridDim + 1, t]]),
> lista[[1, i, t + 1]] = list[[1, i, t]] (list[[2, i + 1, t]] -
> list[[2, i - 1, t]])]],
> {i, 1, 2*gridDim + 1}];
> lista
> ];
>
>
> pUpdate[list_, t_] := Module[{lista},
> lista = {};
> lista = list;
> Table[If[i + 1 > 2*gridDim + 1,
> lista[[2, i, t + 1]] = Mod[list[[1, i, t + 1]] (list[[2, 1, t]] -
> list[[2, i - 1, t]]), 2*Pi],
> If[i - 1 == 0,
> lista[[2, i, t + 1]] = Mod[list[[1, i, t + 1]] (list[[2, i + 1,
> t]] - list[[2, 2*gridDim + 1, t]]), 2*Pi],
> lista[[2, i, t + 1]] = Mod[ list[[1, i, t + 1]] (list[[2, i + 1,
> t]] - list[[2, i - 1, t]]), 2*Pi]]], {i, 1, 2*gridDim + 1}];
> lista
> ];
>
>
> Do[
> list = zUpdate[list, i];
> list = pUpdate[list, i];, {i, 1, timeDim - 1}];
> list

Your update functions are doing approximately infinitely many array copies. Instead you could alter the thing in place by using HoldFirst attributes for those functions. Below is pedestrian Do-loop code for this. I also simplified the updates by making use of Mod to handle the iterator edge value cases.

I will illustrate on an example where the relevant dimensions are 200 and 3000 respectively.

gridDim = 200; timeDim = 3000;
list = ConstantArray[0, {2, 2*gridDim + 1, timeDim}];

AbsoluteTiming[
Do[list[[1, i, 1]] = Sin[-(gridDim + 1.) + i], {i, 1, 2*gridDim + 1}];
Do[list[[2, i, 1]] = RandomReal[{0, 2*Pi}], {i, 1, 2*gridDim + 1}];]

Out[3]= {0.035499, Null}

SetAttributes[zUpdate, HoldFirst]
zUpdate[list_, t_] :=

Do[list[[1, i, t + 1]] =
list[[1, i, t]] *(list[[2, Mod[i + 1, 2*gridDim + 1, 1], t]] -
list[[2, Mod[i - 1, 2*gridDim + 1, 1], t]]),
{i, 1, 2*gridDim + 1}]

SetAttributes[pUpdate, HoldFirst]
pUpdate[list_, t_] :=

Do[list[[2, i, t + 1]] =
Mod[list[[1, i,
t + 1]] (list[[2, Mod[i + 1, 2*gridDim + 1, 1], t]] -
list[[2, Mod[i - 1, 2*gridDim + 1, 1], t]]), 2*Pi], {i, 1,
2*gridDim + 1}]

Now run the thing.

AbsoluteTiming[Do[zUpdate[list, i];
pUpdate[list, i];, {i, 1, timeDim - 1}];]

Out[8]= {18.619950, Null}

Daniel Lichtblau
Wolfram Research

Date Subject Author
3/5/13 Iván Lazaro
3/7/13 daniel.lichtblau0@gmail.com
3/7/13 Iván Lazaro