R/move_images.R

In warbleR: Streamline Bioacoustic Analysis

#' Move/copy image files between directories
#'
#' \code{move_images} moves/copies image files created by \code{\link{warbleR}} between
#' directories (folders).
#' @usage move_images(from = NULL, to = NULL, it = "all", cut = TRUE,
#' overwrite = FALSE, create.folder = TRUE, folder.name = "image_files",
#' parallel = 1, pb = TRUE)
#' @param from Directory path where image files to be copied are found.
#'  If \code{NULL} (default) then the current working directory is used.
#' @param to Directory path where image files will be copied to.
#' @param it A character vector of length 1 giving the image type to be used. "all",
#' "tiff", "jpeg" and "pdf" are admitted ("all" includes all the rest). Default is "all".
#' @param cut Logical. Determines if files are removed from the original location after
#' being copied (cut) or not (just copied). Default is \code{TRUE}.
#' @param overwrite Logical. Determines if files that already exist in the destination directory
#' should be overwritten. Default is \code{FALSE}.
#' @param create.folder Logical. Determines if files are moved to a new folder (which is named with the
#' "folder.name" argument). Ignored if 'to' is provided. Default is \code{TRUE}.
#' @param folder.name Character string with the name of the new folder where the files will be
#' copied to. Ignored if 'to' is provided. Default is \code{"image_files"}.
#' @param parallel Numeric. Controls whether parallel computing is applied.
#'  It specifies the number of cores to be used. Default is 1 (i.e. no parallel computing).
#' @param pb Logical argument to control progress bar. Default is \code{TRUE}.
#' @family data manipulation
#' @seealso \code{\link{filtersels}}
#' @export
#' @name move_images
#' @details This function aims to simplify the manipulation of the image files generated by many
#' of the \code{\link{warbleR}} function. It copies/cuts files between directories.
#' @return Image files moved into user-defined folders.
#' @examples
#' {
#'   # load data
#'   data(list = c("Phae.long1", "Phae.long2", "Phae.long3", "Phae.long4", "lbh_selec_table"))
#'   writeWave(Phae.long1, file.path(tempdir(), "Phae.long1.wav"))
#'   writeWave(Phae.long2, file.path(tempdir(), "Phae.long2.wav"))
#'
#'   # create spectrograms
#'   spectrograms(lbh_selec_table[1:5, ], path = tempdir(), pb = FALSE)
#'
#'   # create folder to move image files
#'   dir.create(file.path(tempdir(), "imgs"))
#'
#'   # copy files
#'   move_images(cut = FALSE, from = tempdir(), to = file.path(tempdir(), "imgs"))
#'
#'   # cut files
#'   move_images(
#'     cut = TRUE, from = tempdir(),
#'     to = file.path(tempdir(), "imgs"), overwrite = TRUE
#'   )
#'
#'   # Check this folder
#'   file.path(tempdir(), "imgs")
#' }
#'
#' @references {
#' Araya-Salas, M., & Smith-Vidaurre, G. (2017). warbleR: An R package to streamline analysis of animal acoustic signals. Methods in Ecology and Evolution, 8(2), 184-191.
#' }
#' @author Marcelo Araya-Salas (\email{marcelo.araya@@ucr.ac.cr})
# last modification on feb-09-2017 (MAS)

move_images <- function(from = NULL, to = NULL, it = "all", cut = TRUE, overwrite = FALSE, create.folder = TRUE, folder.name = "image_files", parallel = 1, pb = TRUE) {
  if (is.null(from)) from <- getwd()
  if (is.null(to) & !create.folder) stop2("Either 'to' must be provided or 'create.folder' set to TRUE")
  if (is.null(to) & create.folder) {
    to <- file.path(from, folder.name)
    if (dir.exists(to)) stop2("Directory with folder name provided already exists")
    dir.create(to)
  }

  # Check directory permissions
  if (file.access(to, 2) == -1) stop2(paste("You don't have permission to copy files into", to))


  #### set arguments from options
  # get function arguments
  argms <- methods::formalArgs(move_images)

  # get warbleR options
  opt.argms <- if (!is.null(getOption("warbleR"))) getOption("warbleR") else SILLYNAME <- 0

  # 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]])
    }
  }

  # define what image type will be copied
  if (it == "all") pattern <- "\\.jpeg$|\\.tiff$|\\.pdf$"
  if (it == "tiff") pattern <- "\\.tiff$"
  if (it == "jpeg") pattern <- "\\.jpeg$|\\.jpg$"
  if (it == "pdf") pattern <- "\\.pdf$"

  # list images
  imgs <- list.files(path = from, pattern = pattern, ignore.case = TRUE)

  if (length(imgs) == 0) {
    message2(paste("No image files were found in", from))
  } else {
    # set clusters for windows OS
    if (Sys.info()[1] == "Windows" & parallel > 1) {
      cl <- parallel::makePSOCKcluster(getOption("cl.cores", parallel))
    } else {
      cl <- parallel
    }

    a <- pblapply_wrblr_int(pbar = pb, X = seq(1, length(imgs), by = 10), cl = cl, FUN = function(x) {
      if (length(imgs) <= x + 9) y <- length(imgs) else y <- x + 9

      file.copy(from = file.path(from, imgs[x:y]), to = file.path(to, imgs[x:y]), overwrite = overwrite)
    })

    a <- unlist(a)

    # a <- file.copy(from = file.path(from, imgs), to = file.path(to, imgs), overwrite = overwrite)

    if (all(!a) & !overwrite) message2(paste("All files already existed in", to)) else if (any(!a) & !overwrite) message2(paste("Some files already existed in 'to'", to))

    if (cut) unlink(file.path(from, imgs)[a])
  }
}


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

move_imgs <- move_images