R/tweak.R

In moodymudskipper/tweak: Modifies PNG images

#' Does simple tranformations to an image
#'
#' Recolor, add transparency, cut an image into two parts etc
#' @param img pth, url, array or raster of image to transform, supports tif jpg and png
#' @param color the color to convert to, only R colors, original colors kept if NULL
#' @param bold set all color values to chosen color, leaves alpha untouched (0 to 1)
#' @param alpha to add more transparency (0 to 1)
#' @param cuts vector of relative positions of cuts (0 to 1)
#' @param dir direction of separation
#' @details Originally designed to help build infographics in R.
#' @examples
#' img <- system.file("img", "Rlogo.png", package="png")
#' imgs <- list(
#'   tweak(img),            # original
#'   tweak(img,alpha=0.5),  # transparent
#'   tweak(img,"black"),    # greyscales
#'   tweak(img,"darkred"),    # any R color
#'   tweak(img,cuts=c(0.7),alpha = c(0,NA)),          # clean cut
#'   tweak(img,cuts=c(0.7),alpha = c(0.5,NA)),        #   transparency
#'   tweak(img,cut=c(0.33,0.66), dir = "h",
#'     color=c("black","gold","darkred")),      #   color on both side
#'   tweak(img,"darkred",bold = 1),            # make completely bold
#'   tweak(img,"darkred",bold = 0.3)          # make partially bold
#' )
#' showcase(imgs)
#' @export
tweak <- function(img, color = NA, bold=NA,alpha=NA,
                  cuts=NULL,dir="v"){
  assertthat::assert_that(dir %in% c("h","v"))
  assertthat::assert_that(is.null(bold) | !is.null(color))
  if(is.null(cuts)){
    mat <- tweak0(img,color,bold,alpha)
  } else
  {
    mat <- convert(img,to="matrix")
    if(dir == "v") cut_pos <- c(0,round(cuts * nrow(mat)),nrow(mat)+1) else
      cut_pos <- c(0,round(cuts * ncol(mat)),ncol(mat)+1)
    # +1 because slices stop at next-1
    keep <- !duplicated(cut_pos)
    cut_pos <- cut_pos[keep]
    if(length(color) ==1) color <- rep(color,length(cuts)+1)
    if(length(bold)  ==1) bold  <- rep(bold, length(cuts)+1)
    if(length(alpha) ==1) alpha <- rep(alpha,length(cuts)+1)
    color <- color[keep[-1]]
    bold  <-  bold[keep[-1]]
    alpha <- alpha[keep[-1]]

    cut_mat <- cbind(cut_pos[-length(cut_pos)],cut_pos[-1])
    if(dir == "v") spl     <- apply(cut_mat,1,function(x) mat[x[1]:(x[2]-1),]) else
      spl <- apply(cut_mat,1,function(x) mat[,x[1]:(x[2]-1)])

    spl_new <- Map(tweak0,spl,color,bold,alpha) # run tweak0 on all subsets, with relevant slice parameters, and concatenate back
    if(dir == "v") mat     <- do.call(rbind,spl_new) else
      mat     <- do.call(cbind,spl_new)
  }
  rst <- as.raster(mat)
}

tweak0 <- function(img,color,bold,alpha){
  lng <- convert(img,to="long")
  bri <- brightness(lng)
  if(!is.na(bold))  bri       <- bri *(1-bold)
  if(!is.na(color)) lng[,1:3] <- colorRamp(c(color, "white"))(bri)/255
  if(!is.na(alpha)) lng[,4]   <- lng[,4] * alpha
  mat <- convert(lng,to="matrix",from="long")
  mat
}

brightness <- function(lng){
  sqrt(0.299 * lng[,1]^2 + 0.587 * lng[,2]^2 + 0.114 * lng[,3]^2)
}