view redelacSticsInputGenerator.R @ 9:2a6d7d053ba7 draft

"planemo upload for repository https://forgemia.inra.fr/redelac commit adcac73e150f1f821b4b7f7673a490dc0fadc936"
author siwaa
date Mon, 25 Sep 2023 16:25:51 +0000
parents fb6f7d60508d
children f707c2fb725b
line wrap: on
line source

library(SticsRFiles)
library(dplyr)
library(lubridate)
library(parallel)
library(doParallel)

sessionInfo()

startTime <- Sys.time()

workspace <- paste0(getwd(), "/WS")
javastics_path <- getwd()

txt_path <- paste0(getwd(), "/WS/txt_files")
dir.create(txt_path, recursive = T)

USMsFile <- "USMs.csv"
TecFile <- "Tec.csv"
IniFile <- "Ini.csv"
StationFile <- "Station.csv"

args = commandArgs(trailingOnly = TRUE)

genUSMsXmlOneAfterOther <- (args[1] == "usmx_one_after_other")
parallel <- (args[2] == "parallel")
nbSlots <- as.integer(args[3])

# USMs file loading

usms_param <- read_params_table(file.path(workspace, USMsFile)) %>%
  select(
    usm_name,
    datedebut,
    datefin,
    finit,
    nomsol,
    fstation,
    fclim1,
    fclim2,
    culturean,
    nbplantes,
    codesimul,
    fplt_1,
    ftec_1,
    flai_1,
    fplt_2,
    ftec_2,
    flai_2
  )

# Tec files loading and generating xml

tec_param <- read_params_table(file.path(workspace, TecFile))
columnToRemove <-
  names(tec_param[grep("juleclair|nbinfloecl", names(tec_param))])
columnToKeep <-
  names(tec_param)[names(tec_param) %in% columnToRemove == FALSE]

tec_param <- subset(tec_param, select = columnToKeep)

gen_tec_xml(param_df = tec_param, out_dir = workspace)

# Ini files loading and generating xml

ini_param <- read_params_table(file.path(workspace, IniFile))

gen_ini_xml(param_df = ini_param, out_dir = workspace)

# Station files loading and generating xml

sta_param <- read_params_table(file.path(workspace, StationFile))

gen_sta_xml(param_df = sta_param, out_dir = workspace)

if (genUSMsXmlOneAfterOther) {

  durGenX <- lubridate::as.duration(0)
  durGenT <- lubridate::as.duration(0)

  if (parallel) {
    cl <- makeCluster(nbSlots)
    print(cl)
    registerDoParallel(cl)
    `%dordopar%` <- `%dopar%`
  } else {
    `%dordopar%` <- `%do%`
  }

  # looping on USMs
  loopRes <- foreach::foreach(i = 1:nrow(usms_param),
    .packages = c("SticsRFiles", "lubridate")) %dordopar% {

    beforeGenXmlTimeI <- Sys.time()

    usmxFileName = paste0("usms", as.character(i) , ".xml")

    usmxFilePath  = file.path(workspace, usmxFileName)

    gen_usms_xml(file = usmxFilePath,
                 param_df = usms_param[i, ])

    afterGenXmlTimeI <- Sys.time()
    durGenXI <-
      lubridate::as.duration(lubridate::interval(beforeGenXmlTimeI,
                                                 afterGenXmlTimeI))

    # one after the other generating txt folder

    beforeGenTxtTimeI <- Sys.time()

    gen_usms_xml2txt(
      usms_file = usmxFileName,
      javastics = javastics_path,
      workspace = workspace,
      out_dir = txt_path,
      verbose = TRUE
    )

    afterGenTxtTimeI <- Sys.time()
    durGenTI <-
      lubridate::as.duration(lubridate::interval(beforeGenTxtTimeI,
                                                 afterGenTxtTimeI))

    return(c(durGenXI, durGenTI))
  }

  if (parallel) stopCluster(cl)

  durDS <- as.data.frame(do.call(rbind, loopRes))
  durGenX <- sum(durDS[1])
  durGenT <- sum(durDS[2])

} else {

  beforeGenXmlTime <- Sys.time()

  gen_usms_xml(file = file.path(workspace, "usms.xml"),
               param_df = usms_param)

  afterGenXmlTime <- Sys.time()
  durGenX <-
    lubridate::as.duration(lubridate::interval(beforeGenXmlTime,
                                               afterGenXmlTime))

  beforeGenTxtTime <- Sys.time()

  gen_usms_xml2txt(
    javastics = javastics_path,
    workspace = workspace,
    out_dir = txt_path,
    verbose = TRUE
  )

  afterGenTxtTime <- Sys.time()
  durGenT <-
    lubridate::as.duration(lubridate::interval(beforeGenTxtTime,
                                               afterGenTxtTime))

}

endTime <- Sys.time()

dur <-
  lubridate::as.period(lubridate::as.duration(lubridate::interval(startTime, endTime)))
durGenXP <- lubridate::as.period(durGenX)
durGenTP <- lubridate::as.period(durGenT)

print("REDELACSticsInputGenerator Report")
print("=================================")
print(paste0("number of usms: ", nrow(usms_param)))
print(paste("usms.xml one after the other:", genUSMsXmlOneAfterOther))

sprintf(
  'overall duration: %g jour(s) %g heure(s) %g minute(s) %g seconde(s)',
  lubridate::day(dur),
  lubridate::hour(dur),
  lubridate::minute(dur),
  lubridate::second(dur))

sprintf(
  'inside gen_usms_xml duration: %g jour(s) %g heure(s) %g minute(s) %g seconde(s)',
  lubridate::day(durGenXP),
  lubridate::hour(durGenXP),
  lubridate::minute(durGenXP),
  lubridate::second(durGenXP))

sprintf(
  'inside gen_usms_xml2txt duration: %g jour(s) %g heure(s) %g minute(s) %g seconde(s)',
  lubridate::day(durGenTP),
  lubridate::hour(durGenTP),
  lubridate::minute(durGenTP),
  lubridate::second(durGenTP))