view redelacSticsTool.R @ 8:cbd23f8906db draft default tip

"planemo upload for repository https://forgemia.inra.fr/redelac commit 53d19ea66881dcd272711c98940626fa6bb58075"
author siwaa
date Thu, 24 Oct 2024 17:45:22 +0000
parents e0d592bb516e
children
line wrap: on
line source

library(SticsRFiles)
library(SticsOnR)
library(dplyr)
library(lubridate)
library(parallel)
library(doParallel)
library(doFuture)
library(stringr)
library(readxl)
library(data.table)
library(readr)
library(tidyr)

sessionInfo()

args = commandArgs(trailingOnly = TRUE)

startTime <- Sys.time()

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

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"

redelac <- (args[1] == "optim")
parallel <- (args[2] == "parallel")
print(paste("parallel:", parallel, args[2]))
nbSlots <- as.integer(args[3])
print(paste("nbslots:", nbSlots))
scenario <- args[4]

# 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 (parallel) {
  doFuture::registerDoFuture()
  future::plan(multisession, workers = nbSlots)
  `%dordopar%` <- `%dofuture%`
} else {
  `%dordopar%` <- `%do%`
}

beforeGenXmlTime <- Sys.time()

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

chunckSize <- 1000
nbUSMs <- nrow(usms_param)

ids <- seq(1, nbUSMs, chunckSize)

foreach (i = ids,
         .options.future = list(packages = c("foreach", "SticsRFiles"))) %dordopar% {
	   usmsXfolder =  file.path(workspace, paste0("UXF__", i))
	   dir.create(usmsXfolder)
           gen_usms_xml(file = file.path(usmsXfolder, paste0("usms__", i, ".xml")),
                        param_df = usms_param[i:min(i + chunckSize - 1, nbUSMs),])
         }

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

beforeGenTxtTime <- Sys.time()

foreach (i = ids,
         .options.future = list(packages = c("foreach", "SticsRFiles"))) %dordopar% {
           gen_usms_xml2txt(
             javastics = javastics_path,
             workspace = workspace,
             out_dir = txt_path,
             usms_file = paste0("UXF__", i, "/usms__", i, ".xml"),
             redelac = redelac,
             parallel = parallel,
             verbose = FALSE
           )
         }

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

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(paste("number of usms: ", nrow(usms_param)))
print(paste("redelac optimization:", redelac))
print(paste("process in parallel:", parallel))
print(paste("nbslots:", nbSlots))

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)
)
print(
  "==================================================================================="
)


#
# Simulation part
#

# List of successive USMs
successive_usms_file <- ("successionPlan.csv")
successive_usms_tab <-
  read.csv(file = file.path(workspace, successive_usms_file),
           sep = ";")

# from succesions to simulate retrieving upcSol Cases

successRef <- successive_usms_tab["Treatment"]

successRef <- successRef %>%
  separate(
    col = Treatment,
    into = c("upc", "sol", "systeme", "rotation", "tete_rotation", "horizon"),
    sep = "-",
    remove = FALSE
  )

successRef$upcSol <- paste0(successRef$upc, "-", successRef$sol)

casesUpcSol <- unique(successRef$upcSol)

systeme <- successRef$systeme[1]
rotation <- successRef$rotation[1]

successive_usms_tab_split <- list()

for (j in  1:length(casesUpcSol)) {
  splited <- strsplit(casesUpcSol[j], split = "-")[[1]]

  upc <- splited[1]

  sol <- splited[2]

  successive_usms_tab_split[[j]] <-
    successive_usms_tab[successRef$upcSol == casesUpcSol[j],]
}

result <- foreach(j = 1:length(casesUpcSol)) %:%
  foreach(
    i = 1:nrow(successive_usms_tab_split[[j]]),
    .options.future = list(packages =c("foreach", "SticsRFiles", "SticsOnR"))

  ) %dordopar% {

    nusms <- as.numeric(successive_usms_tab_split[[j]][i, 2])

    vec <-
      as.character(successive_usms_tab_split[[j]][i, c(3:(2 + nusms))])

    list_successive_usms <- list(vec)

    sim_options <- stics_wrapper_options(
      stics_exe = "stics_modulo",
      workspace = txt_path,
      verbose = TRUE,
      force = TRUE,
      successive = list_successive_usms
    )

    list_usms <- vec

    cat(paste0("--> succession : ", successive_usms_tab_split[[j]][i, 1], " launched\n"))

    return(stics_wrapper(model_options = sim_options, situation = list_usms))

  }

for (j in  1:length(casesUpcSol)) {
  splited <- strsplit(casesUpcSol[j], split = "-")[[1]]

  upc <- splited[1]

  sol <- splited[2]

  for (i in 1:nrow(successive_usms_tab_split[[j]])) {
    #i=1
    if (i == 1) {
      simPCP <- result[[j]][[i]]
    } else {
      simPCP$sim_list <- c(simPCP$sim_list, result[[j]][[i]]$sim_list)
    }

  }

  #agregation des sorties dans un dataframe
  sim_df <-
    rbindlist(simPCP$sim_list, use.names = TRUE, idcol = "usm")

  #ajout des colonnes explicatives + de l'horizon temporel
  sim_df <- sim_df %>%
    separate(
      col = usm,
      into = c(
        "upc",
        "sol",
        "systeme",
        "rotation",
        "tete_rotation",
        "horizon",
        "annee",
        "culture"
      ),
      sep = "-",
      remove = FALSE
    )

  #sauvegarde sous la forme d'un fichier rds

  if (dir.exists(paste0(
    workspace,
    "/analyse_simulations_STICS/",
    systeme,
    "/",
    rotation
  )) == FALSE) {
    dir.create(
      paste0(
        workspace,
        "/analyse_simulations_STICS/",
        systeme,
        "/",
        rotation
      ),
      recursive = TRUE
    )
  }

  saveRDS(
    sim_df,
    paste0(
      workspace,
      "/analyse_simulations_STICS/",
      systeme,
      "/",
      rotation,
      "/outputs-",
      rotation,
      "-",
      upc,
      "-",
      sol,
      "-",
      scenario,
      ".rds"
    )
  )

  successive_usms_tab_split[[j]]$Treatment <- NULL
  successive_usms_tab_split[[j]]$Number_USM <- NULL

  list_usms <-
    unlist(unname(as.list(
      transpose(successive_usms_tab_split[[j]])
    )))
  list_usms <- list_usms[!is.na(list_usms)]
  list_usms <- list_usms[list_usms != '']

  list_usms_yr1 <- successive_usms_tab_split[[j]]$USM_1

  for (i in 1:length(list_usms)) {
    if (i == 1) {
      #ajout d'une condition sur l'existence du fichier "mod_rapport.sti" pour la concatenation
      #en attendant que toutes les simulations tournent correctement
      #if(exists(file.path(txt_path, list_usms[i], "mod_rapport.sti"))==TRUE){
      rap_1 <-
        read_delim(file.path(txt_path, list_usms[i], "mod_rapport.sti"),
                   col_names = TRUE)
      names_col <- colnames(rap_1)

      rap_string <-
        read_lines(file = file.path(txt_path, list_usms[i], "mod_rapport.sti"),
                   skip = 1)

      rap <- as_tibble(rap_string) %>%
        separate(col = value,
                 sep = ";",
                 into = names_col) %>%
        mutate(USM = list_usms[i])
      # }

    } else {
      #if (list_usms[i] %in% list_usms_yr1) {
      #ajout d'une condition sur l'existence du fichier "mod_rapport.sti" pour la concatenation
      #en attendant que toutes les simulations tournent correctement
      #if(exists(file.path(txt_path, list_usms[i], "mod_rapport.sti"))==TRUE){
      rap_string <-
        read_lines(file = file.path(txt_path, list_usms[i], "mod_rapport.sti"),
                   skip = 1,)#}

      # } else {
      #ajout d'une condition sur l'existence du fichier "mod_rapport.sti" pour la concatenation
      #en attendant que toutes les simulations tournent correctement
      #if(exists(file.path(txt_path, list_usms[i], "mod_rapport.sti"))==TRUE){
      #   rap_string <-
      #     read_file(file = file.path(txt_path, list_usms[i], "mod_rapport.sti"))#}
      # }
      rap_i <- as_tibble(rap_string) %>%
        separate(col = value,
                 sep = ";",
                 into = names_col) %>%
        mutate(USM = list_usms[i])

      rap <- bind_rows(rap, rap_i)

    }

  }
  rm(rap_1, names_col, rap_string, rap_i)

  rap <- rap %>%
    select(USM, everything()) %>%
    mutate(P_usm = str_replace_all(P_usm, " ", "")) %>%
    mutate(wlieu = str_replace_all(wlieu, " ", "")) %>%
    mutate(stade = str_replace_all(stade, " ", "")) %>%
    mutate(nomversion = str_replace_all(P_usm, " ", "")) %>%
    mutate(across(4:10, as.numeric)) %>%
    mutate(across(14:ncol(rap), as.numeric)) %>%
    separate(
      col = USM,
      into = c(
        "upc",
        "sol",
        "systeme",
        "rotation",
        "tete_rotation",
        "horizon",
        "annee",
        "culture"
      ),
      sep = "-",
      remove = FALSE
    )

  write_delim(
    x = rap,
    file = paste0(
      workspace,
      "/analyse_simulations_STICS/",
      systeme,
      "/",
      rotation,
      "/report-",
      rotation,
      "-",
      upc,
      "-",
      sol,
      "-",
      scenario,
      ".csv"
    ),
    delim = ";"
  )

}