diff --git a/DESCRIPTION b/DESCRIPTION index 9b097567..5604f32e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,11 +1,13 @@ Package: kwb.geosalz Title: R Package for Documenting Workflow Used in Project "geosalz" -Version: 0.6.0 +Version: 0.7.0 Authors@R: c( person("Michael", "Rustler", , "michael.rustler@kompetenz-wasser.de", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-0647-7726")), person("Hauke", "Sonnenberg", , "hauke.sonnenberg@kompetenz-wasser.de", role = "ctb", comment = c(ORCID = "0000-0001-9134-2871")), + person("Christoph", "Sprenger", , "christoph.sprenger@kompetenz-wasser.de", role = "ctb", + comment = c(ORCID = "0000-0002-0178-6645")), person("GeoSalz", role = "fnd"), person("Kompetenzzentrum Wasser Berlin gGmbH (KWB)", role = "cph") ) @@ -17,6 +19,7 @@ Depends: R (>= 2.10) Imports: archive, + cowplot, cellranger (>= 1.1.0), crayon (>= 1.3.4), data.table (>= 1.12.0), @@ -36,6 +39,7 @@ Imports: readODS, readr(>= 1.4.0), readxl (>= 1.2.0), + RColorBrewer, rlang (>= 0.3.1), rmarkdown (>= 1.11), sf, @@ -44,7 +48,8 @@ Imports: tibble (>= 2.0.1), tidyr (>= 0.8.2), tidyselect (>= 1.1.2), - withr + withr, + zoo Suggests: covr (>= 3.2.1), DT, @@ -71,4 +76,4 @@ Remotes: ByteCompile: true Encoding: UTF-8 LazyData: true -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 diff --git a/NAMESPACE b/NAMESPACE index 9456e1b6..dc0f4389 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,6 +28,7 @@ export(get_phreeqc_data) export(get_site_id) export(import_labor) export(order_measurement_chain_data) +export(plot_measurementchain_and_well_operation) export(plot_measurementchains) export(prepare_phreeqc_input) export(read_bwb_data) @@ -45,6 +46,7 @@ export(stop_if_duplicated_samples_found) export(write_measurementchains_data) import(crayon) import(dplyr) +importFrom(RColorBrewer,brewer.pal) importFrom(archive,archive_write_files) importFrom(cellranger,cell_limits) importFrom(cellranger,cell_rows) @@ -68,6 +70,7 @@ importFrom(dplyr,relocate) importFrom(dplyr,rename) importFrom(dplyr,select) importFrom(dplyr,summarise) +importFrom(dplyr,summarize) importFrom(forcats,fct_reorder) importFrom(fs,dir_create) importFrom(fs,file_copy) @@ -76,11 +79,17 @@ importFrom(fs,path_abs) importFrom(geosalz.phreeqc,prepare_solutions_input) importFrom(geosalz.phreeqc,tidy_samples) importFrom(ggplot2,aes) +importFrom(ggplot2,element_blank) +importFrom(ggplot2,geom_bar) importFrom(ggplot2,geom_line) importFrom(ggplot2,geom_point) importFrom(ggplot2,ggplot) +importFrom(ggplot2,guide_legend) +importFrom(ggplot2,guides) importFrom(ggplot2,labs) importFrom(ggplot2,scale_color_discrete) +importFrom(ggplot2,scale_color_manual) +importFrom(ggplot2,scale_x_date) importFrom(ggplot2,theme) importFrom(ggplot2,theme_bw) importFrom(janitor,clean_names) @@ -151,3 +160,4 @@ importFrom(utils,str) importFrom(utils,unzip) importFrom(utils,write.csv) importFrom(withr,with_dir) +importFrom(zoo,rollmean) diff --git a/NEWS.md b/NEWS.md index 834128c2..44f486de 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,13 @@ +# [kwb.geosalz 0.7.0](https://github.com/KWB-R/kwb.geosalz/releases/tag/v0.7.0) 2024-03-13 + +* Add combined plot for wells with measurement chains (i.e. 9,10,13) showing +EC (top plot and daily abstraction rates of this well (middle plot) and total +daily wellfield production rate (bottom plot). These plots were automatically +created with the article [Measurement Chains](../articles/measurement-chains.html) +and uploaded to the same cloud folder where already the measurement chains data +and pdf files are located. For this the latest well operation export needs to be +uploaded to the KWB cloud folder `../messketten/BWB_Brunnen_Prozessdaten`. + # [kwb.geosalz 0.6.0](https://github.com/KWB-R/kwb.geosalz/releases/tag/v0.6.0) 2023-04-14 * Fix GitHub Actions failure: diff --git a/R/plot_measurementchain_and_welloperation.R b/R/plot_measurementchain_and_welloperation.R new file mode 100644 index 00000000..65be78e3 --- /dev/null +++ b/R/plot_measurementchain_and_welloperation.R @@ -0,0 +1,113 @@ +#' Plot measurementchain and well operation in combined plot +#' +#' @param mc_dat mc_dat +#' @param well_op_data_meta well_op_data_meta +#' @param brunnen_nr well id (default: 9) +#' @param para parameter (either: "Leitfaehigkeit" or "Temperatur") +#' @param y_label y label (default: "elektr. Leitfaehigkeit (µS/cm)") +#' @param date_min minimum date for plotting (default: as.Date("2023-05-10")) +#' @param date_max maximum date for plotting (default: Sys.Date()) +#' @return combined plot +#' @export +#' @importFrom dplyr filter group_by summarize n +#' @importFrom RColorBrewer brewer.pal +#' @importFrom ggplot2 ggplot aes geom_line scale_color_manual labs theme_bw +#' theme guides guide_legend element_blank geom_bar scale_x_date +#' @importFrom zoo rollmean +plot_measurementchain_and_well_operation <- function(mc_dat, + well_op_data_meta, + brunnen_nr = 9, + para = "Leitfaehigkeit", + y_label = "elektr. Leitf\u00E4higkeit (\u00B5S/cm)", + date_min = as.Date("2023-05-10"), + date_max = Sys.Date()) { + + well_ids <- c(9,10,13) + + if (! brunnen_nr %in% well_ids) { + stop("'brunnen_nr' has to be one of: ", paste(well_ids, collapse = ", ")) + } + +# plot time series Brunnen 9 +selection <- mc_dat %>% + dplyr::filter(.data[["parameter"]] == para, + .data[["brunnen_nummer"]] == brunnen_nr) + + +n_sensors <- length(unique(selection$einbau_sensor_muGOK)) + +custom_palette <- RColorBrewer::brewer.pal(n_sensors, + "Dark2") + +p_well <- ggplot2::ggplot(selection, + ggplot2::aes(x = datum_uhrzeit, + y = messwert, + group = einbau_sensor_muGOK, + color = as.factor(einbau_sensor_muGOK))) + + ggplot2::geom_line() + + ggplot2::scale_color_manual(values = custom_palette) + + ggplot2::labs(x="", y = y_label, color = "Sensor [muGOK]") + + ggplot2::theme_bw() + + ggplot2::xlim(as.POSIXct(date_min), as.POSIXct(date_max)) + + #ggplot2::ylim(500,3000) + + ggplot2::theme(legend.position = "top", + axis.text.x = ggplot2::element_blank()) + + ggplot2::guides(color = ggplot2::guide_legend(ncol = n_sensors)) + +#p_well + +dat_well <- well_op_data_meta %>% dplyr::filter(.data$brunnen_nummer == brunnen_nr) + +sum_well <- dat_well %>% + dplyr::group_by(.data$bwb_datum) %>% + dplyr::summarise(n = dplyr::n(), + total_q = sum(.data$menge_summe_m3, na.rm = TRUE) ) + +sum_well$ma7 <- zoo::rollmean(sum_well$total_q, k = 7, fill = NA, align = "right") +sum_well$ma10 <- zoo::rollmean(sum_well$total_q, k = 10, fill = NA, align = "right") + +plot_q_well <- ggplot2::ggplot(sum_well, ggplot2::aes(x = as.Date(bwb_datum), y = total_q)) + + ggplot2::geom_bar(stat = "identity", width=1, color = "blue") + + ggplot2::labs(x="", y = sprintf("Q, Brunnen %2d (m3/d)", brunnen_nr)) + + ggplot2::theme_bw() + + ggplot2::theme(axis.text.x = ggplot2::element_blank()) + + ggplot2::xlim(date_min, date_max) + # ggplot2::scale_x_date(date_breaks = "1 month", date_labels = "%b %Y") + + # ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 0, + # vjust = 0.5, + # hjust = 1)) #+ + + +sum_wellfield <- well_op_data_meta %>% + dplyr::group_by(.data$bwb_datum) %>% + dplyr::summarise(n = dplyr::n(), + total_q = sum(.data$menge_summe_m3, na.rm = TRUE) ) + +sum_wellfield$ma7 <- zoo::rollmean(sum_well$total_q, k = 7, fill = NA, align = "right") +sum_wellfield$ma10 <- zoo::rollmean(sum_well$total_q, k = 10, fill = NA, align = "right") + +plot_q_wellfield <- ggplot2::ggplot(sum_wellfield, ggplot2::aes(x = as.Date(bwb_datum), y = total_q)) + + ggplot2::geom_bar(stat = "identity", width=1, color = "blue") + + ggplot2::labs(x="Zeit", y = "Q, Brunnenfeld K-Galerie (m3/d)") + + ggplot2::theme_bw() + + ggplot2::xlim(date_min, date_max) + + ggplot2::scale_x_date(date_breaks = "1 month", date_labels = "%b %Y") + + ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 0, + vjust = 0.5, + hjust = 1)) + + +combined_plot <- cowplot::plot_grid(p_well, + plot_q_well, + plot_q_wellfield, + ncol = 1, align = 'v') + +combined_plot_with_title <- cowplot::ggdraw() + + cowplot::draw_plot(combined_plot, 0, 0, 1, 1) + + cowplot::draw_label(sprintf("Brunnen %2d", brunnen_nr), x = 0.2, y = 0.8, size = 12, hjust = 0.5) + +combined_plot_with_title + +} + + diff --git a/_pkgdown.yml b/_pkgdown.yml index c6eca345..0e0ec437 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -4,9 +4,11 @@ authors: href: https://mrustl.de Hauke Sonnenberg: href: https://github.com/hsonne + Christoph Sprenger: + href: https://www.kompetenz-wasser.de/en/ueber-uns/team/christoph-sprenger GeoSalz: href: https://www.kompetenz-wasser.de/en/forschung/projekte/geosalz - html: Project GeoSalz Kompetenzzentrum Wasser Berlin gGmbH (KWB): href: https://www.kompetenz-wasser.de diff --git a/man/plot_measurementchain_and_well_operation.Rd b/man/plot_measurementchain_and_well_operation.Rd new file mode 100644 index 00000000..afb401c1 --- /dev/null +++ b/man/plot_measurementchain_and_well_operation.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_measurementchain_and_welloperation.R +\name{plot_measurementchain_and_well_operation} +\alias{plot_measurementchain_and_well_operation} +\title{Plot measurementchain and well operation in combined plot} +\usage{ +plot_measurementchain_and_well_operation( + mc_dat, + well_op_data_meta, + brunnen_nr = 9, + para = "Leitfaehigkeit", + y_label = "elektr. Leitfähigkeit (µS/cm)", + date_min = as.Date("2023-05-10"), + date_max = Sys.Date() +) +} +\arguments{ +\item{mc_dat}{mc_dat} + +\item{well_op_data_meta}{well_op_data_meta} + +\item{brunnen_nr}{well id (default: 9)} + +\item{para}{parameter (either: "Leitfaehigkeit" or "Temperatur")} + +\item{y_label}{y label (default: "elektr. Leitfaehigkeit (µS/cm)")} + +\item{date_min}{minimum date for plotting (default: as.Date("2023-05-10"))} + +\item{date_max}{maximum date for plotting (default: Sys.Date())} +} +\value{ +combined plot +} +\description{ +Plot measurementchain and well operation in combined plot +} diff --git a/vignettes/measurement-chains.Rmd b/vignettes/measurement-chains.Rmd index 887606de..9956e507 100644 --- a/vignettes/measurement-chains.Rmd +++ b/vignettes/measurement-chains.Rmd @@ -94,7 +94,10 @@ paths <- kwb.utils::resolve(list( export_dir = "/export", # KWB cloud directory to which data in "export_dir" is uploaded - upload_dir = "projects/GeoSalz/Monitoring/messketten" + upload_dir = "projects/GeoSalz/Monitoring/messketten", + + # KWB cloud directory with latest BWB well operation data + well_operation = "/BWB_Brunnen_Prozessdaten" )) # Print all paths @@ -374,3 +377,106 @@ if (kwb.utils::isTryError(result)) { ) } ``` + +### Download Well Operation Data from Cloud + +```{r download_well_operation_data_from_cloud} + +mc_dat <- mc_data %>% + dplyr::left_join(metadata[,c("sensor_id", "einbau_sensor_muGOK")], by = "sensor_id") %>% + dplyr::left_join(mc_files %>% dplyr::select(sftp_path, galerie, brunnen_nummer), + by = c(file = "sftp_path")) + + +well_op_file <- kwb.nextcloud::list_files(path = paths$well_operation, + full_info = TRUE) %>% + dplyr::filter(lastmodified == max(lastmodified)) + + +xlsx_file <- kwb.nextcloud::download_files(hrefs = well_op_file$href, + target_dir = paths$export_dir) + +well_op_data <- readxl::read_xlsx(path = xlsx_file) %>% + janitor::clean_names() %>% + dplyr::filter(.data$menge_summe_m3 < 2000) + + + +separate_name_der_messstelle_gms <- function(string) { + +tibble::tibble( + wasserwerk = stringr::str_sub(string, 1L, 3L), + galerie = stringr::str_sub(string, 4L, 4L) %>% toupper(), + brunnen_nummer = stringr::str_sub(string, 5L, 9L) %>% + stringr::str_remove_all(pattern = "-") %>% + as.integer(), + unbekannter_buchstabe = stringr::str_sub(string, 10L, 10L) %>% + stringr::str_remove_all(pattern = "-") %>% + as.character(), + brunnen_baujahr = stringr::str_sub(string, 12L, 15L) %>% + stringr::str_remove_all(pattern = "-") %>% + as.integer(), + brunnen_bauart = stringr::str_sub(string, 16L, 16L) %>% + stringr::str_remove_all(pattern = "-") %>% + as.character() + ) +} + + +well_op_data_meta <- well_op_data %>% + dplyr::bind_cols(separate_name_der_messstelle_gms(well_op_data$name_der_messstelle_gms)) + + +``` + + +### Make combined EC and well operation plot + +and upload on cloud. + +```{r make_combined_plot,eval = TRUE} +well_ids <- c(9,10,13) + +pdf_names <- sprintf("mc_and_q_well-%02d.pdf", well_ids) + +target_dir <- "." +para <- "Leitfaehigkeit" +debug <- TRUE + +### Make pdf for each well +pdf_files <- sapply(well_ids, function(well_id) { + path <- file.path(target_dir, sprintf("mc-%s_and_abstraction_well-%02d.pdf", + para, + well_id)) + kwb.utils::catAndRun( + sprintf("Writting '%s' to '%s'", well_id, path), + expr = { + kwb.utils::preparePdf(path, landscape = TRUE) + on.exit(dev.off()) + print( + kwb.geosalz::plot_measurementchain_and_well_operation( + mc_dat = mc_dat, + well_op_data_meta = well_op_data_meta, + brunnen_nr = well_id, + para = para, + date_min = as.Date("2023-05-10"))) + path + }, + dbg = debug + ) + }) + +### Upload pdf files on cloud + + for (file in pdf_files) { + + kwb.utils::catAndRun( + messageText = paste("Uploading file", file), + expr = try(kwb.nextcloud::upload_file( + file = file, + target_path = paths$upload_dir + )), + dbg = TRUE + )} + +``` \ No newline at end of file