R/showcase.R

In moodymudskipper/tweak: Modifies PNG images

#' shows a list of images in a convenient way
#'
#' @param imgs list of raster objects or single raster object
#' @param width,height layout of plot, default to a square or close
#' @param normalize x to normalize width, y for height, square to stretch to a square
#' @param cex numeric character expansion factor, see ?text
#' @param show_code display code under the picture, if the call contains the code.
#' @param max_char_code to limit amount of characters shown when displaying code
#' @details normalise: x to normalize width, y for height, sq
#' @examples
#' showcase(tweak(system.file("img", "Rlogo.png", package="png"),
#'   color="purple",bold=1,alpha = 0.3))
#' @export
showcase <- function(imgs,width =NULL,height=NULL,
                     normalize=c("no","x","y","square"),
                     cex=0.75, show_code = FALSE,max_char_code = 40){
  if(!is.list(imgs)) imgs <- list(imgs)
  assertthat::assert_that(all(sapply(imgs,class) == "raster"))
  normalize <- match.arg(normalize)
  if(is.null(width) & is.null(height)){
    width <- ceiling(sqrt(length(imgs)))     # width as a number of images
    height <- ceiling(length(imgs)/width)    # height as a number of images
  } else if(is.null(height))
    height <- ceiling(length(imgs))/width else if(is.null(width))
      width  <- ceiling(length(imgs))/height

  assertthat::assert_that(width*height >= length(imgs))
  #browser()
  labels <- NULL
  show_names <- !is.null(names(imgs))
  if(show_names) labels <- names(imgs)
  if(show_code){
    code <- as.character(substitute(imgs))[-1]
    code <- sapply(code,function(x)
      if(nchar(x) <= max_char_code) x else
        paste0(substr(x,1,max_char_code-3),"..."))
    #labels <- paste(labels,code,"\n")
  }

  if(! "list" %in% class(imgs)) imgs <- list(imgs)
  dims <- sapply(imgs,dim)
  if(normalize == "x"){
    dims <- dims / rbind(dims[2,],dims[2,])
  } else if (normalize == "y")
  {
    dims <- dims / rbind(dims[1,],dims[1,])
  } else if (normalize == "square")
  {
    dims <- dims / dims
  } else (normalize == "no")
  {
    dims <- dims / max(dims)
  }

  max_dims <- apply(dims,1,max)

  h_text = 0.1 * (show_names+show_code)
  xleft   <- max_dims[2] * ((0:(length(imgs)-1)) %% width)
  ybottom <- h_text + (max_dims[1]+h_text) * ((height-1)-(0:(length(imgs)-1)) %/% width)
  if(show_names)  y_text_names <- ybottom - 0.1
  if(!is.null(labels))  y_text_labels <- ybottom - h_text
  opar <- par()
  par(oma=c(0, 0, 0, 0),mar=c(0, 0, 0, 0))
  on.exit(suppressWarnings(par(opar)))
  plot(c(0,width *max_dims[2]-0.2),
       c(0,height *(max_dims[1]+h_text)-0.2),
       type = "n", xlab = "", ylab = "", asp=1,xaxt='n',yaxt='n')
  Map(rasterImage,
      imgs,
      xleft,
      ybottom,
      xleft+0.8 *dims[2,],
      ybottom+0.8 *dims[1,])
  if(show_code) text(code,x=xleft+0.4,y=y_text_labels,cex=cex)
  if(show_names)       text(labels,x=xleft+0.4,y=y_text_names, cex=cex)
  invisible(NULL)
}