logisticMap.r

# The formula to iterate
logisticMap <- function(x, r) r * x * (1-x)

# Iterate N times from starting point
makeMap <- function(x , r, N){
  for(i in 2:N) x[i] <- logisticMap(x[i-1], r)
  x
}

# How many iterations?
N = 200

# Make an empty data frame
dat <- data.frame(x=NA,y=NA)

# Apply function over values of `r` then pass list of plots to gifski
lapply(seq(2.4 , 4.0 , 0.005), \(r) {
  
  # Set up the graph
  layout(matrix(c(1,2,3,3), 2, 2, byrow = TRUE))
  par(mar=2*c(1,1,1,1), oma=3*c(1,1,1,1))
  y=makeMap(.1,r,N)
  
  # Add the current iterations points to the frame (I know)
  dat <<- rbind(dat , data.frame(x=r, y=y[-(1:100)]))
  
  # Plot the sequence
  plot(x=1:N,y=y,ylim=c(0,1),type="l",main="Logistic map:x_{n+1} =  r * x_n * (1-x_n)" , xlab="n", ylab="x_n")
    points(x=1:N,y=y,ylim=c(0,1),col=c("blue", "red"), pch=19)
  
  # Plot the map and trace the iterations in 2D
  # Red are even iterations, blue are odd.
  plot(x=seq(0,1,l=N) , 
       y=logisticMap(x=seq(0,1,l=N),r = r), 
       type="l", ylim=c(0,1), ylab="x_n", xlab="x_n+1",main=sprintf("r=%0.3f",r))
    points(y=seq(0,1,l=N) , x=logisticMap(x=seq(0,1,l=N),r = r), type="l")
    lines(x=y[c(1,rep(seq(3,N,2),each=2))][1:N], y=y[c(rep(seq(2,N,2),each=2))], col="red")
    lines(y=y[c(1,rep(seq(3,N,2),each=2))][1:N], x=y[c(rep(seq(2,N,2),each=2))], col="blue")
    
  # Now build up the graphs of the orbits and how they change with r.
  plot(dat, xlim=c(2.4,4), ylim=c(0,1), xlab="r", ylab="x",col=c("red", "blue"), pch=20)
  
  grid()
  
  }  )   |> 

  gifski::save_gif( gif_file="bifurcation.gif", delay = 1/10,width = 800,height = 800)

Code to produce an illustration of the logistic map from r=2.4 to 4.0