From 3ec3cd6a5a1424a04d8acdbb6a9c986f043f8372 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Christoph=20Sch=C3=BCrz?= <christoph.schuerz@ufz.de>
Date: Mon, 12 Dec 2022 20:41:26 +0100
Subject: [PATCH] Add function to get overview of triggered management
---
DESCRIPTION | 2 +-
NAMESPACE | 6 ++-
R/plot_mgt_harv.R | 1 +
R/print_mgt.R | 103 ++++++++++++++++++++++++++++++++++++++++++++
R/run_swat_verify.R | 50 ++++++++++++++++++++-
man/read_sch.Rd | 15 +++++++
6 files changed, 174 insertions(+), 3 deletions(-)
create mode 100644 man/read_sch.Rd
diff --git a/DESCRIPTION b/DESCRIPTION
index 7861527..30fdd8b 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
Package: SWATdoctR
Type: Package
Title: Finding the right diagnoses and treatments for SWAT+ models
-Version: 0.1.1
+Version: 0.1.2
Author: c(person("Svajunas", "Plunge",
email = "svajunas_plunge@sggw.edu.pl",
role = c("aut")),
diff --git a/NAMESPACE b/NAMESPACE
index d80c339..88abee4 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -38,12 +38,17 @@ importFrom(lubridate,year)
importFrom(lubridate,ymd)
importFrom(processx,run)
importFrom(purrr,map)
+importFrom(purrr,map2)
importFrom(purrr,map2_chr)
+importFrom(purrr,map2_df)
+importFrom(purrr,map_chr)
importFrom(purrr,map_df)
+importFrom(purrr,map_int)
importFrom(purrr,set_names)
importFrom(readr,read_lines)
importFrom(readr,write_lines)
importFrom(stringr,str_replace)
+importFrom(stringr,str_replace_all)
importFrom(stringr,str_split)
importFrom(stringr,str_sub)
importFrom(stringr,str_trim)
@@ -51,4 +56,3 @@ importFrom(tibble,as_tibble)
importFrom(tibble,tibble)
importFrom(tidyr,pivot_longer)
importFrom(tidyselect,all_of)
-importFrom(vroom,vroom_lines)
diff --git a/R/plot_mgt_harv.R b/R/plot_mgt_harv.R
index a812c44..81f7af1 100644
--- a/R/plot_mgt_harv.R
+++ b/R/plot_mgt_harv.R
@@ -16,6 +16,7 @@
#' @importFrom dplyr filter group_by mutate n rename select ungroup %>%
#' @importFrom ggplot2 aes ggplot geom_boxplot geom_hline labs theme_bw
#' @importFrom purrr set_names
+#'
#' @export
#'
plot_variable_at_harvkill <- function(sim_verify, variable, years = 1900:2100) {
diff --git a/R/print_mgt.R b/R/print_mgt.R
index 9de813d..f6742aa 100644
--- a/R/print_mgt.R
+++ b/R/print_mgt.R
@@ -15,6 +15,7 @@
#' @return Prints a tibble with triggered operations to the R console.
#'
#' @importFrom dplyr filter mutate rename select %>%
+#'
#' @export
#'
print_triggered_mgt <- function(sim_verify, hru_id, start_year = 1900, end_year = 2100) {
@@ -31,3 +32,105 @@ print_triggered_mgt <- function(sim_verify, hru_id, start_year = 1900, end_year
select(., year, mon, day, phuplant, operation, op_data1, op_data3) %>%
print(., n = Inf)
}
+
+#' Generate a report table that compares the scheduled and triggered managements
+#'
+#' report_mgt compares the scheduled management operations for all schedules
+#' with the triggered management operations. Therefore HRUs are randomly
+#' selected for each schedule where one of the schedules is implemented.
+#'
+#' @param sim_verify Simulation output of the function \code{run_swat_verification()}.
+#' To print the management at least the output option \code{outputs = 'mgt'} must
+#' be set in \code{run_swat_verification()}
+#'
+#' @return Returns a tibble that summarises all management schedules for
+#' which operations where scheduled, that were either not triggered of
+#' for which operation properties differ..
+#'
+#' @importFrom dplyr filter group_by group_split lead left_join mutate rename select slice_sample summarise %>%
+#' @importFrom purrr map
+#' @importFrom stringr str_sub
+#'
+#' @export
+#'
+report_mgt <- function(sim_verify) {
+ yr_start <- min(sim_verify$mgt_out$year)
+ mgt_lbl <- unique(sim_verify$lum_mgt$mgt)
+ mgt_lbl <- mgt_lbl[!is.na(mgt_lbl)]
+
+ schdl_mgt <- sim_verify$mgt_sch %>%
+ filter(schedule %in% mgt_lbl) %>%
+ filter(!is.na(op_typ)) %>%
+ group_by(schedule) %>%
+ mutate(rm_skp = lead(op_typ, 1),
+ rm_skp = ifelse(op_typ == 'skip' &
+ rm_skp != 'skip' |
+ is.na(rm_skp), TRUE, FALSE)) %>%
+ filter(!rm_skp) %>%
+ select(-rm_skp) %>%
+ mutate(year = c(NA, diff(mon)),
+ year = ifelse(is.na(year) | year >= 0, 0, 1),
+ year = cumsum(year) + yr_start) %>%
+ ungroup(.)
+
+ mgt_lbl <- unique(schdl_mgt$schedule)
+
+ hru_sel <- sim_verify$lum_mgt %>%
+ filter(mgt %in% mgt_lbl) %>%
+ group_by(mgt) %>%
+ slice_sample(., n = 1)
+
+ mgt_i <- sim_verify$mgt_out %>%
+ filter(hru %in% hru_sel$id) %>%
+ left_join(., hru_sel, by = c('hru' = 'id')) %>%
+ rename(schedule = mgt,
+ op_typ = operation,
+ op_data1_trig = op_typ) %>%
+ select(., schedule, year, mon, day, op_typ, op_data1_trig) %>%
+ mutate(op_typ = str_sub(op_typ, 1, 4) %>% tolower(.),
+ op_typ = ifelse(op_typ == 'plan', 'plnt', op_typ))
+
+ schdl_join <- left_join(schdl_mgt, mgt_i,
+ by = c("schedule", "year", "mon", "day", "op_typ")) %>%
+ select(schedule, year, mon, day, op_typ, op_data1_trig, starts_with('op_data')) %>%
+ mutate(op_issue = is.na(op_data1_trig) | op_data1_trig != op_data1,
+ year = year - yr_start + 1) %>%
+ filter(op_issue)
+
+ schdl_report <- schdl_join %>%
+ select(schedule, op_issue) %>%
+ group_by(schedule) %>%
+ summarise(op_issue = sum(op_issue),
+ .groups = 'drop')
+
+ ops_detail <- schdl_join %>%
+ group_by(schedule) %>%
+ group_split() %>%
+ map(., ~ filter(.x, op_issue)) %>%
+ map(., ~ select(.x, year, mon, day, op_typ, op_data1_trig, starts_with('op_data')))
+
+ schdl_report <- schdl_report %>%
+ mutate(schedule_report = ops_detail)
+
+ return(schdl_report)
+}
+
+
+#' Transform x to a matrix with 7 columns and fill up with NA values
+#'
+#' @param x character vector or NULL
+#'
+#' @keywords internal
+#'
+as_mtx_null <- function(x) {
+ if(is.null(x)) {
+ matrix(rep(NA_character_, 7), ncol = 7)
+ } else {
+ matrix(x, nrow = 7) %>%
+ t(.)
+ }
+}
+
+
+
+
diff --git a/R/run_swat_verify.R b/R/run_swat_verify.R
index d5f96a0..8624cb5 100644
--- a/R/run_swat_verify.R
+++ b/R/run_swat_verify.R
@@ -80,6 +80,7 @@ run_swat_verification <- function(project_path, outputs = c('wb', 'mgt', 'plt'),
}
if ('mgt' %in% outputs) {
model_output$mgt_out <- read_mgt(run_path)
+ model_output$mgt_sch <- read_sch(run_path)
hru_data <- read_tbl('hru-data.hru', run_path, 2)
landuse_lum <- read_tbl('landuse.lum', run_path, 2)
@@ -203,9 +204,9 @@ read_tbl <- function(file, run_path, n_skip) {
#'
#' @importFrom dplyr %>%
#' @importFrom purrr map map_df set_names
+#' @importFrom readr read_lines
#' @importFrom stringr str_trim str_split
#' @importFrom tibble as_tibble
-#' @importFrom vroom vroom_lines
#'
#' @keywords internal
#'
@@ -231,6 +232,53 @@ read_mgt <- function(run_path) {
return(mgt)
}
+#' Read SWAT+ management schedule file and return the read file in a tibble
+#'
+#' @param run_path Path to the folder where simulations are performed
+#'
+#' @importFrom dplyr mutate %>%
+#' @importFrom purrr map map_int map_chr map2 map2_df map_df set_names
+#' @importFrom readr read_lines
+#' @importFrom stringr str_replace_all str_trim str_split
+#' @importFrom tibble as_tibble
+#'
+#' @keywords internal
+#'
+read_sch <- function(run_path) {
+ schdl_path <- paste0(run_path, '/management.sch')
+
+ schdl <- read_lines(schdl_path, skip = 2, lazy = FALSE) %>%
+ str_trim(.) %>%
+ str_replace_all(., '\t', ' ') %>%
+ str_split(., '[:space:]+')
+
+ n_elem <- map_int(schdl, length)
+ schdl <- schdl[n_elem != 1]
+ n_elem <- map_int(schdl, length)
+ schdl_def_pos <- which(n_elem == 3)
+
+ schdl_name <- map_chr(schdl_def_pos, ~ schdl[[.x]][1])
+
+ schdl_start <- schdl_def_pos + 1
+ schdl_end <- c(schdl_def_pos[2:length(schdl_def_pos)] - 1, length(schdl))
+ no_entry <- schdl_start > schdl_end
+ schdl_start[no_entry] <- length(schdl) + 1
+ schdl_end[no_entry] <- length(schdl) + 1
+ schdl_start[no_entry] <- 1e9
+ schdl_end[no_entry] <- 1e9
+
+ schdl_mgt <- map2(schdl_start, schdl_end, ~ schdl[.x:.y]) %>%
+ map(., unlist) %>%
+ map(., as_mtx_null) %>%
+ map(., ~ as_tibble(.x, .name_repair = 'minimal')) %>%
+ map(., ~ set_names(.x, c('op_typ', 'mon', 'day', 'hu_sch', paste0('op_data', 1:3)))) %>%
+ map2_df(., schdl_name, ~ mutate(.x, schedule = .y, .before = 1))
+
+ schdl_mgt[,c(3:5, 8)] <- map_df(schdl_mgt[,c(3:5, 8)], as.numeric)
+
+ return(schdl_mgt)
+}
+
#' Generate folder structure for SWAT execution
#'
#' @param project_path Path to the SWAT project folder (i.e. TxtInOut)
diff --git a/man/read_sch.Rd b/man/read_sch.Rd
new file mode 100644
index 0000000..3f127b6
--- /dev/null
+++ b/man/read_sch.Rd
@@ -0,0 +1,15 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/run_swat_verify.R
+\name{read_sch}
+\alias{read_sch}
+\title{Read SWAT+ management schedule file and return the read file in a tibble}
+\usage{
+read_sch(run_path)
+}
+\arguments{
+\item{run_path}{Path to the folder where simulations are performed}
+}
+\description{
+Read SWAT+ management schedule file and return the read file in a tibble
+}
+\keyword{internal}
--
GitLab