Mercurial > repos > siwaa > redelac_stics_t
comparison redelacSticsTool.R @ 0:7f8f474a7bd7 draft
"planemo upload for repository https://forgemia.inra.fr/redelac commit 29a2aee3b41d8da4d056600ea5cf4af978c714b9"
author | siwaa |
---|---|
date | Tue, 06 Feb 2024 09:21:00 +0000 |
parents | |
children | ed9c49c6c6e1 |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:7f8f474a7bd7 |
---|---|
1 library(SticsRFiles) | |
2 library(SticsOnR) | |
3 library(dplyr) | |
4 library(lubridate) | |
5 library(parallel) | |
6 library(doParallel) | |
7 library(doFuture) | |
8 library(stringr) | |
9 library(readxl) | |
10 library(data.table) | |
11 library(readr) | |
12 library(tidyr) | |
13 | |
14 sessionInfo() | |
15 | |
16 args = commandArgs(trailingOnly = TRUE) | |
17 | |
18 startTime <- Sys.time() | |
19 | |
20 workspace <- paste0(getwd(), "/WS") | |
21 javastics_path <- getwd() | |
22 default_config_path <- paste0(javastics_path, "/config") | |
23 | |
24 txt_path <- paste0(getwd(), "/WS/txt_files") | |
25 dir.create(txt_path, recursive = T) | |
26 | |
27 USMsFile <- "USMs.csv" | |
28 TecFile <- "Tec.csv" | |
29 IniFile <- "Ini.csv" | |
30 StationFile <- "Station.csv" | |
31 | |
32 redelac <- (args[1] == "optim") | |
33 parallel <- (args[2] == "parallel") | |
34 print(paste("parallel:", parallel, args[2])) | |
35 nbSlots <- as.integer(args[3]) | |
36 print(paste("nbslots:", nbSlots)) | |
37 scenario <- args[4] | |
38 | |
39 # USMs file loading | |
40 | |
41 usms_param <- read_params_table(file.path(workspace, USMsFile)) %>% | |
42 select( | |
43 usm_name, | |
44 datedebut, | |
45 datefin, | |
46 finit, | |
47 nomsol, | |
48 fstation, | |
49 fclim1, | |
50 fclim2, | |
51 culturean, | |
52 nbplantes, | |
53 codesimul, | |
54 fplt_1, | |
55 ftec_1, | |
56 flai_1, | |
57 fplt_2, | |
58 ftec_2, | |
59 flai_2 | |
60 ) | |
61 | |
62 # Tec files loading and generating xml | |
63 | |
64 tec_param <- read_params_table(file.path(workspace, TecFile)) | |
65 columnToRemove <- | |
66 names(tec_param[grep("juleclair|nbinfloecl", names(tec_param))]) | |
67 columnToKeep <- | |
68 names(tec_param)[names(tec_param) %in% columnToRemove == FALSE] | |
69 | |
70 tec_param <- subset(tec_param, select = columnToKeep) | |
71 | |
72 gen_tec_xml(param_df = tec_param, out_dir = workspace) | |
73 | |
74 # Ini files loading and generating xml | |
75 | |
76 ini_param <- read_params_table(file.path(workspace, IniFile)) | |
77 | |
78 gen_ini_xml(param_df = ini_param, out_dir = workspace) | |
79 | |
80 # Station files loading and generating xml | |
81 | |
82 sta_param <- read_params_table(file.path(workspace, StationFile)) | |
83 | |
84 gen_sta_xml(param_df = sta_param, out_dir = workspace) | |
85 | |
86 if (parallel) { | |
87 doFuture::registerDoFuture() | |
88 future::plan(multisession, workers = nbSlots) | |
89 `%dordopar%` <- `%dofuture%` | |
90 } else { | |
91 `%dordopar%` <- `%do%` | |
92 } | |
93 | |
94 beforeGenXmlTime <- Sys.time() | |
95 | |
96 #gen_usms_xml(file = file.path(workspace, "usms.xml"), | |
97 # param_df = usms_param) | |
98 | |
99 chunckSize <- 1000 | |
100 nbUSMs <- nrow(usms_param) | |
101 | |
102 ids <- seq(1, nbUSMs, chunckSize) | |
103 | |
104 foreach (i = ids, | |
105 .options.future = list(packages = c("foreach", "SticsRFiles"))) %dordopar% { | |
106 gen_usms_xml(file = file.path(workspace, paste0("usms__", i, ".xml")), | |
107 param_df = usms_param[i:min(i + chunckSize - 1, nbUSMs),]) | |
108 } | |
109 | |
110 afterGenXmlTime <- Sys.time() | |
111 durGenX <- | |
112 lubridate::as.duration(lubridate::interval(beforeGenXmlTime, | |
113 afterGenXmlTime)) | |
114 | |
115 beforeGenTxtTime <- Sys.time() | |
116 | |
117 foreach (i = ids, | |
118 .options.future = list(packages = c("foreach", "SticsRFiles"))) %dordopar% { | |
119 gen_usms_xml2txt( | |
120 javastics = javastics_path, | |
121 workspace = workspace, | |
122 out_dir = txt_path, | |
123 usms_file = paste0("usms__", i, ".xml"), | |
124 redelac = redelac, | |
125 parallel = parallel, | |
126 verbose = FALSE | |
127 ) | |
128 } | |
129 | |
130 afterGenTxtTime <- Sys.time() | |
131 durGenT <- | |
132 lubridate::as.duration(lubridate::interval(beforeGenTxtTime, afterGenTxtTime)) | |
133 | |
134 afterGenTxtTime <- Sys.time() | |
135 durGenT <- | |
136 lubridate::as.duration(lubridate::interval(beforeGenTxtTime, afterGenTxtTime)) | |
137 | |
138 endTime <- Sys.time() | |
139 | |
140 dur <- | |
141 lubridate::as.period(lubridate::as.duration(lubridate::interval(startTime, endTime))) | |
142 durGenXP <- lubridate::as.period(durGenX) | |
143 durGenTP <- lubridate::as.period(durGenT) | |
144 | |
145 print("REDELACSticsInputGenerator Report") | |
146 print("=================================") | |
147 print(paste("number of usms: ", nrow(usms_param))) | |
148 print(paste("redelac optimization:", redelac)) | |
149 print(paste("process in parallel:", parallel)) | |
150 print(paste("nbslots:", nbSlots)) | |
151 | |
152 sprintf( | |
153 'overall duration: %g jour(s) %g heure(s) %g minute(s) %g seconde(s)', | |
154 lubridate::day(dur), | |
155 lubridate::hour(dur), | |
156 lubridate::minute(dur), | |
157 lubridate::second(dur) | |
158 ) | |
159 | |
160 sprintf( | |
161 'inside gen_usms_xml duration: %g jour(s) %g heure(s) %g minute(s) %g seconde(s)', | |
162 lubridate::day(durGenXP), | |
163 lubridate::hour(durGenXP), | |
164 lubridate::minute(durGenXP), | |
165 lubridate::second(durGenXP) | |
166 ) | |
167 | |
168 sprintf( | |
169 'inside gen_usms_xml2txt duration: %g jour(s) %g heure(s) %g minute(s) %g seconde(s)', | |
170 lubridate::day(durGenTP), | |
171 lubridate::hour(durGenTP), | |
172 lubridate::minute(durGenTP), | |
173 lubridate::second(durGenTP) | |
174 ) | |
175 print( | |
176 "===================================================================================" | |
177 ) | |
178 | |
179 | |
180 # | |
181 # Simulation part | |
182 # | |
183 | |
184 # List of successive USMs | |
185 successive_usms_file <- ("successionPlan.csv") | |
186 successive_usms_tab <- | |
187 read.csv(file = file.path(workspace, successive_usms_file), | |
188 sep = ";") | |
189 | |
190 # from succesions to simulate retrieving upcSol Cases | |
191 | |
192 successRef <- successive_usms_tab["Treatment"] | |
193 | |
194 successRef <- successRef %>% | |
195 separate( | |
196 col = Treatment, | |
197 into = c("upc", "sol", "systeme", "rotation", "tete_rotation", "horizon"), | |
198 sep = "-", | |
199 remove = FALSE | |
200 ) | |
201 | |
202 successRef$upcSol <- paste0(successRef$upc, "-", successRef$sol) | |
203 | |
204 casesUpcSol <- unique(successRef$upcSol) | |
205 | |
206 systeme <- successRef$systeme[1] | |
207 rotation <- successRef$rotation[1] | |
208 | |
209 successive_usms_tab_split <- list() | |
210 | |
211 for (j in 1:length(casesUpcSol)) { | |
212 splited <- strsplit(casesUpcSol[j], split = "-")[[1]] | |
213 | |
214 upc <- splited[1] | |
215 | |
216 sol <- splited[2] | |
217 | |
218 successive_usms_tab_split[[j]] <- | |
219 successive_usms_tab[successRef$upcSol == casesUpcSol[j],] | |
220 } | |
221 | |
222 result <- foreach(j = 1:length(casesUpcSol)) %:% | |
223 foreach( | |
224 i = 1:nrow(successive_usms_tab_split[[j]]), | |
225 .options.future = list(packages =c("foreach", "SticsRFiles", "SticsOnR")) | |
226 | |
227 ) %dordopar% { | |
228 | |
229 nusms <- as.numeric(successive_usms_tab_split[[j]][i, 2]) | |
230 | |
231 vec <- | |
232 as.character(successive_usms_tab_split[[j]][i, c(3:(2 + nusms))]) | |
233 | |
234 list_successive_usms <- list(vec) | |
235 | |
236 sim_options <- stics_wrapper_options( | |
237 javastics = javastics_path, | |
238 stics_exe = paste0(javastics_path, "/bin/stics_modulo"), | |
239 workspace = txt_path, | |
240 verbose = TRUE, | |
241 successive = list_successive_usms | |
242 ) | |
243 | |
244 list_usms <- vec | |
245 | |
246 cat(paste0("--> succession : ", successive_usms_tab_split[[j]][i, 1], " launched\n")) | |
247 | |
248 return(stics_wrapper(model_options = sim_options, situation = list_usms)) | |
249 | |
250 } | |
251 | |
252 for (j in 1:length(casesUpcSol)) { | |
253 splited <- strsplit(casesUpcSol[j], split = "-")[[1]] | |
254 | |
255 upc <- splited[1] | |
256 | |
257 sol <- splited[2] | |
258 | |
259 for (i in 1:nrow(successive_usms_tab_split[[j]])) { | |
260 #i=1 | |
261 if (i == 1) { | |
262 simPCP <- result[[j]][[i]] | |
263 } else { | |
264 simPCP$sim_list <- c(simPCP$sim_list, result[[j]][[i]]$sim_list) | |
265 } | |
266 | |
267 } | |
268 | |
269 #agregation des sorties dans un dataframe | |
270 sim_df <- | |
271 rbindlist(simPCP$sim_list, use.names = TRUE, idcol = "usm") | |
272 | |
273 #ajout des colonnes explicatives + de l'horizon temporel | |
274 sim_df <- sim_df %>% | |
275 separate( | |
276 col = usm, | |
277 into = c( | |
278 "upc", | |
279 "sol", | |
280 "systeme", | |
281 "rotation", | |
282 "tete_rotation", | |
283 "horizon", | |
284 "annee", | |
285 "culture" | |
286 ), | |
287 sep = "-", | |
288 remove = FALSE | |
289 ) | |
290 | |
291 #sauvegarde sous la forme d'un fichier rds | |
292 | |
293 if (dir.exists(paste0( | |
294 workspace, | |
295 "/analyse_simulations_STICS/", | |
296 systeme, | |
297 "/", | |
298 rotation | |
299 )) == FALSE) { | |
300 dir.create( | |
301 paste0( | |
302 workspace, | |
303 "/analyse_simulations_STICS/", | |
304 systeme, | |
305 "/", | |
306 rotation | |
307 ), | |
308 recursive = TRUE | |
309 ) | |
310 } | |
311 | |
312 saveRDS( | |
313 sim_df, | |
314 paste0( | |
315 workspace, | |
316 "/analyse_simulations_STICS/", | |
317 systeme, | |
318 "/", | |
319 rotation, | |
320 "/outputs-", | |
321 rotation, | |
322 "-", | |
323 upc, | |
324 "-", | |
325 sol, | |
326 "-", | |
327 scenario, | |
328 ".rds" | |
329 ) | |
330 ) | |
331 | |
332 successive_usms_tab_split[[j]]$Treatment <- NULL | |
333 successive_usms_tab_split[[j]]$Number_USM <- NULL | |
334 | |
335 list_usms <- | |
336 unlist(unname(as.list( | |
337 transpose(successive_usms_tab_split[[j]]) | |
338 ))) | |
339 list_usms <- list_usms[!is.na(list_usms)] | |
340 list_usms <- list_usms[list_usms != ''] | |
341 | |
342 list_usms_yr1 <- successive_usms_tab_split[[j]]$USM_1 | |
343 | |
344 for (i in 1:length(list_usms)) { | |
345 if (i == 1) { | |
346 #ajout d'une condition sur l'existence du fichier "mod_rapport.sti" pour la concatenation | |
347 #en attendant que toutes les simulations tournent correctement | |
348 #if(exists(file.path(txt_path, list_usms[i], "mod_rapport.sti"))==TRUE){ | |
349 rap_1 <- | |
350 read_delim(file.path(txt_path, list_usms[i], "mod_rapport.sti"), | |
351 col_names = TRUE) | |
352 names_col <- colnames(rap_1) | |
353 | |
354 rap_string <- | |
355 read_lines(file = file.path(txt_path, list_usms[i], "mod_rapport.sti"), | |
356 skip = 1) | |
357 | |
358 rap <- as_tibble(rap_string) %>% | |
359 separate(col = value, | |
360 sep = ";", | |
361 into = names_col) %>% | |
362 mutate(USM = list_usms[i]) | |
363 # } | |
364 | |
365 } else { | |
366 #if (list_usms[i] %in% list_usms_yr1) { | |
367 #ajout d'une condition sur l'existence du fichier "mod_rapport.sti" pour la concatenation | |
368 #en attendant que toutes les simulations tournent correctement | |
369 #if(exists(file.path(txt_path, list_usms[i], "mod_rapport.sti"))==TRUE){ | |
370 rap_string <- | |
371 read_lines(file = file.path(txt_path, list_usms[i], "mod_rapport.sti"), | |
372 skip = 1,)#} | |
373 | |
374 # } else { | |
375 #ajout d'une condition sur l'existence du fichier "mod_rapport.sti" pour la concatenation | |
376 #en attendant que toutes les simulations tournent correctement | |
377 #if(exists(file.path(txt_path, list_usms[i], "mod_rapport.sti"))==TRUE){ | |
378 # rap_string <- | |
379 # read_file(file = file.path(txt_path, list_usms[i], "mod_rapport.sti"))#} | |
380 # } | |
381 rap_i <- as_tibble(rap_string) %>% | |
382 separate(col = value, | |
383 sep = ";", | |
384 into = names_col) %>% | |
385 mutate(USM = list_usms[i]) | |
386 | |
387 rap <- bind_rows(rap, rap_i) | |
388 | |
389 } | |
390 | |
391 } | |
392 rm(rap_1, names_col, rap_string, rap_i) | |
393 | |
394 rap <- rap %>% | |
395 select(USM, everything()) %>% | |
396 mutate(P_usm = str_replace_all(P_usm, " ", "")) %>% | |
397 mutate(wlieu = str_replace_all(wlieu, " ", "")) %>% | |
398 mutate(stade = str_replace_all(stade, " ", "")) %>% | |
399 mutate(nomversion = str_replace_all(nomversion, " ", "")) %>% | |
400 mutate(across(3:9, as.numeric)) %>% | |
401 mutate(across(13:ncol(rap), as.numeric)) %>% | |
402 #separate(col=P_usm,into=c("upc","sol","systeme","rotation","tete_rotation","horizon","annee","culture"),sep="-",remove = FALSE) | |
403 separate( | |
404 col = USM, | |
405 into = c( | |
406 "upc", | |
407 "sol", | |
408 "systeme", | |
409 "rotation", | |
410 "tete_rotation", | |
411 "horizon", | |
412 "annee", | |
413 "culture" | |
414 ), | |
415 sep = "-", | |
416 remove = FALSE | |
417 ) | |
418 | |
419 write_delim( | |
420 x = rap, | |
421 file = paste0( | |
422 workspace, | |
423 "/analyse_simulations_STICS/", | |
424 systeme, | |
425 "/", | |
426 rotation, | |
427 "/report-", | |
428 rotation, | |
429 "-", | |
430 upc, | |
431 "-", | |
432 sol, | |
433 "-", | |
434 scenario, | |
435 ".csv" | |
436 ), | |
437 delim = ";" | |
438 ) | |
439 | |
440 } |