R/spiraplot.R

In cj-holmes/spiraplot: Reproduce Images On Spirals

#' Create spiraplot images
#'
#' @param img Path of URL of image
#' @param image_res Horizontal resolution for resized image
#' @param ncols Number of shades of grey to quantise image into
#' @param spiral_turns Number of turns in spiral
#' @param spiral_res Number of points on spiral
#' @param spiral_r0 Spiral inner radius
#' @param spiral_r1_f Multiplicative scaling factor for spiral outer radius (1 makes spiral to full image width or height)
#' @param thin Size of thinnest lines in spiral
#' @param thick Size of thickest lines in spiral
#' @param aspect Image aspect "landscape" (default) or "portrait"
#' @param col_bg Background colour
#' @param col_line Spiral line colour
#' @param show_image Show image underneath spiral (default FALSE)
#' @param contrast A measure of contrast. Higher numbers will give more contrast. A value of 1 will scale the line width
#'   linearly from the darkest to the lightest shade of grey (default = 2)
#' @param offset_angle Offset angle of spiral in degrees (default = 0)
#'
#' @return A ggplot2 plot
#' @export
spiraplot <- function(img,
                      image_res = 300,
                      ncols = 16,
                      spiral_turns = 80,
                      spiral_res = 10000,
                      spiral_r0 = 0,
                      spiral_r1_f = 1,
                      thin = 0.05,
                      thick = 1.5,
                      contrast = 2,
                      offset_angle = 0,
                      aspect = "landscape",
                      col_bg = "white",
                      col_line = "black",
                      show_image = FALSE){

  # Create polygon image ----------------------------------------------------
  img_sf <-
    magick::image_read(img) %>%
    magick::image_resize(as.character(image_res), filter="point") %>%
    magick::image_convert(type = "grayscale") %>%
    magick::image_flip() %>%
    magick::image_quantize(max = ncols, dither=FALSE, treedepth = 0) %>%
    magick::image_raster() %>%
    dplyr::mutate(col = purrr::map_dbl(col, ~col2rgb(.x)[1]),
                  col = scales::rescale(col, to=c(1, 0))) %>%
    stars::st_as_stars() %>%
    sf::st_as_sf(as_points = FALSE, merge = TRUE) %>%
    sf::st_make_valid()

  # Extract coordinates from SF image
  coords <- sf::st_coordinates(img_sf)[,1:2]

  # Spiral origin at centre of image
  origin_x <- (max(coords[,1]) - min(coords[,1]))/2
  origin_y <- (max(coords[,2]) - min(coords[,2]))/2

  # If landscape image have spiral end at factor * image height
  # If portrait image have spiral end at factor * image width
  # This means you always get a full circle spiral - not one cut off by the bounds of the image
  if(aspect=="landscape"){
    spiral_r1 <- ((max(coords[,2]) - min(coords[,2]))/2)*spiral_r1_f
  } else if(aspect=="portrait"){
    spiral_r1 <- ((max(coords[,1]) - min(coords[,1]))/2)*spiral_r1_f
  }

  # Create spiral coords ----------------------------------------------------
  s <-
    spiral_coords(xo = origin_x,
                  yo = origin_y,
                  n_points = spiral_res,
                  n_turns = spiral_turns,
                  r0 = spiral_r0,
                  r1 = spiral_r1,
                  offset_angle = offset_angle) %>%
    sf::st_as_sf(coords=c("x", "y")) %>%
    dplyr::summarise(do_union = FALSE) %>%
    sf::st_cast("LINESTRING")

  # Visualise ---------------------------------------------------------------
  sf::st_agr(img_sf) <- "constant"
  sf::st_agr(s) <- "constant"

  ggplot2::ggplot()+
    {if(show_image) ggplot2::geom_sf(data = img_sf, ggplot2::aes(fill=col), col=NA)}+
    ggplot2::geom_sf(data = sf::st_intersection(img_sf, s),
                     ggplot2::aes(size = col^contrast), col=col_line)+
    ggplot2::scale_size_continuous(range=c(thin, thick))+
    ggplot2::scale_fill_viridis_c(alpha=0.7, option="plasma", direction = -1)+
    ggplot2::theme_void()+
    ggplot2::theme(legend.position = "",
                   panel.background = ggplot2::element_rect(fill = col_bg, colour = NA))
}