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$
8
  • $\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, 2015 at 17:28
  • $\begingroup$ Yes! But the discrete plot above should change with it as well. $\endgroup$
    – Walter U.
    Apr 25, 2015 at 17:36
  • $\begingroup$ Of that, I am not sure. $\endgroup$
    – Walter U.
    Apr 25, 2015 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, 2015 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$
    – Walter U.
    Apr 25, 2015 at 17:48

1 Answer 1

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@"https://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[{[email protected], 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$
3
  • $\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$
    – Walter U.
    Apr 25, 2015 at 19:13
  • $\begingroup$ Nevermind. I got it! $\endgroup$
    – Walter U.
    Apr 25, 2015 at 19:29
  • $\begingroup$ @JohnWayne360 Good :) Just need to add a new pos and {1, 2, 3} :) $\endgroup$
    – Öskå
    Apr 25, 2015 at 19:53

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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