Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2001
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2001

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Lists and speed

  • To: mathgroup at smc.vnet.net
  • Subject: [mg30244] Re: [mg30142] Lists and speed
  • From: Daniel Lichtblau <danl at wolfram.com>
  • Date: Fri, 3 Aug 2001 00:56:13 -0400 (EDT)
  • References: <200107310827.EAA17587@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

Stuart Humphries wrote:
> 
> Hi,
> 
> About a month ago I submitted a question about lists  and received some
> very useful help (summarised below). However, although my program (a
> coupled map lattice for population dynamics) now works well with Ted
> Ersek's modifications, it still takes over 20 minutes (compared to the
> original 40 minutes) to run.
> A colleague has just coded the same thing in another system, which runs in around 40 _seconds_...is this unusual?
> I was happy to trade-off speed for faster development time compared to
> Pascal etc, but the difference here seems so huge that I'm concerned that
> my Mathematica programming is still way-off.
> Any thoughts welcome.
> Thanks
> Stuart
> 
> >The program considers a 10 by 10 lattice of populations, and implements
> >equations for population growth and then manipulated the lattice (list) to
> >incorporate dispersal between populations, the whole process is repeated
> >for about 1200 'generations' , and this itself form part of a larger (100+
> >) repetition.
> 
> >Stuart Humphries had a Mathematica program that was running rather slow.
> >The poor performance was most likely do to the use of  AppendTo[data, ..]
> >inside a Do loop.
> >Instead of using AppendTo[data, ...] use the following:
> >
> >
> >Do[  (
> >    blah; blah; ....;
> >    data = {data, stuff}
> >), {n, 500}]
> >Flatten[data]
> >------------------------
> >However, that will not work if the final result is supposed to be a matrix.
> >In that case do the following instead.
> >
> >
> >Module[{h},
> >    Do[  (
> >       blah; blah; ....;
> >       data = h[data, stuff]
> >    ), {n, 500}]
> >    List@@Flatten[data]
> >]
> >
> >
> >--------------
> >Cheers,
> >Ted Ersek
> 
> Dr Stuart Humphries
> FBA/NERC Research Fellow
> 
> Division of Environmental and Evolutionary Biology
> Graham Kerr Building
> University of Glasgow
> Glasgow G12 8QQ
> Tel: +44 (0)141 330 6621
> Fax: +44 (0)141 330 5971
> http://www.gla.ac.uk/Acad/IBLS/DEEB/sh

I dug the original from the archives and include it below, with an
attempt at a faster version afterward.

----------------------------------------

Subject: [mg30244] [mg29568] List problems 
From: Stuart Humphries <s.humphries at bio.gla.ac.uk>
To: mathgroup at smc.vnet.net


Hi,

I'm very new to Mathematica, but I've cobbled together some code for a 
coupled map lattice model to look at population dynamics. My problem is 
that although the code generates the results I'm interested in, it runs 
incredibly slowly. I think I've narrowed the problem down to the way in 
which I handle the arrays (lists) of population densities, but I'm
stumped 
as to how to code a faster implementation.
At present my code does the following:

Do[
(*Apply reproduction function to popn matrix, and remove dispersing 
                          individuals*)
 popn1 = Map[remain, Map[f, popn]];
(*generate array holding dispersing individuals*)
 dispersers = Map[m, Map[f, popn]];
(*divide all dispersers by 4 to get single direction dispersers*)
 dispersers = dispersers/4;
(*distribute dispersers*)
 z = Table[z, {z, 1, 9}];
 y = Table[y, {y, 2, 10}];
 popn1[[1, All]] = dispersers[[10, All]] + popn1[[1, All]];
(*add bottom row to top*)
 popn1[[10, All]] = dispersers[[1, All]] + popn1[[10, All]];
 popn1[[All, 1]] = dispersers[[All, 10]] + popn1[[All, 1]];
(*add right col to left*)
 popn1[[All, 10]] = dispersers[[All, 1]] + popn1[[All, 10]];
(*add left col to right*)
 popn1[[z, All]] = dispersers[[y, All]] + popn1[[z, All]];
(*add to next row up from last 3 rows*)
 popn1[[y, All]] = dispersers[[z, All]] + popn1[[y, All]];
(*add to next row down from first 3 rows*)
 popn1[[All, z]] = dispersers[[All, y]] + popn1[[All, z]];
(*add to next col left from right 3 cols*)
 popn1[[All, y]] = dispersers[[All, z]] + popn1[[All, y]];
(*add to next col right from left 3 cols*)
 popn = popn1;
(*If generations is between range specified, add total population size
to 
 ensemble array, and patch population size to patch array*)
 If[g1 <= g <= g2, {AppendTo[ensemblesize, {Apply[Plus,
Flatten[popn]]}], 
       AppendTo[patchsize, {popn[[5, 5]]}]}]; Unset[popn1];
Unset[dispersers];
 , {g, gmax}];


which is repeated for about 1200 'generations' (gmax), and this itself
form 
part of a larger 100+ repetition.

I hope this makes sense to someone out there.
Any suggestions would be very welcome.

Thanks,
Stuart

----------------------------------------

There is not enough shown to reconstruct exactly what is wanted. The
code below will give some idea of how it might be made to run alot
faster. It uses Compile and also avoids part extraction by adding
directly cyclicly rotated (row and columnwise, left and right) copies of
the dispersion matrix. I think what I did here accurately emulates the
code above, although I did not understand the corresponding comments. I
generated a random matrix each time for dispersers. I assume you want
popn updated (otherwise why loop beyond g2?) but do not do that in the
fragment below.

Assuming the missing details involve functions that Compile can handle,
this should give an accurate picture of speed; it was run on a 300 Mhz
machine.

popEvolve = Compile[{{gmax,_Integer}, {g1,_Integer},
    {g2,_Integer}, {popn,_Real,2}},
  Module[
	{popn1=popn, sizindx=0, ensemblesize, patchsize, dispersers, nr, nc},
 	{nr,nc} = Dimensions[popn];
    ensemblesize = Table[0., {g2-g1+1}];
    patchsize = Table[0., {g2-g1+1}];
    Do [
	  dispersers = Table[Random[],{nr},{nc}]/4;
      popn1 += RotateLeft[dispersers] + RotateRight[dispersers] +
	    Map[RotateLeft,dispersers] + Map[RotateRight,dispersers]; 
      If [g1 <= g <= g2,
        sizindx++;
		ensemblesize[[sizindx]] = Apply[Plus, Flatten[popn1]];
		patchsize[[sizindx]] = popn1[[5, 5]];
		]
    , {g, gmax}];
    {ensemblesize,patchsize}
    ], {{nr,_Integer}, {nc,_Integer}}
  ]

In[18]:= SeedRandom[1111]

In[19]:= mm = Table[Random[], {10}, {10}];

In[20]:= Timing[popEvolve[1200, 2, 4, mm];]
Out[20]= {0.78 Second, Null}

In[21]:= Timing[Do[popEvolve[1200, 2, 4, mm], {100}]]
Out[21]= {78.15 Second, Null}


Daniel Lichtblau
Wolfram Research


  • Prev by Date: Re: Any quantum chemists / physicists?
  • Next by Date: Re: Any quantum chemists / physicists?
  • Previous by thread: Re: Lists and speed
  • Next by thread: RE: SquareFreeQ vs. MoebiusMu