R/tidy_sim.R

In thierrygosselin/grur: Imputations of RADseq data

#' @title Tidy simulations
#' @description Will extract and tidy all simulations objects from a directory,
#' provided that the simulations were generated with \code{\link{simulate_rad}}.
#' @param sim.directory (character, path) Full path to the directory containing simulation objects.
#' @param write.tidy (logical, optional) The function uses \code{\link[fst]{write.fst}},
#' to write the tidy data frame in the appropriate scenario directory.
#' The file extension is \code{.rad}.
#' Default: \code{write.tidy = TRUE}.
#' @param parallel.core (integer, optional) The number of core used for parallel
#' execution during extraction of simulated data.
#' Default: \code{parallel::detectCores() - 1}.
#' @return A list with all the tidy data frames for all scenarios and iterations 
#' generated by \code{\link{simulate_rad}}. Depending on argument values, the function also 
#' write the tidy data in the appropriate folder.
#' @export
#' @rdname tidy_sim
#' @author Thierry Gosselin \email{thierrygosselin@@icloud.com}

tidy_sim <- function(sim.directory, write.tidy = TRUE, parallel.core = parallel::detectCores() - 1) {
  list.gtypes <- list.files(path = sim.directory, pattern = "gtypes", full.names = TRUE)
  load_sim_data <- function(list.gtypes = NULL, write.tidy = TRUE, write.obj = FALSE) {
    # list.gtypes <- list.gtypes[3]
    sim.data <- NULL
    load(list.gtypes)
    fsc.list <- NULL
    
    sim.name <- stringi::stri_join(
      "scenario_",
      stringi::stri_sub(str = list.gtypes, from = -8, to = -6) %>%
        stringi::stri_replace_all_fixed(
          str = ., pattern = ".",
          replacement = "", vectorize_all = FALSE) %>%
        stringi::stri_pad_left(str = ., width = 2, pad = "0"))
    sim.data <- purrr::map(.x = sim.data, .f = radiator::tidy_gtypes)
    # tidy.sim <- purrr::map(.x = sim.data, .f = radiator::tidy_gtypes)
    names(sim.data) <- stringi::stri_join(
      sim.name,
      "_iteration_",
      stringi::stri_pad_left(str = seq(1, length(sim.data)), width = 2, pad = "0")
    )
    if (write.tidy) {
      message("Writing simulations in tidy format in folder")
      path.folder <- stringi::stri_join(sim.directory,"/", sim.name, sep = "")
      dir.create(file.path(path.folder))
    } else {
      path.folder <- NULL
    }
    
    extract_save <- function(x, sim.data, sim, path.folder = NULL, write.tidy = TRUE, write.obj = FALSE) {
      # x <- 1
      # sim <- sim.name
      sim <- stringi::stri_join(sim, "_iteration_", stringi::stri_pad_left(str = x, width = 2, pad = "0"))
      # if (write.obj) {
      #   assign(x = sim, value = data, pos = 1)
      # } else {
      # small hack to remove note in R CMD Check
      pos <- 1
      envir <- as.environment(pos)
      assign(x = sim, value = sim.data, envir = envir)
      # }
      if (write.tidy) {
        radiator::write_rad(data = eval(as.name(sim)), path = file.path(path.folder, stringi::stri_join(sim, ".rad")))
      }
      
    }#End extract_save
    
    purrr::walk2(
      .x = 1:length(sim.data),
      .y = sim.data,
      .f = extract_save,
      sim = sim.name,
      path.folder = path.folder, 
      write.tidy = write.tidy, 
      write.obj = FALSE)
    return(sim.data)
  }
  # serial test
  # res <- purrr::map(
  #   .x = list.gtypes,
  #   .f = load_sim_data,
  #   write.tidy = write.tidy, write.obj = write.obj
  #   ) %>% purrr::flatten(.)

  # parallel
  res <- grur::grur_future(
    .x = list.gtypes,
    .f = load_sim_data,
    flat.future = "drop",
    parallel.core = parallel.core,
    write.tidy = write.tidy
    ) %>% 
    purrr::flatten(.)
  
  return(res)
}#End tidy_sim