R/tweak_spectro.R

In warbleR: Streamline Bioacoustic Analysis

#' Plot a mosaic of spectrograms with varying display parameters
#' 
#' \code{tweak_spectro} plots a mosaic of spectrograms with varying display parameters to
#' facilitate selection of display parameters
#' @usage tweak_spectro(X, length.out = 5, ovlp = 90, wl = c(100, 1000), wn = "hanning",
#'  collev.min = -40, pal = "reverse.gray.colors.2", path = NULL, rm.axes = TRUE, ...)
#' @param X object of class 'selection_table', 'extended_selection_table' or data frame with a single row and columns for sound file name (sound.files), selection number (selec), 
#' and start and end time of signal (start and end). Default is \code{NULL}.
#' @param length.out Numeric vector of length 1 controlling the number of sublevels of
#'  the numeric arguments for which a range has been provided. Ranges are allowed for
#'  'ovlp', 'wl', and 'collev.min' arguments.
#' @param ovlp Numeric vector of length 1 or 2 specifying \% of overlap (or 
#' lower/upper values the desired range) between two consecutive windows, as in 
#' \code{\link[seewave]{spectro}}. Default is 90.
#' @param wl A numeric vector of length 1 or 2 specifying the window length (length 1)
#' or the lower and upper range limits of the desired window length range (length 2) for creating spectrograms.
#' Default is c(100, 1000).
#' @param wn Character vector specifying the window function names to be used. Several
#' names can be provided. See \code{\link[seewave]{ftwindow}}
#' for name options. Default is "hanning". If "all", then all window functions available are used.
#' @param collev.min A (negative) numeric vector of length 1 or 2. Determines the first argument
#' to use in 'collevels' for the internal spectrogram creating function. This replaces the 
#' first element in the 'collevels' as in \code{\link[seewave]{spectro}}. Note that
#' 'collevels' is not available in this function \code{\link[warbleR]{tweak_spectro}}.
#' @param pal Color palette function for spectrogram. Default is "reverse.gray.colors.2". 
#' Several palettes can be provided in a character vector. Note that, contrary to
#'  other \code{warbleR} and \code{seewave} functions, the 
#' palette most be provided as character string rather than as a function. See 
#' \code{\link[seewave]{spectro}} for more palettes. 
#' @param path Character string containing the directory path where the sound file are located. 
#' @param rm.axes Logical. If \code{TRUE} frequency and time axes are excluded. Default is \code{TRUE}.
#' @param ... Additional arguments to be passed to \code{\link{catalog}} function for customizing
#' graphical output. Check out \code{\link{catalog}} for more details.
#' @return Image files with spectrograms of entire sound files in the working directory. Multiple pages
#' can be returned, depending on the length of each sound file. 
#' @export
#' @name tweak_spectro
#' @details This functions aims to simplify the selection of spectrogram parameters. 
#' The function plots, for a single selection, a mosaic of spectrograms with varying 
#' display parameters. For numeric arguments the upper and lower limits of a range can
#' be provided. The following arguments accept can have varying values:
#' \itemize{
#'    \item \code{wl}: Windows length (numeric range)
#'    \item \code{ovlp}: Overlap (numeric range)
#'    \item \code{collev.min}: Minimum value of the color levels (numeric range) 
#'    \item \code{wn}: window function names (character)
#'    \item \code{pal}: palette (character)
#'    }
#'  Outputs are similar to those of \code{\link{catalog}}. The output image files can be put together in a single pdf file with \code{\link{catalog2pdf}}.
#'   We recommend using low resolution (~60-100) and smaller dimensions (width & height < 10) if
#'   aiming to generate pdfs (otherwise pdfs could be pretty big).
#' @seealso \code{\link{catalog2pdf}}
#' @examples
#' \dontrun{
#' # Save to temporary working directory
#' 
#' # save sound file examples
#' data(list = c("Phae.long1", "lbh_selec_table"))
#' writeWave(Phae.long1, file.path(tempdir(), "Phae.long1.wav")) 
#' 
#' # variable collevels
#' tweak_spectro(X = lbh_selec_table, wl = 164, ovlp = c(90), wn = c("flattop"), 
#' length.out = 16, nrow = 4, ncol = 4, width = 20, height = 11.3, rm.axes = TRUE, 
#' cex = 1, box = F, collev.min = c(-20, -150), path = tempdir(), flim = c(0, 10))
#' 
#' # variable overlap and wn
#' tweak_spectro(X = lbh_selec_table, wl = 164, ovlp = c(50, 90), 
#' wn = c("hanning", "hamming", "rectangle", "bartlett", "blackman", "flattop"),
#' length.out = 7, nrow = 6, ncol = 7, width = 20, height = 11.3, rm.axes = TRUE, 
#' cex = 1, box = F, path = tempdir(), flim = c(0, 10))
#' 
#' # variable wl and wn
#' tweak_spectro(X = lbh_selec_table, wl = c(100, 1000), ovlp = c(50, 90), wn = "all", 
#' length.out = 5, nrow = 10, ncol = 14, width = 20, height = 11.3, rm.axes = TRUE, 
#' cex = 0.7, path = tempdir(), flim = c(0, 10))
#' 
#' # variable wl, collev.min and wn 
#' tweak_spectro(X = lbh_selec_table, wl = c(100, 1000), ovlp = 90, 
#' wn = c("hanning", "hamming", "rectangle"), collev.min = c(-110, -25), 
#' length.out = 3, nrow = 10, ncol = 14, width = 20, height = 11.3, rm.axes = TRUE,
#'  cex = 0.7, path = tempdir(), flim = c(0, 10))
#'  
#'  # variable wl, wn and pal
#'  tweak_spectro(X = lbh_selec_table, wl = c(100, 1000), ovlp = 90, 
#'  wn = c("hanning", "hamming", "rectangle"), 
#'  pal = c("reverse.gray.colors.2", "reverse.topo.colors", 
#'  "reverse.terrain.colors", "reverse.cm.colors"), 
#'  length.out = 4, nrow = 5, ncol = 10, width = 20, height = 11.3,
#'   rm.axes = TRUE, cex = 0.7, lab.mar = 2, path = tempdir(), flim = c(0, 10))
#'   
#'   # wl, wn and pal
#'   tweak_spectro(X = lbh_selec_table, wl = c(100, 1000), ovlp = 90,
#'    wn = c("hanning", "hamming", "rectangle"), 
#'   pal = c("reverse.gray.colors.2", "reverse.topo.colors", 
#'   "reverse.terrain.colors", "reverse.cm.colors"), 
#'   length.out = 4, nrow = 5, ncol = 10, width = 20, height = 11.3, rm.axes = TRUE,
#'    cex = 0.7, group.tag = "wn",  spec.mar = 0.4, lab.mar = 0.8, box = FALSE, 
#'    tag.pal = list(reverse.cm.colors), path = tempdir(), flim = c(0, 10))
#' 
#' check this floder
#' tempdir()
#' }
#' @author Marcelo Araya-Salas (\email{marcelo.araya@@ucr.ac.cr})
#last modification on mar-08-2018 (MAS)

tweak_spectro <- function(X, length.out = 5, ovlp = 90, wl = c(100, 1000), 
                    wn = "hanning", collev.min = -40,
                    pal = "reverse.gray.colors.2", path = NULL, rm.axes = TRUE, ...)
{
  #### set arguments from options
  # get function arguments
  argms <- methods::formalArgs(tweak_spectro)
  
  # get warbleR options
  opt.argms <- if(!is.null(getOption("warbleR"))) getOption("warbleR") else SILLYNAME <- 0
  
  opt.argms <- opt.argms[which(names(opt.argms) == "path")]
  
  # remove options not as default in call and not in function arguments
  opt.argms <- opt.argms[!sapply(opt.argms, is.null) & names(opt.argms) %in% argms]
  
  # get arguments set in the call
  call.argms <- as.list(base::match.call())[-1]
  
  # remove arguments in options that are in call
  opt.argms <- opt.argms[!names(opt.argms) %in% names(call.argms)]
  
  # set options left
  if (length(opt.argms) > 0)
    for (q in seq_len(length(opt.argms)))
      assign(names(opt.argms)[q], opt.argms[[q]])
  
  # stop if pal is function
  if (is.function(pal)) stop2("'pal' should be a character vector")
  
  ## reset parameters
  # only seewave spectros
  fast.spec <- FALSE
  if (wn[1] == "all") wn <- c("bartlett", "blackman", "flattop", "hamming", "hanning", "rectangle")
  
  #if X is not a data frame
  if (!any(is.data.frame(X), is_selection_table(X), is_extended_selection_table(X))) stop2("X is not of a class 'data.frame', 'selection_table' or 'extended_selection_table'")
  
  if (nrow(X) > 1){
  X <- X[1, , drop = FALSE]
   warning2(x = "Data frame provided has more than 1 selection (row), only the first one was used")
  }
  
  if (length.out < 2) stop2("'length.out' should be equal or higher than 2")
  
  exp.cols <- c("ovlp", "wl", "wn", "collev.min", "pal")[which(c(length(ovlp), length(wl), length(wn), length(collev.min), length(pal)) > 1)]
  
  # expand arguments
  if (length(wl) > 1)
  wl <- seq(wl[1], wl[2], length.out = length.out)

  if (length(ovlp) > 1)
    ovlp <- seq(ovlp[1], ovlp[2], length.out = length.out)
  
  if (length(collev.min) > 1)
    collev.min <- seq(collev.min[1], collev.min[2], length.out = length.out)
  
  if (is_extended_selection_table(X))  X.orig <- X
  
  # Expand data frame
  X <- suppressWarnings(data.frame(X, expand.grid(ovlp = ovlp, wl = wl, 
          collev.min = collev.min, wn = wn, pal = pal), stringsAsFactors = FALSE))
 
  X$ovlp <- round(X$ovlp, 0)
  X$wl <- round(X$wl, 0)
  X$collev.min <- round(X$collev.min, 0)
  X$selec2 <- X$selec
  X$selec <- 1:nrow(X)
  X$lbs <- ""
  
  
  if (length(exp.cols) > 0)
  for(i in seq_len(length(exp.cols)))
    X$lbs <- paste(X$lbs, exp.cols[i], "=", X[ , exp.cols[i]], " ")
  
  co <- 32
  if (max(nchar(X$lbs)) > co) {
    empty_spc <- sapply(gregexpr(" ", substr(X$lbs, co, 1000)), "[[", 1) + co

        for(i in 1:nrow(X)){
          if (nchar(X$lbs[i]) > co)
    substring(X$lbs[i], first = empty_spc[i], last = empty_spc[i] + 1) <- paste0("\n", substr(X$lbs[i], empty_spc[i], empty_spc[i] + 1))
        }
    }
  
  X$lbs <- gsub(" \n$| $|  $|^ |^  ", "", X$lbs)  
  
  
  if (exists("X.orig"))
    {
    attributes(X)$check.results <- do.call(rbind, lapply(1:nrow(X), function(x) attributes(X.orig)$check.results[1, ]))
    attributes(X)$check.results$selec <- 1:nrow(X)

    attributes(X)$wave.objects <- attributes(X.orig)$wave.objects[1]

    attributes(X)$by.song <- attributes(X.orig)$by.song
    class(X) <- class(X.orig)
    }

    catalog(X = X, ovlp = X$ovlp, wl = X$wl, collevels = "collev.min", title = paste(X$sound.files[1], X$selec2[1]), rm.axes = rm.axes, img.suffix = "tweak_spectro", 
                  wn = X$wn, pal = "pal.list", path = path, labels = c("lbs"), ...)
  
    
  return(NULL)  
}

##############################################################################################################
#' alternative name for \code{\link{tweak_spectro}}
#'
#' @keywords internal
#' @details see \code{\link{tweak_spectro}} for documentation. \code{\link{spec_param}} will be deprecated in future versions.
#' @export

spec_param <- tweak_spectro