1
$\begingroup$

I have the following code:

ClearAll[rt1, rt2]
rt1 = Transpose@
    RecurrenceTable[{o[n] == 0.88 o[n - 1] + 0.36 e[n - 1] + 30,
      e[n] == 0.64 e[n - 1] + 0.11 h[n - 1],
      h[n] == 0.89 h[n - 1] + 30,
      o[0] == 2400, e[0] == 1800, h[0] == 3500}, {o, e, h}, {n, 
      0, #}] &;
Row[ListPlot[#@50, BaseStyle -> PointSize[Medium], ImageSize -> 500, 
    PlotLegends -> {"Pollutants: L. Ontario", "Pollutants: L. Erie", 
      "Pollutants: L. Huron"}] & /@ {rt1}]

enter image description here

which plots the discrete dynamical system modeling pollution in the some lakes.

enter image description here

What I'd like to do, is to present the DiscretePlot described above, along with the map of the the lakes, and use Manipulate to control the time steps showing how the system changes with time.
As I move the slider, I'd like circles in the respective lakes to change size showing the amount of pollution in each lake, as such:

enter image description here

Is it possible to accomplish this with Manipulate? My graphics skills with Mathematica are very basic, and thus far I have not been able to make anything work.

Could someone at least point towards a template I might be able to modify to accomplish this? Much appreciated.

enter image description here

$\endgroup$
  • $\begingroup$ So basically you would like to the the circles and the number in them changing as the Manipulate slider moves? $\endgroup$ – Öskå Apr 25 '15 at 17:28
  • $\begingroup$ Yes! But the discrete plot above should change with it as well. $\endgroup$ – Lucif3r Apr 25 '15 at 17:36
  • $\begingroup$ Of that, I am not sure. $\endgroup$ – Lucif3r Apr 25 '15 at 17:45
  • $\begingroup$ So you mean a point on the discrete plot would be highlighted as well as the time changes? $\endgroup$ – Öskå Apr 25 '15 at 17:47
  • $\begingroup$ Either that, or the plot itself would be "building" itself as time progresses. I haven't been able to accomplish any. $\endgroup$ – Lucif3r Apr 25 '15 at 17:48
1
$\begingroup$

A pretty rough solution, you should be able to make it look better but here is the idea. I put the pos on random lakes, put them where ever you wish.

i = Import@"http://i.stack.imgur.com/JL5No.png";
pos1 = {500, 300}; 
pos2 = {320, 160}; 
nmax = 50;
Manipulate[
 Column[{
  First[ListPlot[(#@50)[[All, 1 ;; n]], BaseStyle -> PointSize[Medium],
          ImageSize -> 350, PlotRange -> {{0, nmax + 1}, {0, Max@rt1@500 + 1}}] & /@ {rt1}],
  Show[{i, 
   Graphics[{Opacity@.5, FaceForm@Red, 
    {Disk[#, 5*Log@((rt1@50)[[#2, n]])],
     Text[(rt1@50)[[#2, n]], #]} & @@@ Thread@{{pos1, pos2}, {1, 2}}}]}]},
 Alignment -> Center], {n, 1, nmax, 1}]

enter image description here

You should play with the Disk size to make it more accurate, my answer is just here to show you how it could be done.

$\endgroup$
  • $\begingroup$ For some reason I cannot get the thing to add the 3rd circle. I should have one for every plot line. Many thanks. $\endgroup$ – Lucif3r Apr 25 '15 at 19:13
  • $\begingroup$ Nevermind. I got it! $\endgroup$ – Lucif3r Apr 25 '15 at 19:29
  • $\begingroup$ @JohnWayne360 Good :) Just need to add a new pos and {1, 2, 3} :) $\endgroup$ – Öskå Apr 25 '15 at 19:53

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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