Merge pull request #40 from KWB-R/well_operation

Well operation

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", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-0647-7726")),
     person("Hauke", "Sonnenberg", , "[email protected]", role = "ctb",
            comment = c(ORCID = "0000-0001-9134-2871")),
+    person("Christoph", "Sprenger", , "[email protected]", role = "ctb",
+           comment = c(ORCID = "0000-0002-0178-6645")),
     person("GeoSalz", role = "fnd"),
     person("Kompetenzzentrum Wasser Berlin gGmbH (KWB)", role = "cph")
   )
@@ -36,6 +38,7 @@ Imports:
     readODS,
     readr(>= 1.4.0),
     readxl (>= 1.2.0),
+    RColorBrewer, 
     rlang (>= 0.3.1),
     rmarkdown (>= 1.11),
     sf,
@@ -44,7 +47,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 +75,4 @@ Remotes:
 ByteCompile: true
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1

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)

NEWS.md

@@ -1,3 +1,13 @@
+# [kwb.geosalz 0.7.0](https://github.com/KWB-R/kwb.geosalz/releases/tag/v0.7.0) <small>2024-03-13</small>
+
+* 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) <small>2023-04-14</small>
 
 * Fix GitHub Actions failure: 

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
+
+}
+
+

_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: <img src='https://www.kompetenz-wasser.de/media/pages/forschung/projekte/geosalz/7bc1cad2b3-1650461797/geosalz_logo_transparent_rgb.png' alt='Project GeoSalz'
+    html: <img src='https://www.kompetenz-wasser.de/media/pages/forschung/projekte/geosalz/8fbeee5cf8-1702890603/geosalz_logo_transparent_rgb.png' alt='Project GeoSalz'
       height = '24' />
   Kompetenzzentrum Wasser Berlin gGmbH (KWB):
     href: https://www.kompetenz-wasser.de

vignettes/measurement-chains.Rmd

@@ -94,7 +94,10 @@ paths <- kwb.utils::resolve(list(
   export_dir = "<local_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 = "<upload_dir>/BWB_Brunnen_Prozessdaten"
 ))
 
 # Print all paths
@@ -374,3 +377,110 @@ 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))
+
+
+file <- well_op_file$file[1]
+tdir <- fs::path_norm(paths$download_dir)
+
+xlsx_file <- kwb.nextcloud::download_files(hrefs = well_op_file$href,
+                                           target_dir = tdir)
+
+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}
+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
+  )}
+
+```