# Manipulate with plot and images

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}]


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

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:

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.

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

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}]


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.

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