Пример с новозеландски овце

Въвеждане на данните

За целта отворете тетрадката 032-leslie-table-CLS.nb или кликнете долния бутон.

Button["032-leslie-table-CLS.nb",NotebookOpen[NotebookDirectory[]<>"032-leslie-table-CLS.nb"]]

Да (пре)заредим функциита leslie и leslieDiagram:

ClearAll@leslie
leslie[f_,p_]:=Table[
If[i==1,f[[j]],
If[i==j+1,p[[j]],0
]
]
,{j,1,Length[f]},{i,1,Length[f]}
]

ClearAll@leslieDiagram
leslieDiagram[f_,p_]:=Module[
{
edgeList={},
n=Length[f] (* брой възрастови групи *)
},
(* въвеждаме връзките на преживяемост между групите *)
(* U1 може да ползваме и стрингове за да надпишем стойностите *)
edgeList=edgeList~Join~Table[{i->i+1,p[[i]]},{i,1,n-1}];
(* въвеждаме връзките на фертилност на групите *)
(* U2 може да ползваме и стрингове за да надпишем стойностите *)
edgeList=edgeList~Join~Table[{i->1,f[[i]]},{i,1,n}];
(* Чертаем ориентиран граф чрез GraphPlot, използвайки информацията в edgeList *)
GraphPlot[edgeList,ImageSize->400,DirectedEdges->{True,"ArrowheadsSize"->0.03},VertexLabeling->True,Method->"RadialDrawing"]
]

Да запишем данните в съответни вектори. Последната колона ще я обсъдим след малко.

fx=tblLeslie[[All,1]];
px=tblLeslie[[All,2]];
lx=tblLeslie[[All,3]];
nx0=tblLeslie[[All,4]];

Да запишем в mx матрицата на Лесли за fx и px.

mx=leslie[fx,px];

mx//MatrixForm

Да нарисуваме диаграмка.

leslieDiagram[fx,px]

Информацията в l показва как протича остаряването. Наблюдават се три типа.

({{, Тип I - Хора
Постепенно
остаряване}, {, Тип II - Птици
Еднаква степен на преживяемост,
независимо от възрастта}, {, Тип III - Жаби, Риби
Числеността зависи най-вече от
количеството продуцирани организми}})

Да видим как е при нас.

ListPlot[lx,Joined->True]

Т.е. остаряването е от постепенен тип (тип 1).

Графично представяне

Да зададем модела във вид на общото решение.

leslieModel[n0_,m_,t_]:=MatrixPower[m,t].n0

Нека направим интерактивна хистограма. Ползваме BarChart + Manipulate. Задаваме опцията ChartLabels, за да обозначим с етикет всяка отделна група.

Manipulate[BarChart[leslieModel[nx0,mx,t],ChartLabels->Range[1,12]],{t,0,100,1}]

Тук личат двата съществени извода за модела на Лесли.

След известно време (в нашия пример експериментално се вижда, че става дума за t>15) разпределението на популацията по възрастови групи започва да има характерен вид (по-точно се забелязват константни пропорции между възрастовите групи). Този ефект се нарича устойчиво възрастово разпределение на популацията.

След t=15 този вид се запазва, но популацията продължава да расте неограничено.

Собствени числа и вектори

Да сметнем собствените числа.

λ=Eigenvalues[mx]

Теорията казва, че има едно реално водещо собствено чисто със стойност близка до единица. Всъщност това е първото собствено число в списъка, тъй като Mathematica автоматично сортира собствените числа по модул.

Да сметнем матриците X и (X^(-1)), които ще ни трябват за приближеното решение. Тук транспонирам X, тъй като Mathematica връща резултата в транспониран вид.

myX=Transpose@Eigenvectors[mx];
myXinv=Inverse@myX;

Нека запаметим (Subscript[λ, 1]) и съответстващия му вектор.

{λ1,x1}={λ[[1]],myX[[All,1]]}

Приближено решение

За приближеното решение имахме:

n(t)(Underscript[⟶, t->∞])(Subscript[λ, 1]^t)(Subscript[x, 1])(Subscript[c, 1]), където (Subscript[c, 1])=(Subscript[(OverBar[x]), 1])(Subscript[n, 0])

Да сметнем (Subscript[c, 1]). Взимаме първата колона на myX и първия ред на myXinv

myC1=myXinv[[1]].nx0

Ще видим, че резултата е коректен, но нека махнем миниатюрния имагинерен остатък.

myC1=Re[myC1]

Тогава вече можем да запишем апроксимирания модел.

leslieModelApprox[m_,t_]:=myC1 ((λ1)^t)x1

Да сравним двете решения.

Manipulate[ListPlot[{leslieModel[nx0,mx,t],leslieModelApprox[mx,t]},Filling->Axis,Joined->True],{t,1,15,1}]

В синьо е общото решение, а във виолетово – приближеното. Вижда се, че за t>15 двете решения (поне визуално) съвпадат.

Ограничаване на популацията чрез нагласяне на коефициентите на фертилност

Както видяхме, разглежданата популация расте неограничено. Това не винаги е желано. Ако коефициентите на фертилност за всички групи се снижат с някаква константа (например фермерът има контрол над размножаването на добитъка), бихме могли да получим устойчива численост.

Да добавим скалиращ параметър (който естествено е в [0,1] ), регулиращ фертилността.

Manipulate[
t1=leslie[c fx,px];
t2=leslieModel[nx0,t1,t];
{
{BarChart[t2]},
{
{{"λ1:",Eigenvalues[t1][[1]]}}//Grid
},
{
{{
"нови f",
c fx//MatrixForm
}}//Grid
},
{
{{"Общо овце в популацията:",Plus@@t2}}//Grid
}
}//Grid,
{t,0,100,1},{{c,0.39783},0.1,1}]

Добра стойност за скалиращия параметър на фертилността е: 0.39783