R/dither.R

In cj-holmes/ditherer:

#' Produce an image with ordered dithering
#'
#' An implementation of ordered or error diffusion dithering
#'
#' @param img path or URL to image
#' @param res horizontal resolution of output image in pixels (default = 200)
#'   This is only used if scale = NULL (which is the default behavior). The reason for this is to try and
#'   prevent very large images being processed by accident (large images will be slow to dither)
#' @param scale scaling percentage (default = NULL).
#'   If scale is not NULL, it overrides the value of res. Full size = 100, half size = 50 etc.
#' @param target_palette A target palette of colours for the output image. One of
#' \itemize{
#'   \item "c216" - 216 colours spaced uniformly in RGB (default)
#'   \item "c64" - 64 colours spaced uniformly in RGB
#'   \item A vector of colours generated by the user}
#' @param r spread in color space for target palette (default = 1/8). This default is set to look 'OK' by eye. It is probably the factor that will
#'   most significantly change the appearance of the dithering. Higher numbers will give 'broader' more dithering and lower numbers will give 'tighter' less dithering
#' @param bayer_size bayer matrix size (square matrix of side length 2^bayer_size) (default = 3)
#' @param dither dither type, one of
#' \itemize{
#'   \item "ordered" - Ordered dithering using a bayer matrix (default)
#'   \item "diffusion" - Floyd/Steinberg error diffusion dithering from \code{magick::image_map()}
#'   \item "none" - No dithering}
#' @param original return the original image (resized to \code{res})
#' @export
dither <- function(img,
                   res = 200,
                   scale = NULL,
                   target_palette = "c216",
                   r = 1/8,
                   bayer_size = 3,
                   dither = "ordered",
                   original = FALSE){

  # Resize image and save info ----------------------------------------------
  if(class(img) == "magick-image"){
    i <-
      img %>%
      magick::image_scale(geometry = ifelse(is.null(scale),
                                            magick::geometry_size_pixels(width=res),
                                            magick::geometry_size_percent(width = scale)))}
  else {
    i <-
      magick::image_read(img) %>%
      magick::image_scale(geometry = ifelse(is.null(scale),
                                             magick::geometry_size_pixels(width=res),
                                             magick::geometry_size_percent(width = scale)))}

  # Compute information on resized image
  info_out <- magick::image_info(i)


  # Define the target image -------------------------------------------------
  if(target_palette == "c216"){
    t <- matrix(c216, nrow=1) %>% magick::image_read()
  }else if(target_palette == "c64"){
    t <- matrix(c64, nrow=1) %>% magick::image_read()
  }else{
    # If a palette of colours is passed, turn it into a magick image and this will be our target image to map colours too
    # n (number of colours) must be overwritten to the length of the palette provided
    # The n that is passed to the function will essentially be ignored
    t <- matrix(target_palette, nrow=1) %>% magick::image_read()
  }

  # Create dither matrix ----------------------------------------------------
  if(original){
    # If original is requested - return the original image (rescaled) as a dataframe
    p <- i %>% magick::image_raster()

  } else if(dither == "ordered"){
    # If dither is ordered do ordered dithering and return dithered image as dataframe
    dm <-
      bayer(bayer_size) %>%
      norm_bayer() %>%
      rep_mat(nrow_out = info_out[["height"]],
              ncol_out = info_out[["width"]]) %>%
      as.vector()

    pos_dither <-
      replace(dm, sign(dm) != 1, values = 0) %>%
      magrittr::multiply_by(255 * r) %>%
      rgb(., ., ., maxColorValue = 255) %>%
      matrix(nrow = info_out[["height"]],
             ncol = info_out[["width"]]) %>%
      magick::image_read()

    neg_dither <-
      replace(dm, sign(dm) != -1, values = 0) %>%
      abs() %>%
      magrittr::multiply_by(255 * r) %>%
      rgb(., ., ., maxColorValue = 255) %>%
      matrix(nrow = info_out[["height"]],
             ncol = info_out[["width"]]) %>%
      magick::image_read()

    # Apply dither and generate plot
    p <-
      magick::image_composite(neg_dither,
                              magick::image_composite(i, pos_dither, operator = "Plus"),
                              operator = "Minus") %>%
      magick::image_map(t) %>%
      magick::image_raster()

  } else if(dither == "diffusion"){
    # If dither is diffusion do error diffusion dithering (through {magick})
    p <-
      i %>%
      magick::image_map(t, dither = TRUE) %>%
      magick::image_raster()

  } else if(dither == "none"){
    p <- i %>% magick::image_map(t, dither = FALSE) %>% magick::image_raster()

  } else {
    stop('dither options are "ordered", "diffusion" or "none"')

  }

  p %>%
    ggplot2::ggplot(ggplot2::aes(x, y, fill = col)) +
    ggplot2::geom_raster()+
    ggplot2::scale_fill_identity()+
    ggplot2::coord_equal()+
    ggplot2::theme_void()+
    ggplot2::scale_x_continuous(expand = ggplot2::expansion(mult=0, add=0))+
    ggplot2::scale_y_reverse(expand = ggplot2::expansion(mult=0, add=0))
}