R/attractors.R

Defines functions attractor_lorenz attractor_swirl attractor_hopalong attractor_Gumowski_Mira attractor_fractal_dream attractor_bedhead attractor_henon attractor_clifford create_trajectory

#' 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()
delabj/genArt documentation built on March 25, 2021, 11:56 p.m.