Фрактали

Фракта́л (лат. fractus — подрібнений, дробовий) — нерегулярна, самоподібна структура. В широкому розумінні фрактал означає фігуру, малі частини якої в довільному збільшенні є подібними до неї самої.

Ми почнемо з простих фракталів

library(ggplot2)
library(pracma)

Перший фрактал - сніжинка

z <- fractalcurve(1, which="snowflake")
snowflake <- as.data.frame(z)
ggplot(snowflake, aes(x,y)) + geom_point() + theme_minimal() + coord_fixed(ratio = 1)

z <- fractalcurve(3, which="molecule")
snowflake <- as.data.frame(z)
snowflake$endx <- c(snowflake[2:length(snowflake$x),1],snowflake[1,1])
snowflake$endy <- c(snowflake[2:length(snowflake$y),2],snowflake[1,2])

ggplot(snowflake, aes(x,y)) + geom_segment(aes(x = x,y = y,xend = endx,yend = endy)) + theme_minimal() + coord_fixed(ratio = 1)

z <- fractalcurve(6, which="snowflake")
snowflake <- as.data.frame(z)
snowflake$endx <- c(snowflake[2:length(snowflake$x),1],snowflake[1,1])
snowflake$endy <- c(snowflake[2:length(snowflake$y),2],snowflake[1,2])

ggplot(snowflake, aes(x,y)) + geom_segment(aes(x = x,y = y,xend = endx,yend = endy)) + theme_minimal() + coord_fixed(ratio = 1)

z <- fractalcurve(8, which="snowflake")
snowflake <- as.data.frame(z)

ggplot(snowflake, aes(x,y)) + 
  geom_point() + 
  theme_minimal() + 
  coord_fixed(ratio = 1)

z <- fractalcurve(9, which="snowflake")
snowflake <- as.data.frame(z)
ggplot(snowflake, aes(x,y)) + 
  geom_point(alpha = 0.7, colour = "blue",shape = 12, size = 0.01) + 
  theme_void() + 
  coord_fixed(ratio = 1)

ggplot(snowflake, aes(x,y)) + 
  geom_point(alpha = 0.7, colour = "blue",shape = 11,size = 0.2) + 
  theme_minimal() + 
  coord_fixed(ratio = 1)

ggplot(snowflake, aes(x,y)) + 
  geom_jitter(alpha = 0.5, colour = "blue", shape = 2,height = 0.02, width = 0.02) + 
  theme_minimal() + 
  coord_fixed(ratio = 1)

Дракон

z <- fractalcurve(3, which="dragon")
dragon <- as.data.frame(z)
dragon$endx <- c(dragon[2:length(dragon$x),1],dragon[length(dragon$y),1])
dragon$endy <- c(dragon[2:length(dragon$y),2],dragon[length(dragon$y),2])
ggplot(dragon, aes(x,y)) + geom_point(size = 3) + geom_segment(aes(x = x,y = y,xend = endx,yend = endy)) + theme_minimal() + coord_fixed(ratio = 1)

z <- fractalcurve(5, which="dragon")
dragon <- as.data.frame(z)
dragon$endx <- c(dragon[2:length(dragon$x),1],dragon[length(dragon$y),1])
dragon$endy <- c(dragon[2:length(dragon$y),2],dragon[length(dragon$y),2])
ggplot(dragon, aes(x,y)) + geom_point(size = 3) + geom_segment(aes(x = x,y = y,xend = endx,yend = endy)) + theme_minimal() + coord_fixed(ratio = 1)

z <- fractalcurve(10, which="dragon")
dragon <- as.data.frame(z)
dragon$endx <- c(dragon[2:length(dragon$x),1],dragon[length(dragon$y),1])
dragon$endy <- c(dragon[2:length(dragon$y),2],dragon[length(dragon$y),2])
ggplot(dragon, aes(x,y)) + geom_point(size = 1,alpha = 0.5) + geom_segment(aes(x = x,y = y,xend = endx,yend = endy)) + theme_minimal() + coord_fixed(ratio = 1)

z <- fractalcurve(15, which="dragon")
dragon <- as.data.frame(z)
dragon$endx <- c(dragon[2:length(dragon$x),1],dragon[length(dragon$y),1])
dragon$endy <- c(dragon[2:length(dragon$y),2],dragon[length(dragon$y),2])
ggplot(dragon, aes(x,y)) + geom_point(size = 0.2,alpha = 0.5) + geom_segment(aes(x = x,y = y,xend = endx,yend = endy,ltw = 0.2)) + theme_minimal() + coord_fixed(ratio = 1)
## Warning: Ignoring unknown aesthetics: ltw

z <- fractalcurve(15, which="dragon")
dragon <- as.data.frame(z)
dragon$endx <- c(dragon[2:length(dragon$x),1],dragon[length(dragon$y),1])
dragon$endy <- c(dragon[2:length(dragon$y),2],dragon[length(dragon$y),2])
ggplot(dragon, aes(x,y)) + 
  geom_point(size = 0.2,alpha = 0.5,aes(colour = y)) + 
  geom_segment(aes(x = x,y = y,xend = endx,yend = endy,colour = y)) + 
  theme_minimal() + 
  coord_fixed(ratio = 1) + scale_color_gradient(low="blue", high="red")

ggplot(dragon, aes(x,y)) + 
  geom_jitter(size = 0.1,alpha = 1,aes(colour = y),width = 0.01,height = 0.01) + 
  geom_segment(aes(x = x,y = y,xend = endx,yend = endy,colour = y)) + 
  theme_void() + 
  coord_fixed(ratio = 1) + scale_color_gradient(low="black", high="magenta",guide = FALSE)

ggplot(dragon, aes(x,y)) + 
  geom_point(size = 0.1,alpha = 1,aes(colour = y)) + 
  geom_segment(aes(x = x,y = y,xend = endx,yend = endy,colour = y)) + 
  coord_fixed(ratio = 1) + scale_color_gradientn(colors = terrain.colors(5)) + 
   theme_void()

ggplot(dragon, aes(x,y)) + 
  geom_point(size = 0.1,alpha = 1,aes(colour = x)) + 
  geom_segment(aes(x = x,y = y,xend = endx,yend = endy,colour = x)) + 
  theme_void() + 
  coord_fixed(ratio = 1) + scale_color_gradientn(colors = heat.colors(10), guide=FALSE)

Серпинський

z <- fractalcurve(8, which="triangle")
sierpinski <- as.data.frame(z)
ggplot(sierpinski, aes(x,y)) + 
  geom_point(aes(x,y, colour = (x - 0.5)^2 + (y-0.5)^2),size = 0.001) + 
  coord_fixed(ratio = 1) + 
  scale_color_gradientn(colors = rainbow(3)) + 
   theme_void() 

a=-0.7;b=-0.4 # Complex parameter, connected to coordinate of the Mandelbrot set in a complex plane. Constants here.
Limits=c(-2,2)
MaxIter=60
cl=colours()
Step=seq(Limits[1],Limits[2],by=0.01)
PointsMatrix=array(0,dim=c(length(Step)*length(Step),3))
a1=0

for(x in Step)
{
  for(y in Step)
  {
    n=0
    DIST=0
    x1=x;y1=y # Original x and y are saved.
    while(n<MaxIter & DIST<4)
    {
      newx=x1^2-y1^2+a
      newy=2*x1*y1+b
      DIST=newx^2+newy^2
      x1=newx;y1=newy
      n=n+1
    }
    if(DIST<4) colour=24 else colour=n*10
    #points(x,y, pch=".", col=cl[colour])
    a1=a1+1
    PointsMatrix[a1,]=c(x,y,colour)
  }
}
 
plot(PointsMatrix[,1], PointsMatrix[,2], xlim=Limits, ylim=Limits, col=cl[PointsMatrix[,3]], pch=".", xaxt='n', yaxt='n', ann=FALSE)

Логістична крива і хаос

q_map<-function(r=1,x_o=runif(1,0,1),N=100,burn_in=0,...)
{
par(mfrow=c(2,1),mar=c(4,4,1,2),lwd=2)
############# Trace #############
x<-array(dim=N)
x[1]<-x_o
for(i in 2:N)
x[i]<-r*x[i-1]*(1-x[i-1])
 
plot(x[(burn_in+1):N],type='l',xlab='t',ylab='x',...)
#################################
 
##########  Quadradic Map ########
x<-seq(from=0,to=1,length.out=100)
x_np1<-array(dim=100)
for(i in 1:length(x))
x_np1[i]<-r*x[i]*(1-x[i])
 
plot(x,x_np1,type='l',xlab=expression(x[t]),ylab=expression(x[t+1]))
abline(0,1)
 
 
start=x_o
vert=FALSE
lines(x=c(start,start),y=c(0,r*start*(1-start)) )
for(i in 1:(2*N))
{
if(vert)
{
lines(x=c(start,start),y=c(start,r*start*(1-start)) )
vert=FALSE
}
else
{
lines(x=c(start,
r*start*(1-start)),
y=c(r*start*(1-start),
r*start*(1-start)) )
vert=TRUE
start=r*start*(1-start)
}
}
#################################
}
q_map(r=3.8,x_o=0.4)

bif_diagram <- function(f=function(x,a) (a*x*(1-x)),alow=2.5,ahigh=4,
                        thinness=1000, transient=200, collect=200){
        # f function, parameter must be named a
    n <- 1
    R <- seq(alow,ahigh,length=thinness)
    data <- matrix(0,collect,thinness+1)

    for(a in R){
      x <- runif(1) # random initial condition
      ## first converge to attractor
      for(i in 1:transient){
        x <- f(x,a)
      } # collect points on attractor
      for(i in 1:collect){
        x <- f(x,a)
        data[i,n] <- x
      }
  n <- n+1
}

data <- data[,1:thinness]
yrange <- range(data)+c(-0.1,0.1)
plot(R,data[1,], pch=".", xlab="a", ylab="States",ylim=yrange)
for(i in 2:collect) points(R,data[i,],pch=".")
}
bif_diagram(alow=0.5,ahigh=4)