(* loads in packages we need *)

Needs["MultivariateStatistics`"]
Needs["Histograms`"]
Needs["BarCharts`"]

(* this generates random numbers from the normal distribution *)
Random[NormalDistribution[0,1]]
?NormalDistribution

(* this is the main program. the first part generates a random matrix A where it is one of three possible matrices; the second generates a random matrix B where the various key entries are taken from normal distributions; Bexact is the same as B but with 0 variance. *)
f[x_] := If[x < .1, 1/6,If[x < .9, 2/6, 3/6]];
A[x_] := {{0,f[x],2.005/3,0},{1,0,0,0},{0,1,0,0},{0,0,1,0}};
B[x_] := {{0,Abs[Random[NormalDistribution[2/5.11,.06]]],Abs[Random[NormalDistribution[x 2.005/3,.1]]],0},{.95+Random[]*.05,0,0,0},{0,.9+Random[]*.1,0,0},{0,0,.8+Random[]*.2,0}};
Bexact = {{0,2/5.11,2.005/3,0},{.975,0,0,0},{0,.95,0,0},{0,0,.9,0}};
Bexactvar[x_] := {{0,2/5.11,x 2.005/3,0},{.975,0,0,0},{0,.95,0,0},{0,0,.9,0}};
MatrixForm[B[1]]
MatrixForm[Bexact]
Eigenvalues[Bexact]
Eigenvalues[Bexactvar[1.1]]
Eigenvalues[Bexactvar[1.2]]
Eigenvalues[Bexactvar[1.3]]
(*A[.08]
A[.8]
A[.93]*)

(* testing how to take entries of a vector *)
v0 = {{1},{0},{0},{0}};
v0[[1,1]]  + v0[[2,1]]

(* main program to look at evolution *)
(* if doB = 1 then we use the random B matrices, else use the A matrices *)
(* saveevery tells how many steps we take before saving to file *)
(* growth = 1 is the test case where the largest eigenvalue is 1.00025, just slightly above 1; if we use larger growth values then we can have a better chance of the population surviving. *)
evolve[years_,iterations_,doB_,saveevery_,growth_] := Module[{},
allresults = {};
allratios = {};
exact = {};
(* initial population *)
v0 = {{1},{0},{0},{0}};
initialpop = v0[[1,1]]+v0[[2,1]]+v0[[3,1]]+v0[[4,1]];
exact = AppendTo[exact,{0,initialpop}];
Print["Largest eigenvalue of the constant matrix is ", N[Eigenvalues[Bexactvar[growth]][[1]]]];
For[i = 1, i ≤ iterations, i++,
{
(* saves in exact, results and ratios *)
results = {{0,initialpop}};
ratio = {{0,1}};
vcurr = v0;
vexactcurr = v0;
(*Print[vcurr];*)
For[n = 1, n ≤ years, n++,
{
If[doB == 1, vcurr = B[growth].vcurr,vcurr = A[Random[]] . vcurr];
If[Mod[n,saveevery] == 0,
results = AppendTo[results, {n,vcurr[[1,1]] + vcurr[[2,1]] + vcurr[[3,1]] + vcurr[[4,1]]}]];
If[i == 1,
{
If[doB == 1,vexactcurr = Bexactvar[growth].vexactcurr,vexactcurr = A[.5] . vexactcurr];
If[Mod[n,saveevery] == 0,
exact = AppendTo[exact, {n, vexactcurr[[1,1]]+vexactcurr[[2,1]]+vexactcurr[[3,1]]+vexactcurr[[4,1]]}]];
}];
If[Mod[n,saveevery] == 0,
ratio = AppendTo[ratio, {n, results[[n/saveevery,2]] / exact[[n/saveevery,2]] 1.0}]];
}];(* end of n years loop *)
allresults = AppendTo[allresults,results];
allratios = AppendTo[allratios,ratio];
Print["At time ", n, " we have a population of ", results[[Length[results],2]], " giving a ratio to the current exact population of ", ratio[[Length[ratio],2]]];
}]; (* end i iterations loop *)
allresults = AppendTo[allresults,exact];
Print[ListPlot[allresults]];
Print[ListPlot[allratios]];
];

evolve[500,5,1,1,1]
evolve[500,5,1,1,1.001]
evolve[500,5,1,1,1.01]

evolve[5000,5,1,20,1]
evolve[5000,5,1,20,1.001]
evolve[5000,5,1,20,1.01]

evolve[50000,5,1,200,1]
evolve[50000,5,1,200,1.001]
evolve[50000,5,1,200,1.01]

evolve[5000,5,1,1,1]

evolve[5000,5,1,1,1.3]

evolve[10000,3,1,1,1]

evolve[2000,4,1,1,1]

evolve[5000,4,1,20,1]
evolve[5000,4,1,20,1.01]