人口の推移モデル
N_t+1=r*N_t*(1-N_t)

FUNpop_t<-function(r=2.5,n0=0.5,gen=100) {
  nt=n0;x=seq(0, 1, 0.01);y=r*x*(1-x)
  maxY=max(y,1);i_gen=1
  plot(x,y,type='l',xlim=c(-0.1, 1.1),ylim=c(0,maxY),xlab="Prop. @ time t", 
   ylab="Prop @ time t+1");
  lines(x,x,type='l')
  while ((i_gen < gen) & (nt>0)) {
    nt1=r*nt*(1-nt);
    lines(c(nt,nt),c(nt, nt1),type='l',col='red')
    lines(c(nt,nt1),c(nt1,nt1),type='l',col='red')
    nt=nt1;
    i_gen=i_gen+1;
  }
}
# example
par(mfrow=c(2,2))
FUNpop_t(r=2.7,n0=0.15,gen=100)
FUNpop_t(r=3.1,n0=0.15,gen=100)
FUNpop_t(r=3.8,n0=0.15,gen=100)
FUNpop_t(r=4.2,n0=0.15,gen=100)

周期性の検証

FUNpop_t2<-function(gen=100,digit=5,n0=0.5){
  r=seq(2.5,4,0.001)
  res=matrix(0,ncol=2,nrow=1)
  r.length=length(r)
  for (i_r in 1:r.length) {
    nt=matrix(0,nrow=gen,ncol=1)
    nt[1]=n0;
    for (i_loop in 2:gen)
      {nt[i_loop]=r[i_r]*nt[i_loop-1]*(1-nt[i_loop-1])}
    bunnki<-unique(round(nt[duplicated(round(nt,digits=digit))],digits=digit))
    bunnki.length<-length(bunnki);
    res=rbind(res,cbind(rep(r[i_r],bunnki.length),bunnki))
  }
return(res[-1, ])
}
# example
res<-FUNpop_t2(gen=10000, digit=5)
plot(res[,1],res[,2],pch=19,cex=0.1,col="red",xlab="r values",ylab="cyclic points")