離散時間のモデル
Models in discrete time

指数モデル Exponential model

fn[x_]:=R x/.R->1.5

fn[0]

seq=NestList[fn,1,20]

ListPlot[seq,Joined->True,PlotRange->All,PlotMarkers->Automatic,AxesLabel->{"t","N_t"}]

ListLogPlot[seq,Joined->True,PlotMarkers->Automatic,AxesLabel->{"t","N_t"}]

Export["data.txt",seq]

pairWise[x_List]:=Block[{len = Length[x],points={},start,end},
start = {x[[1]],0};
AppendTo[points, start];
AppendTo[points,{x[[1]],x[[1]]}];

Do[
	AppendTo[points,{x[[i]],x[[i+1]]}];
	AppendTo[points,{x[[i+1]],x[[i+1]]}],{i,1,len-1}
];
Return[points]
]

data=pairWise[seq]

gDyna=ListPlot[data,Joined->True,AspectRatio->1,PlotStyle->RGBColor[1,0,0],PlotRange->All]

gMap=Plot[{fn[x],x},{x,0,1000},AspectRatio->1,PlotRange->{{0,1000},{0,1000}}]

Show[gMap,gDyna,AxesLabel->{"N_t","N_t+1"}]

ロジスティックモデル Logistic model

fn[x_]:=R(1-x)x/.R->3.3

seq=NestList[fn,0.1,50]

ListPlot[seq,Joined->True,AxesLabel->{"t","N_t"},PlotRange->{-0.5,1.2}]

pairWise[x_List]:=Block[{len = Length[x],points={},start,end},
start = {x[[1]],0};
AppendTo[points, start];
AppendTo[points,{x[[1]],x[[1]]}];

Do[
	AppendTo[points,{x[[i]],x[[i+1]]}];
	AppendTo[points,{x[[i+1]],x[[i+1]]}],{i,1,len-1}
];
Return[points]
]

data=pairWise[seq]

gDyna=ListPlot[data,Joined->True,AspectRatio->1,PlotStyle->RGBColor[1,0,0],PlotRange->All]

gMap=Plot[{fn[x],x},{x,0,1},AspectRatio->1]

Show[gMap,gDyna,AxesLabel->{"N_t","N_t+1"},PlotRange->{{0,1},{0,1}}]

fn[x]

gMap2=Plot[{fn[fn[x]],x},{x,0,1},AspectRatio->1,AxesLabel->{"x_t","x_{t+2}"}]

Show[gMap,gMap2,gDyna]

ロジスティックモデル Logistic model with chaos

fn[x_]:=R(1-x)x/.R->3.9

seq1=NestList[fn,0.1,50]

seq2=NestList[fn,0.1000001,50]

ListPlot[{seq1,seq2},Joined->True,AxesLabel->{"t","x_t"},PlotRange->{0,1}]

g1=Plot[fn[x],{x,0.1,0.11},PlotRange->{0,1},AxesLabel->{"x_0","x_1"}]

関数を入れ子にするには Nest を使う

Nest[fn,x,2]//Expand

Nest[fn,x,5]//Expand

g5=Plot[Nest[fn,x,5],{x,0.1,0.11},PlotRange->{0,1},AxesLabel->{"x_0","x_5"}]

g10=Plot[Nest[fn,x,10],{x,0.1,0.11},PlotRange->{0,1},AxesLabel->{"x_0","x_10"}]

g15=Plot[Nest[fn,x,15],{x,0.1,0.11},PlotRange->{0,1},AxesLabel->{"x_0","x_15"}]

Show[GraphicsGrid[{{g1,g5},{g10,g15}}]]

Ricker ロジスティックモデル Ricker logistic model

fn[x_]:= Exp[r(1-x)]x

Plot[{x, fn[x]/.r->1, fn[x]/.r->2, fn[x]/.r->3},{x,0,2.5}, AspectRatio->1,AxesLabel->{"N_t","N_{t+1}"},PlotStyle->Thick]

fn1=.

fn1[x_] = fn[x]/.r->2.1

next[xx_]:=fn1[x]/.x->xx
next[0.1]

seq = NestList[next,0.01,100]

ListPlot[seq,Joined->True,PlotRange->{0,1.5}]

pairWise[x_List]:=Block[{len = Length[x],points={},start,end},
start = {x[[1]],0};
AppendTo[points, start];
AppendTo[points,{x[[1]],x[[1]]}];

Do[
	AppendTo[points,{x[[i]],x[[i+1]]}];
	AppendTo[points,{x[[i+1]],x[[i+1]]}],{i,1,len-1}
];
Return[points]
]

data=pairWise[seq]

gDyna=ListPlot[data,Joined->True,AspectRatio->1,PlotStyle->RGBColor[1,0,0]]

gMap=Plot[ {fn1[x],x},{x,0,3},AspectRatio->1]

Show[gDyna,gMap,PlotRange->All,AxesOrigin->{0,0}]

gMap2=Plot[{fn1[fn1[x]],x},{x,0,3},AspectRatio->1]

Show[gDyna,gMap,gMap2,PlotRange->All,AxesOrigin->{0,0}]

アリー効果モデル

fn[x_]:=a x^2/(b+x^2)/.{a->3,b->1}

Plot[{fn[x],x},{x,0,4},PlotRange->All,AspectRatio->1,AxesLabel->{"N_t","N_{t+1}"}]

seq=NestList[fn,0.6,20]

ListPlot[seq,Joined->True,AxesLabel->{"t","N_t"},PlotRange->All]

pairWise[x_List]:=Block[{len = Length[x],points={},start,end},
start = {x[[1]],0};
AppendTo[points, start];
AppendTo[points,{x[[1]],x[[1]]}];

Do[
	AppendTo[points,{x[[i]],x[[i+1]]}];
	AppendTo[points,{x[[i+1]],x[[i+1]]}],{i,1,len-1}
];
Return[points]
]

data=pairWise[seq]

gDyna=ListPlot[data,Joined->True,AspectRatio->1,PlotStyle->RGBColor[1,0,0],PlotRange->All]

gMap=Plot[{fn[x],x},{x,0,4},AspectRatio->1]

Show[gMap,gDyna,AxesLabel->{"N_t","N_t+1"},PlotRange->{{0,4},{0,4}}]