Attractor
2022-10-26
This is my first attempt to create some 2D Strange Attractor. My code is based on a blogpot from Will R. Chase. I tried to change his code to incorporate some formulas described on Softology’s Blog. So apparently, strange attractors are created by repeating (or iterating) a formula over and over again and using the result at each iteration to plot a point. The result of each iteration is fed back into the equation. After millions of points have been plotted fractal structures appear. The repeated points fall within a basin of attraction (they are attracted to the points that make up these shapes). I stole this entire explanation. Anyways, let’s go!
I will start by trying to create some pretty Fractal Dream Attractors. They were discovered by Clifford A Pickover and discussed in his book “Chaos in Wonderland”.
library(ggplot2)## Warning: Paket 'ggplot2' wurde unter R Version 4.1.3 erstelltlibrary(dplyr)## Warning: Paket 'dplyr' wurde unter R Version 4.1.3 erstellt##
## Attache Paket: 'dplyr'## Die folgenden Objekte sind maskiert von 'package:stats':
##
## filter, lag## Die folgenden Objekte sind maskiert von 'package:base':
##
## intersect, setdiff, setequal, union#ggplot theme blank canvas
opt = theme(legend.position = "none",
panel.background = element_rect(fill="black"),
axis.ticks = element_blank(),
panel.grid = element_blank(),
axis.title = element_blank(),
axis.text = element_blank())
#attractor function
createTrajectory <- function(n, x0, y0, a, b, c, d)
{
#pre-initialize vectors of length n
x <- vector(mode = "numeric", length = n)
y <- vector(mode = "numeric", length = n)
#starting values
x[1] <- x0 #x and y both start at 1
y[1] <- y0
#fill vectors with values
for (i in 2:n) {
x[i] <- sin(y[i-1]*b)+c*sin(x[i-1]*b)
y[i] <- sin(x[i-1]*a)+d*sin(y[i-1]*b)
}
#make dataframe
data.frame(x = x, y = y)
}
#constants
a=-1.1554 #must be between -3 and +3
b=-2.3419 #must be between -3 and +3
c=-1.9799 #must be between -0.5 and +1.5
d=2.1828 #must be between -0.5 and +1.5
#calculate positions and plot
df=createTrajectory(2000000, 0.1, 0.1, a, b, c, d)
attractor1 <- ggplot(df, aes(x, y)) + geom_point(color="#ffffff", shape=46, alpha=.05) + opt
attractor1
#ggsave("attractor1.png", attractor1, width = 30, height = 20, units = "in")library(ggplot2)
library(dplyr)
#ggplot theme blank canvas
opt = theme(legend.position = "none",
panel.background = element_rect(fill="black"),
axis.ticks = element_blank(),
panel.grid = element_blank(),
axis.title = element_blank(),
axis.text = element_blank())
#attractor function
createTrajectory <- function(n, x0, y0, a, b, c, d)
{
#pre-initialize vectors of length n
x <- vector(mode = "numeric", length = n)
y <- vector(mode = "numeric", length = n)
#starting values
x[1] <- x0 #x and y both start at 1
y[1] <- y0
#fill vectors with values
for (i in 2:n) {
x[i] <- sin(y[i-1]*b)+c*sin(x[i-1]*b)
y[i] <- sin(x[i-1]*a)+d*sin(y[i-1]*b)
}
#make dataframe
data.frame(x = x, y = y)
}
#constants
a=-0.966918 #must be between -3 and +3
b=2.879879 #must be between -3 and +3
c=0.765145 #must be between -0.5 and +1.5
d=0.744728 #must be between -0.5 and +1.5
#calculate positions and plot
df=createTrajectory(1000000, 0.1, 0.1, a, b, c, d)
ggplot(df, aes(x, y)) + geom_point(color="#ffffff", shape=46, alpha=.05) + opt
library(ggplot2)
library(dplyr)
#ggplot theme blank canvas
opt = theme(legend.position = "none",
panel.background = element_rect(fill="black"),
axis.ticks = element_blank(),
panel.grid = element_blank(),
axis.title = element_blank(),
axis.text = element_blank())
#attractor function
createTrajectory <- function(n, x0, y0, a, b, c, d)
{
#pre-initialize vectors of length n
x <- vector(mode = "numeric", length = n)
y <- vector(mode = "numeric", length = n)
#starting values
x[1] <- x0 #x and y both start at 1
y[1] <- y0
#fill vectors with values
for (i in 2:n) {
x[i] <- sin(y[i-1]*b)+c*sin(x[i-1]*b)
y[i] <- sin(x[i-1]*a)+d*sin(y[i-1]*b)
}
#make dataframe
data.frame(x = x, y = y)
}
#constants
a=-1.9956 #must be between -3 and +3
b=-1.4528 #must be between -3 and +3
c=-1.6206 #must be between -0.5 and +1.5
d=0.8517 #must be between -0.5 and +1.5
#calculate positions and plot
df=createTrajectory(9000000, 0.1, 0.1, a, b, c, d)
attractor3 <- ggplot(df, aes(x, y)) + geom_point(color="#ffffff", shape=46, alpha=.05) + opt
attractor3 
ggsave("attractor3.png", attractor3, width=20, height=20, units="in")I want to colour my second attractor. I use the code provided by Will.
#install.packages("BiocManager")
#BiocManager::install("EBImage")
library(EBImage)
library(tidyverse)## Warning: Paket 'tidyverse' wurde unter R Version 4.1.3 erstellt## Warning: Paket 'tibble' wurde unter R Version 4.1.3 erstellt## Warning: Paket 'tidyr' wurde unter R Version 4.1.3 erstellt## Warning: Paket 'readr' wurde unter R Version 4.1.3 erstellt## Warning: Paket 'purrr' wurde unter R Version 4.1.3 erstellt## Warning: Paket 'stringr' wurde unter R Version 4.1.3 erstellt## Warning: Paket 'forcats' wurde unter R Version 4.1.3 erstellt## Warning: Paket 'lubridate' wurde unter R Version 4.1.3 erstellt## -- Attaching core tidyverse packages ------------------------ tidyverse 2.0.0 --
## v forcats 1.0.0 v stringr 1.5.0
## v lubridate 1.9.2 v tibble 3.2.1
## v purrr 1.0.1 v tidyr 1.3.0
## v readr 2.1.4
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x EBImage::combine() masks dplyr::combine()
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
## x purrr::transpose() masks EBImage::transpose()
## i Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors#read in the image and convert to greyscale
img <- readImage("attractor3.png")
gray <- channel(img, "gray")
#map the color palette to the image
img_col <- colormap(gray, viridis::magma(256))
display(img_col, method = "raster")
#when you are satisfied with the image, save it
writeImage(img_col, "attractor_3_colour.png")Next I want to work on creating some Johnny Svensson Attractors.
library(ggplot2)
library(dplyr)
#ggplot theme blank canvas
opt = theme(legend.position = "none",
panel.background = element_rect(fill="black"),
axis.ticks = element_blank(),
panel.grid = element_blank(),
axis.title = element_blank(),
axis.text = element_blank())
#attractor function
createTrajectory <- function(n, x0, y0, a, b, c, d) {
#pre-initialize vectors of length n
x <- vector(mode = "numeric", length = n)
y <- vector(mode = "numeric", length = n)
#starting values
x[1] <- x0 #x and y both start at 1
y[1] <- y0
#fill vectors with values
for (i in 2:n) {
x[i] <- d*sin(x[i-1]*a)-sin(y[i-1]*b)
y[i] <- c*cos(x[i-1]*a)+cos(y[i-1]*b)}
#make dataframe
data.frame(x = x, y = y)
}
#constants (must all be between -3 and 3)
a=-1.9956
b=-1.4528
c=-1.6206
d=0.8517
#calculate positions and plot
df=createTrajectory(9000000, 0.1, 0.1, a, b, c, d)
jsattractor1 <- ggplot(df, aes(x, y)) + geom_point(color="#ffffff", shape=46, alpha=.05) + opt
jsattractor1
ggsave("jsattractor1.png", jsattractor1, width=20, height=20, units="in")#install.packages("BiocManager")
#BiocManager::install("EBImage")
library(EBImage)
library(tidyverse)
#read in the image and convert to greyscale
img <- readImage("jsattractor1.png")
gray <- channel(img, "gray")
#map the color palette to the image
img_col <- colormap(gray, viridis::magma(256))
#display(img_col, method = "raster")
#when you are satisfied with the image, save it
writeImage(img_col, "jsattractor_1_colour.png")