Services & ResourcesWolfram ForumsMathGroup Archive

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

Help with dynamics

• To: mathgroup at smc.vnet.net
• Subject: [mg52466] Help with dynamics
• From: r.odobescu at ucl.ac.uk (Raluca)
• Date: Sun, 28 Nov 2004 01:06:51 -0500 (EST)
• Sender: owner-wri-mathgroup at wolfram.com

Hello,

I am yet again one ignorant mathematics student struggling to
programme in Mathematica. I found this article with solutions
http://hilbert.math.hr/arhive/mathgroup/2000/07/0440.html, and tried
to do the same. Only problem is that my equations are a system of 10,
recurrent, simultaneous equations. Naturally I go into recurssion
limit and all sorts of errors. Can you please help me? Maybe I should
program in a different way?

Here comes the code.

Please, please help me. I am beginning to be desperate. Million
thanks.

Raluca

CODE***********************************************************

ClearAll[p, distance, r, road, c];
  
  p = Table[Random [Integer, {-10, 10}], {i, 5}, {j, 2}]
  
  distance = 
      Table[Sqrt[(p[[i]] - p[[j]])[[1]]^2 + (p[[i]] - p[[j]])[[2]]^2],
{i, 1, 
          5}, {j, 1, 5}];
  r = Table[
        If[i == j, 0, If[i > j, Random [Integer, {0, 1}], 0]], {i, 5},
{j, 
          5}];
  road = r + Transpose[r];
  MatrixForm[r]
  MatrixForm[road]
  (*Flatten[distance]*)
  MatrixForm[distance]
  c = Table[road[[i, j]]*Exp[-0.1*distance[[i, j]]], {i, 1, 5}, {j, 1,
5}];
MatrixForm[c]
Show[Graphics[{Line[{{-10, -10}, {-10, 10}}], Line[{{-10, 10}, {10,
10}}], 
      Line[{{10, 10}, {10, -10}}], 
      Line[{{10, -10}, {-10, -10}}], {Hue[0], 
        Table[If[road[[i, j]] == 1, 
            Line[{p[[i]], p[[j]]}], {PointSize[0.02], Point[p[[i]]]}],
{i, 1, 
            5}, {j, 1, 5}]}, Table[Text[i, p[[i]]], {i, 1, 5}]}], 
  AspectRatio -> 1, Axes -> True]
N1[0] := 0;
N2[0] := 0;
N3[0] := 0;
N4[0] := 0;
N5[0] := 0.1*10;
E1[0] := 0;
E2[0] := 0;
E3[0] := 0;
E4[0] := 0;
E5[0] := 0;
N1[t_] := 
    N1[t] = N1[t - 1] + 
        0.01*(2*N1[t - 1]*(1 - N1[t - 1]/1) - 0.1*1*N1[t - 1] + 
              0.05*(c[[1, 1]]*E1[t - 1] + c[[2, 1]]*E2[t - 1] + 
                    c[[3, 1]]*E3[t - 1] + c[[4, 1]]*E4[t - 1] + 
                    c[[5, 1]]*E5[t - 1]));
N2[t_] := 
    N2[t] = N2[t - 1] + 
        0.01*(2*N2[t - 1]*(1 - N2[t - 1]/2) - 0.1*2*N2[t - 1] + 
              0.05*(c[[1, 2]]*E1[t - 1] + c[[2, 2]]*E2[t - 1] + 
                    c[[3, 2]]*E3[t - 1] + c[[4, 2]]*E4[t - 1] + 
                    c[[5, 2]]*E5[t - 1]));
N3[t_] := 
    N3[t] = N3[t - 1] + 
        0.01*(2*N3[t - 1]*(1 - N3[t - 1]/5) - 0.1*5*N3[t - 1] + 
              0.05*(c[[1, 3]]*E1[t - 1] + c[[2, 3]]*E2[t - 1] + 
                    c[[3, 3]]*E3[t - 1] + c[[4, 3]]*E4[t - 1] + 
                    c[[5, 3]]*E5[t - 1]));
N4[t_] := 
    N4[t] = N4[t - 1] + 
        0.01*(2*N4[t - 1]*(1 - N4[t - 1]/7) - 0.1*7*N4[t - 1] + 
              0.05*(c[[1, 4]]*E1[t - 4] + c[[2, 4]]*E2[t - 1] + 
                    c[[3, 4]]*E3[t - 1] + c[[4, 4]]*E4[t - 1] + 
                    c[[5, 4]]*E5[t - 1]));
N5[t_] := 
    N5[t] = N5[t - 1] + 
        0.01*(2*N5[t - 1]*(1 - N5[t - 1]/10) - 0.1*10*N5[t - 1] + 
              0.05*(c[[1, 5]]*E1[t - 1] + c[[2, 5]]*E2[t - 1] + 
                    c[[3, 5]]*E3[t - 1] + c[[4, 5]]*E4[t - 1] + 
                    c[[5, 5]]*E5[t - 1]));

E1[t_] := 
    E1[t] = E1[t - 1] + 
        0.01*(0.1*1*N1[t - 1] - h*E1[t - 1] - 
              0.05*E1[t - 1]*Sum[c[[1, j]], {j, 1, 5}]);
E2[t_] := 
    E2[t] = E2[t - 1] + 
        0.01*(0.1*2*N2[t - 1] - h*E2[t - 1] - 
              0.05*E2[t - 1]*Sum[c[[2, j]], {j, 1, 5}]);
E3[t_] := 
    E3[t] = E3[t - 1] + 
        0.01*(0.1*5*N3[t - 1] - h*E3[t - 1] - 
              0.05*E3[t - 1]*Sum[c[[3, j]], {j, 1, 5}]);
E4[t_] := 
    E4[t] = E4[t - 1] + 
        0.01*(0.1*7*N4[t - 1] - h*E4[t - 1] - 
              0.05*E4[t - 1]*Sum[c[[4, j]], {j, 1, 5}]);
E5[t_] := 
    E5[t] = E5[t - 1] + 
        0.01*(0.1*10*N5[t - 1] - h*E5[t - 1] - 
              0.05*E5[t - 1]*Sum[c[[5, j]], {j, 1, 5}]);
(*
  {adata, bdata} = Transpose[Table[{{i, a[i]}, {i, b[i]}}, {i, 0,
100}]];
  *)
{N1data, N2data, N3data, N4data, N5data, E1data, E2data, E3data,
E4data, 
      E5data} = 
    Transpose[
      Table[{{t, N1[t]}, {t, N2[t]}, {t, N3[t]}, {t, N4[t]}, {t,
N5[t]}, {t, 
            E1[t]}, {t, E2[t]}, {t, E3[t]}, {t, E4[t]}, {t, E5[t]}},
{t, 0, 
          20}]];
(*
  Block[{$DisplayFunction = Identity}, 
    aplot = ListPlot[adata, PlotJoined -> True, 
        PlotStyle -> RGBColor[0, 0, 1]]; 
    bplot = ListPlot[bdata, PlotJoined -> True, 
        PlotStyle -> RGBColor[1, 0, 0]]];
Show[aplot, bplot, ImageSize -> 500, Frame -> True, 
    FrameLabel -> {"period", "insects"}, PlotRange -> {0, 35}, 
    PlotLabel -> "Insect Polulations, a Blue, b Red"];*)
Block[{$DisplayFunction = Identity}, {$RecursionLimit = Infinity}, 
    N1plot = ListPlot[N1data, PlotJoined -> True, 
        PlotStyle -> RGBColor[0, 0, 1]];
    N2plot = 
      ListPlot[N2data, PlotJoined -> True, PlotStyle -> RGBColor[0, 0,
0.5]];
    N3plot = 
      ListPlot[N3data, PlotJoined -> True, PlotStyle -> RGBColor[0, 0,
0.7]];
    N4plot = 
      ListPlot[N4data, PlotJoined -> True, PlotStyle -> RGBColor[0, 0,
0]];
    N5plot = 
      ListPlot[N5data, PlotJoined -> True, PlotStyle -> RGBColor[0, 0,
0.2]];
E1plot = ListPlot[E1data, PlotJoined -> True, 
        PlotStyle -> RGBColor[1, 0, 1]];
    E2plot = 
      ListPlot[E2data, PlotJoined -> True, PlotStyle -> RGBColor[1, 0,
0.5]];
    E3plot = 
      ListPlot[E3data, PlotJoined -> True, PlotStyle -> RGBColor[1, 0,
0.7]];
    E4plot = 
      ListPlot[E4data, PlotJoined -> True, PlotStyle -> RGBColor[1, 0,
0]];
    E5plot = 
      ListPlot[E5data, PlotJoined -> True, PlotStyle -> RGBColor[1, 0,
0.2]]];