From bd93839c9007f9e301def16c5d5263667afa00fe Mon Sep 17 00:00:00 2001 From: mrustl Date: Fri, 18 Oct 2024 12:38:14 +0200 Subject: [PATCH] Fix "retardation" typo :bug: and prepar e first version of percental results for factsheet (with/without retardation) --- R/.scenarios_parallel.R | 162 ++++++++++++++++++++++++++++++++++------ 1 file changed, 141 insertions(+), 21 deletions(-) diff --git a/R/.scenarios_parallel.R b/R/.scenarios_parallel.R index e25f888..cfb0b84 100644 --- a/R/.scenarios_parallel.R +++ b/R/.scenarios_parallel.R @@ -435,9 +435,9 @@ inner_function <- function(config, atm_data, soil_columns, helper) config$extreme_rain } tracer <- config$treatment == "tracer" - retardation <- config$retardation == "retardation_yes" + no_retardation <- config$retardation == "retardation_no" - if (retardation) { + if (no_retardation) { soil_columns$retard <- 1 } @@ -651,12 +651,12 @@ if (FALSE) { dirs <- fs::dir_ls("C:/kwb/projects/flextreat/3_1_4_Prognosemodell/Vivian/Rohdaten/irrig_fixed", recurse = TRUE, - regexp = "retardation_no", + regexp = "retardation_yes", type = "directory") dirinfo <- fs::dir_info(path = dirs, type = "directory") - dirinfo <- dirinfo[dirinfo$change_time < as.POSIXct("2024-10-14"),] + dirinfo <- dirinfo[dirinfo$change_time < as.POSIXct("2024-10-17 14:30:00"),] mod_scens <- dirinfo$path %>% stringr::str_remove("C:/kwb/projects/flextreat/3_1_4_Prognosemodell/Vivian/Rohdaten/irrig_fixed/") %>% @@ -690,6 +690,27 @@ if (FALSE) { duration_string = "long", #c("short", "long"), retardation_scenario = "retardation_no") + arg_combis <- kwb.utils::expandGrid( + extreme_rain = c(""), # "" needs to be treated as NULL! + treatment = c("ka"), # "tracer" # c("ka", "o3") + scenario = unlist(lapply(1, function(x) { + paste0("soil-", 1, sprintf("m_irrig-%02ddays", x)) + })), + irrig_only_growing_season = c(FALSE), + duration_string = "long", #c("short", "long"), + retardation_scenario = "retardation_no") + + arg_combis <- kwb.utils::expandGrid( + extreme_rain = c("", "wet", "dry"), # "" needs to be treated as NULL! + treatment = c("ka", "o3"), # "tracer" # c("ka", "o3") + scenario = unlist(lapply(c(1,10), function(x) { + paste0("soil-", 1:3, sprintf("m_irrig-%02ddays", x)) + })), + irrig_only_growing_season = c(TRUE, FALSE), + duration_string = "long", #c("short", "long"), + retardation_scenario = "retardation_yes") + + configs <- lapply(seq_len(nrow(arg_combis)), function(i) { as.list(arg_combis[i, ]) }) @@ -857,7 +878,9 @@ if (FALSE) scenario_dirs <- fs::dir_ls( path = root_path, recurse = TRUE, - regexp = "irrig-period_growing-season/long/retardation_no/.*vs$", + #regexp = "retardation_no.*vs$", + regexp = "irrig-period_status-quo/long/retardation_no.*vs$", + #regexp = "irrig-period_status-quo/long/retardation_no/ablauf_ka_median_soil-1m_irrig-01days_soil-column_0105.*vs$", type = "directory" ) @@ -914,15 +937,24 @@ if (FALSE) future::plan(future::sequential) }) + retardation_short <- "retardation_yes" + + soil_columns_plot <- if(retardation_short == "retardation_yes") { + soil_columns_selected + } else { + soil_columns_selected %>% + dplyr::mutate(retard = 1) + } + scenario_dirs <- fs::dir_ls( path = root_path, recurse = TRUE, #regexp = "irrig-period_growing-season/long/retardation_no/.*vs/hydrus_scenarios.xlsx$", - regexp = "retardation_no.*vs/hydrus_scenarios.xlsx$", + regexp = sprintf("%s.*vs/hydrus_scenarios.xlsx$", retardation_short), type = "file" ) - fs::file_info(scenario_dirs) %>% View() + #fs::file_info(scenario_dirs) %>% View() res_stats <- lapply( @@ -933,7 +965,8 @@ if (FALSE) ) # load_default <- res_stats$`D:/hydrus1d/irrig_fixed_01/irrig-period_status-quo/long/retardation_no/ablauf_ka_median_soil-2m_irrig-10days_soil-column_0105_vs/hydrus_scenarios.xlsx` - load_default <- res_stats$`C:/kwb/projects/flextreat/3_1_4_Prognosemodell/Vivian/Rohdaten/irrig_fixed/irrig-period_status-quo/long/retardation_no/ablauf_ka_median_soil-2m_irrig-10days_soil-column_0105_vs/hydrus_scenarios.xlsx` %>% + load_default <- res_stats[[sprintf("C:/kwb/projects/flextreat/3_1_4_Prognosemodell/Vivian/Rohdaten/irrig_fixed/irrig-period_status-quo/long/%s/ablauf_ka_median_soil-2m_irrig-10days_soil-column_0105_vs/hydrus_scenarios.xlsx", + retardation_short)]] %>% # dplyr::mutate(retardation = basename(dirname(dirname(path))), # duration = basename(dirname(dirname(dirname(path)))), # irrigation_period = basename(dirname(dirname(dirname(dirname((path))))))) %>% @@ -960,36 +993,123 @@ if (FALSE) tidyr::separate(col = soil_depth_irrig, into = c("soil_depth", "irrigation_intervall"), sep = "_", remove = FALSE) %>% dplyr::mutate(duration_irrigperiod = paste0(duration, "_", irrigation_period)) + de <- TRUE + + + if(de) { + res_stats_df$duration_irrigperiod <- res_stats_df$duration_irrigperiod %>% + stringr::str_replace("long_wet", "DWD, trocken (2013: 380 mm/a)") %>% + stringr::str_replace("long_dry", "DWD, nass (2023: 835 mm/a)") %>% + stringr::str_replace("long", "DWD (2017-2023: 611 mm/a)") %>% + stringr::str_replace("_irrig-period_status-quo", ", Bewässerung: ganzjährig") %>% + stringr::str_replace("_irrig-period_growing-season", ", Bewässerung: nur Vegetationsperiode (Apr-Sep)") - View(res_stats_df) + res_stats_df$soil_depth_irrig <- res_stats_df$soil_depth_irrig %>% + stringr::str_replace("soil-", "Boden ") %>% + stringr::str_replace("_irrig-10days", ", Bewässerung: zehntägig") %>% + stringr::str_replace("_irrig-01days", ", Bewässerung: täglich") + lang_id <- "de" + lab_x <- "Bodenm\u00E4chtigkeit und Bew\u00E4sserungsintervall" + lab_y <- "Prozentuale Fracht ins Grundwasser i.V. zu Status Quo (%)" + title <- "Stoff: %s (Halbwertszeit: %3.1f Tage, Retardation: %2.1f)" + legend_col <- "Klima- und Bew\u00E4sserungsszenario " + legend_shape <- "Aufbereitung" + treatment_wwtp <- "Kl\u00E4ranlagenablauf (Median: " + treatment_o3 <- "Ozonanlagenablauf (Median: " + treatment_unit <- "ng/l" - duration_irrigperiods <- unique(res_stats_df$duration_irrigperiod) - duration_irrigper <- duration_irrigperiods[1] + } else { + lang_id <- "en" + lab_x <- "Scenario" + lab_y <- "Percental Load to Groundwater compared to Status Quo (%)" + title <- "Substance: %s (half life time: %3.1f days, retardation: %2.1f)" + legend_col <- "Scenario" + legend_shape <- "Treatment" + treatment_wwtp <- "WWTP effluent (median: " + treatment_o3 <- "Ozone effluent (median: " + treatment_unit <- "ng/l" + } + + #View(res_stats_df) + + + substances <- unique(res_stats_df$substanz_name)[order(unique(res_stats_df$substanz_name))] + - pdff <- "percental-load-to-groundwater_per-scenario.pdf" - kwb.utils::preparePdf(pdff) + pdff <- sprintf("percental-load-to-groundwater_per-substance_%s_%s.pdf", + stringr::str_replace(retardation_short, "_", "-"), + lang_id) + kwb.utils::preparePdf(pdff, borderHeight.cm = 0, borderWidth.cm = 0, width.cm = 32.67, height.cm = 23.1) - sapply(duration_irrigperiods, function(duration_irrigper) { + sapply(substances, function(substance) { + + substance_meta <- soil_columns_plot[soil_columns_plot$substanz_name == substance,] res_stats_df_sel <- res_stats_df %>% - dplyr::filter(duration_irrigperiod == duration_irrigper) + dplyr::filter(substanz_name == substance) + + res_stats_df_sel$treatment_conc <- "" + + res_stats_df_sel$treatment_conc[which(res_stats_df_sel$treatment == "ablauf_ka_median")] <- sprintf("%s %5d %s)", treatment_wwtp, round(substance_meta$ablauf_ka_median, 0), treatment_unit) + res_stats_df_sel$treatment_conc[which(res_stats_df_sel$treatment == "ablauf_o3_median")] <- sprintf("%s %5d %s)", treatment_o3, round(substance_meta$ablauf_o3_median, 0), treatment_unit) gg <- res_stats_df_sel %>% - ggplot2::ggplot(mapping = ggplot2::aes(x = soil_depth_irrig, + ggplot2::ggplot(mapping = ggplot2::aes(x = soil_depth_irrig, y = percental_load_gw, - col = substanz_name, - shape = treatment + col = duration_irrigperiod, + shape = treatment_conc #col = treatment )) + - ggplot2::geom_point(size = 3) + - ggplot2::labs(y = "Percental Load to Groundwater compared to Status Quo (%)", x = "Scenario", + #ggplot2::geom_point(size = 3) + + ggplot2::geom_jitter(width = 0.15, size = 3, alpha = 0.5) + + #ggplot2::scale_y_log10(limits = c(1,1000)) + + ggplot2::ylim(c(0,200)) + + ggplot2::labs(y = lab_y, x = lab_x, + title = sprintf(title, + substance_meta$substanz_name, + substance_meta$half_life_days, + substance_meta$retard), + col = legend_col, + shape = legend_shape) + + ggplot2::theme_bw() + + ggplot2::theme(legend.position = "bottom", + legend.direction = "vertical", + legend.margin= ggplot2::margin(), + axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5, hjust=1)#, + #axis.title.y = ggplot2::element_text(vjust = -10, margin = ggplot2::margin(t = 0, r = 0, b = 100, l = 0)) + ) + print(gg) +}) + +kwb.utils::finishAndShowPdf(pdff) + + +pdff <- sprintf("percental-load-to-groundwater_per-scenario_%s.pdf", + sprintf(retardation_short, "_", "-")) + +kwb.utils::preparePdf(pdff) + +sapply(duration_irrigperiods, function(duration_irrigper) { + + res_stats_df_sel <- res_stats_df %>% + dplyr::filter(duration_irrigperiod == duration_irrigper) + + gg <- res_stats_df_sel %>% + ggplot2::ggplot(mapping = ggplot2::aes(x = soil_depth_irrig, + y = percental_load_gw, + col = substanz_name, + shape = treatment + #col = treatment + )) + + ggplot2::geom_point(size = 3) + + ggplot2::labs(y = "Percental Load to Groundwater compared to Status Quo (%)", x = "Scenario", title = sprintf("Scenario: %s %s (%s)", res_stats_df_sel$irrigation_period[1], res_stats_df_sel$duration[1], res_stats_df_sel$retardation[1]), col = "Substance Name") + - ggplot2::scale_y_log10() + + #ggplot2::scale_y_log10(limits = c(0,200)) + ggplot2::ylim(c(0,200)) + ggplot2::theme_bw() + ggplot2::theme(legend.position = "top",