Skip to content

Commit

Permalink
Merge pull request #40 from KWB-R/well_operation
Browse files Browse the repository at this point in the history
Well operation
  • Loading branch information
mrustl authored Mar 13, 2024
2 parents d05df79 + 452b17d commit f688196
Show file tree
Hide file tree
Showing 6 changed files with 254 additions and 5 deletions.
10 changes: 7 additions & 3 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -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")
)
Expand Down Expand Up @@ -36,6 +38,7 @@ Imports:
readODS,
readr(>= 1.4.0),
readxl (>= 1.2.0),
RColorBrewer,
rlang (>= 0.3.1),
rmarkdown (>= 1.11),
sf,
Expand All @@ -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,
Expand All @@ -71,4 +75,4 @@ Remotes:
ByteCompile: true
Encoding: UTF-8
LazyData: true
RoxygenNote: 7.2.3
RoxygenNote: 7.3.1
10 changes: 10 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)
Expand All @@ -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)
Expand All @@ -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)
Expand Down Expand Up @@ -151,3 +160,4 @@ importFrom(utils,str)
importFrom(utils,unzip)
importFrom(utils,write.csv)
importFrom(withr,with_dir)
importFrom(zoo,rollmean)
10 changes: 10 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -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:
Expand Down
113 changes: 113 additions & 0 deletions R/plot_measurementchain_and_welloperation.R
Original file line number Diff line number Diff line change
@@ -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

}


4 changes: 3 additions & 1 deletion _pkgdown.yml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
112 changes: 111 additions & 1 deletion vignettes/measurement-chains.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
)}
```

0 comments on commit f688196

Please sign in to comment.