#' Create A trajectory
#'
#' @param positions The number of positions given
#' @param x0 starting position of particle on x axis
#' @param y0 starting position of particle on y axis
#' @param a a modifier for the attractor
#' @param b a modifier for the attractor
#' @param c a modifier for the attractor
#' @param d a modifier for the attractor
#' @param attractor name of the attractor function being used. See individual attractor functions for details
#' @param custom use a custom attractor.
#'
#' @export
create_trajectory <- function(positions=150000, x0=0, y0=0, a=1,b=-1,c=-1,d=1, attractor = "clifford", custom = FALSE){
if(custom){
attractor <- match.fun(attractor)
} else {
# Match attractor functions
if(stringr::str_detect(attractor, "attractor_")){
attractor <- match.fun(attractor)
} else {
attractor <- paste0("attractor_", attractor)
attractor <- match.fun(attractor)
}
}
#initialize lengths (Should probably do this in cpp but meh)
x <- vector(mode = "numeric", length = positions)
y <- x
# Set starting position
x[1] <- x0
y[1] <- y0
df <- attractor( positions = positions, x, y, a , b, c, d)
return(df)
}
#' Clifford Attractor
#'
#' @param positions The number of particle positions
#' @param x a vector of length `positions` with initial x position
#' @param y a vector of length `positions` with initial y position,
#' @param a a modifier for the attractor
#' @param b a modifier for the attractor
#' @param c a modifier for the attractor
#' @param d a modifier for the attractor
attractor_clifford <- function(positions, x, y, a, b,c,d){
for(i in 2:positions) {
x[i] <- sin(a*y[i-1])+c*cos(a*x[i-1])
y[i] <- sin(b*x[i-1])+d*cos(b*y[i-1])
}
data.frame(x = x, y = y)
}
#' The henon attractor.
#'
#' @description This one seems to be fairly fiddly.
#'
#' @param positions The number of positions
#' @param x vector of length `positions` for x
#' @param y vector of length `positions` for y
#' @param a a modifier for the attractor try(1)
#' @param b a modifier for the attractor try(1.4)
#' @param c a modifier for the attractor try(2)
#' @param d a modifier for the attractor try(0.3)
attractor_henon <- function(positions, x, y, a , b, c, d){
for(i in 2:positions) {
x[i] <- (y[i-1]+a)-(b*(x[i-1])^c)
y[i] <- d*(x[i-1])
}
data.frame(x = x, y = y)
}
#' Bedhead Attractor
attractor_bedhead <- function(positions, x, y, a , b, c, d){
for(i in 2:positions) {
x[i] <- sin(x[i-1]*y[i-1]/b)*y[i-1]+cos(a*x[i-1]-y[i-1])
y[i] <- x[i-1]+sin(y[i-1])/b
}
data.frame(x = x, y = y)
}
#' Fractal Dream Attractor
attractor_fractal_dream <- function(positions, x, y, a , b, c, d){
for(i in 2:positions) {
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]*a)
}
data.frame(x = x, y = y)
}
attractor_Gumowski_Mira <- function(positions, x, y, a , b, c, d){
for(i in 2:positions) {
w <- a*x[i-1]+(2*(1-a)*x[i-1]^2)/(1+x[i-1]^2)
x[i] <- b*y[i-1]+w
y[i] <- w-x[i-1]
}
data.frame(x = x, y = y)
}
attractor_hopalong <- function(positions, x, y, a , b, c, d){
for(i in 2:positions) {
x[i] <- y[i-1]-1-sqrt(abs(b*x[i-1]-1-c))*sign(x[i-1]-1)
y[i] <- a-x[i-1]-1
}
data.frame(x = x, y = y)
}
attractor_swirl <- function(positions, x, y, a , b, c, d){
for(i in 2:positions) {
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)
}
data.frame(x = x, y = y)
}
attractor_lorenz <- function(positions, x, y, z, a , b , c , d){
for(i in 2:positions) {
x[i] <- b * (y[i-1] - x[i-1])
y[i] <- x[i-1] * (a - z[i-1]) - y[i-1]
z[i] <- x[i-1] * y[i-1] - c * z[i-1]
}
data.frame(x = x, y = y, z = z)
}
# #create_trajectory(3000000, 0,0,2,1,8,2)->plot_data
# create_trajectory(3000000, 0,0,1.24,-1.25,-1.81,-1.91)->plot_data
#
# ggplot(plot_data , aes(x, y)) + geom_point(color="#1E1E1E", shape=46, alpha=.05) + theme_canvas("#F9F1F1")+
# coord_polar()
# #00FF41
# ggsave("infinite_torus3.png", type = "cairo", bg = "#F9F1F1")
#
# palette_tmp <- colorRampPalette(colors = c("black","#008F9B","#FCB76D"))
# color_by_density(new_name = "infinite_torus_color3.png", "infinite_torus3.png", "grey", palette = rev(palette_tmp(3000)))
#
#
# polygon_outline_pts <- function(points = 10000, edges = 3, start_angle = 0, r = 10, wind_angle = 0, cx = 0, cy = 0) {
# a = start_angle * (pi / 180)
# n = floor(points / edges)
#
# #lay out the corner points
# corners <- tibble(angle = seq(0 + a, 2*pi + a, length.out = edges + 1), x = r*cos(angle) + cx, y = r*sin(angle) + cy)
#
# edges_list <- list()
#
# #for each edge, interpolate the points between the corners
# for(i in 1:edges) {
# edges_list[[i]] <- tibble(id = 1:n) %>%
# mutate(d = id / n,
# x = (1 - d) * corners$x[i] + d * corners$x[i + 1],
# y = (1 - d) * corners$y[i] + d * corners$y[i + 1])
# }
#
# bind_rows(edges_list)
#
# }
#
#
# create_trajectory(3000000, 0,0,1.5,-1.5,-2.81,-1.0)->plot_data_1
#
#
# create_trajectory(3000000, 1,2, 3,-1.5,-5.62,-1.0)->plot_data_2
#
# shape <- polygon_outline_pts(3000000, 6, 5, wind_angle = 10)
# ggplot() +
# geom_point(data= plot_data_2 , aes(x, y),
# color="#008F9B", shape=46, alpha=.05) +
# geom_point(data= plot_data_1 , aes(x, y),
# color="#AC78BA", shape=46, alpha=.05)+
# #geom_point(data = shape, aes(x, y))
#
# theme_canvas("#F9F1F1")
#
#
#
# plot_data_1$id <- 1
# plot_data_2$id <- 2
#
# geom_test <- "bar"
#
#
#
# set.seed(42)
# rbind(plot_data_1, plot_data_2) %>%
# mutate(z = rnorm(6000000, 0,1)) %>%
# arrange(z) %>%
# mutate(
# color = z*.5+id * (lag(id)+lead(id))/5
# )-> combined
#
#
# ggplot() +
# geom_point(data= combined , aes(x, y, color = color),
# shape=46, alpha=.05)+
# #geom_point(data = shape, aes(x, y))
#
# theme_canvas("#F9F1F1")+
# delabj::scale_color_delabj("retro", discrete = FALSE)
# ggsave("rift.png", type = "cairo", height = 8, with = 12, dpi = 600)
# color_by_density()
#
#
#
#
# create_trajectory(3000000, -1,1,5,-1.25,-3,-1.91)->plot_data
#
#
# ggplot(plot_data , aes(x, y)) + geom_point(color="#1E1E1E", shape=46, alpha=.05) + theme_canvas("#F9F1F1")
# ggsave("echos.png", type = "cairo", height = 10, width = 8, dpi = 600)
# palette_tmp <- colorRampPalette(colors = c("black","black","#5B3758", "#721121","#E64E8D", "#EE9537"))
#
# color_by_density("echos_col.png", "echos.png", palette = rev(palette_tmp(3000)))
#
#
#
# create_trajectory(3000000, 1,1,5,-2.25,-3,-1)->plot_data_1
# create_trajectory(3000000, 1,-1,3,-2.25,-1,-2)->plot_data_2
# create_trajectory(750000, 1,1,5,-2.25,-3,-1)->plot_data_1
#
#
#
#
# ggplot() +
# geom_point(data = plot_data_1, aes(x, y), color="#1E1E1E", shape=46, alpha=.05) +
# geom_point(data = plot_data_2, aes(x, y, size = abs(x+y)*4 ), color = "#F9F1F1", alpha=.05, shape=46)+
# geom_point(data = plot_data_3, aes(x, y), color="#1E1E1E", shape=46, alpha=.05) +
# theme_canvas("#F9F1F1")+
# coord_polar(theta="y")
#
# ggsave("occlusion_y.png", type = "cairo", height = 8, width = 8, dpi = 600 )
#
# palette_tmp <- colorRampPalette(colors = c("black","#008F9B","#FCB76D"))
#
# color_by_density("test_col.png", "Rplot test.png", palette = rev(palette_tmp(3000)))
# color_by_density("occlusion1_col.png", "occlusion.png", palette = rev(palette_tmp(3000)))
# color_by_density("occlusiony_col.png", "occlusion_y.png", palette = rev(palette_tmp(3000)))
#
# create_trajectory(3000000, 1,1,0.65343,0.7345345,NA,NA, "bedhead") ->plot_data_4
# create_trajectory(3000000, 1,1,0.65343,0.7345345,NA, NA, "bedhead") ->plot_data_5
# range(plot_data_5$x)
# range(plot_data_5$y)
#
#
# ggplot() +
# geom_point(data = plot_data_4, aes(x, y), color="#1E1E1E", alpha=.05, shape=46) +
# theme_canvas("#F9F1F1")
#
#
# ggsave("bedhead_demo.png", type = "cairo", height = 8, width = 8, dpi = 600)
#
#
#
# create_trajectory(3000000, 0.1,0.1, 1.4,1.56,1.4,-6.56, "swirl") ->plot_data_4
# range(plot_data_4$x)
# range(plot_data_4$y)
#
#
# plot_data_4 %>%
# mutate(
# tmp = x,
# x= -y,
# y=tmp
# ) %>%
# select(-tmp)-> rotate
#
# ggplot() +
# geom_point(data = rotate, aes(x, y), color="#5B3758", alpha=.05, shape=46) +
#
# geom_point(data = plot_data_4, aes(x, y+3), color="#1E1E1E", alpha=.05, shape=46) +
# geom_point(data = plot_data_4, aes(x, y-3), color="#1E1E1E", alpha=.05, shape=46) +
#
#
# theme_canvas("#F9F1F1")
#
#
# ggsave("swirl_test.png", type = "cairo", height = 8, width = 8, dpi = 600)
# ggsave("swirl_tests.png", type = "cairo", height = 6, width = 12, dpi = 600)
# ggsave("3_rings.png", type = "cairo", height = 8, width = 12, dpi = 600)
#
#
# ## 45
#
# plot_data_4 %>%
# rotate_trajectory(x,y, 15) -> rotated_15
#
# plot_data_4 %>%
# rotate_trajectory(x,y, 30) -> rotated_30
# plot_data_4 %>%
# rotate_trajectory(x,y, 45) -> rotated_45
# ggplot() +
# geom_point(data = plot_data_4, aes(x, y), color="#1E1E1E", alpha=.05, shape=46) +
# geom_point(data = rotated_15, aes(x, y), color="#6a6a6a", alpha=.025, shape=46) +
# geom_point(data = rotated_30, aes(x, y), color="#6a6a6a", alpha=.025, shape=46) +
# geom_point(data = rotated_45, aes(x, y), color="#1E1E1E", alpha=.05, shape=46) +
#
#
# theme_canvas("#F9F1F1")
#
#
# ggsave("orbit_test.png", type = "cairo", height = 10, width = 8, dpi = 600)
#
#
# palette_tmp <- colorRampPalette(colors = c("black","black","#003B00","#003B00","#008F11","#008F11", "#00FF41"))
# viridis::magma()
# color_by_density("orbit_test_col.png", "orbit_test.png", palette = viridis::magma(3000))
positions <- 3000000
x <- vector(mode = "numeric", length = positions)
x[1] <- 1
y <- x
z <- x
attractor_lorenz(positions, x, y, z, 28,10,8/3,NULL)-> test
range(plot_data_4$x)
plot_data_4 <- plot_data_4 %>%
mutate(group = case_when(
x > 3.779994 & abs(y)>=2 ~ 1,
x < 3.779994 & abs(y^x)>=2 ~ 2,
x > y & abs(y)<=2 ~ 3,
x < 2 & abs(y)>=2 ~ 4,
TRUE ~ 5
))
plot_data_4$group
plot_data_4 %>%
arrange(y) %>%
replace_na(list(group = c(6))) %>%
ggplot(aes(x,y, group = group, fill =as.factor(group), subgroup = group-1))+
geom_polygon( alpha = .4)+
geom_point(color="#1E1E1E", alpha=.05, shape=46)+
geom_polygon( alpha = .5)+
theme_canvas()+
delabj::scale_fill_delabj()
ggsave("jar.png", type="cairo", height=6, width = 4 )
chull()
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.