added bug fixes in mgt_report and print out for schedule_report, bug fixes for...

added bug fixes in mgt_report and print out for schedule_report, bug fixes for point sources (if there is none case)

NAMESPACE

@@ -25,7 +25,9 @@ importFrom(dplyr,arrange)
 importFrom(dplyr,bind_rows)
 importFrom(dplyr,case_when)
 importFrom(dplyr,distinct)
+importFrom(dplyr,ends_with)
 importFrom(dplyr,filter)
+importFrom(dplyr,full_join)
 importFrom(dplyr,group_by)
 importFrom(dplyr,group_map)
 importFrom(dplyr,group_split)
@@ -36,6 +38,7 @@ importFrom(dplyr,mutate_all)
 importFrom(dplyr,mutate_at)
 importFrom(dplyr,n)
 importFrom(dplyr,rename)
+importFrom(dplyr,rename_with)
 importFrom(dplyr,row_number)
 importFrom(dplyr,select)
 importFrom(dplyr,slice)
@@ -81,7 +84,9 @@ importFrom(purrr,map_df)
 importFrom(purrr,map_int)
 importFrom(purrr,set_names)
 importFrom(readr,read_lines)
+importFrom(readr,write_delim)
 importFrom(readr,write_lines)
+importFrom(stringr,str_remove)
 importFrom(stringr,str_replace)
 importFrom(stringr,str_replace_all)
 importFrom(stringr,str_split)

R/helper.R

@@ -75,3 +75,32 @@ hide_show <- function(graph){
                   args = list("visible", "legendonly"),
                   label = "hide all")))))
 }
+
+#' Remove tail endings for management, plant community, land use classes
+#'
+#' This function is required for SWATfarmR generated management files
+#' as management.sch, plant.ini, landuse.lum and hru-data.hru can get too
+#' long names for swat executable.
+#'
+#' @param f multiline character
+#' @param pattern pattern after which to remove tail
+#' @return corrected multiline character
+#' @keywords internal
+#'
+#' @examples
+#' \dontrun{
+#' library(readr)
+#' landuse <- read_lines(paste0(project_path,'/landuse.lum'), lazy = FALSE)
+#' landuse  <- remove_tail(landuse, "lum")
+#' landuse  <- remove_tail(landuse, "comm")
+#' landuse  <- remove_tail(landuse, "mgt")
+#' write_lines(landuse, paste0(project_path,'/landuse_new.lum'))
+#' }
+
+remove_tail <- function(f, pattern){
+  ind <- grep(paste0("_", pattern,"_"), f)
+  for(i in ind){
+    f[i] <- gsub(paste0("(_", pattern, ").*?\\s"), "\\1 ", f[i])
+  }
+  return(f)
+}

R/plot_ps_tile.R

@@ -17,40 +17,45 @@
 #' }
 
 plot_ps <- function(sim_verify, conc = FALSE){
-  df <- sim_verify$recall_yr[, -c(1:3,6)] %>%
-    .[, colSums(.!= 0) > 0] %>%
-    mutate(yr = as.factor(yr),
-           name = gsub("hru00", "ps", name))
-  if(conc){
-    df <- df %>%
-      pivot_longer(-c(yr, name, flo), names_to = 'var', values_to = 'Values') %>%
-      mutate(Values = ifelse(var == "sed", (Values/flo)*(1000000/(24*69*60*365.25)),
-                             (Values/flo)*(1000/(24*69*60*365.25)))) %>%
-      select(yr, name, var, Values) %>%
-      bind_rows(df[c("yr", "name", "flo")] %>% mutate(var = "flo") %>% rename(Values = flo)) %>%
-      mutate(var = case_when(var == 'flo' ~ "flo m3/s",
-                             var %in% c("orgn", "no3", "nh3", "no2") ~ paste(var, "N mg/y"),
-                             var %in% c("sedp", "solp") ~ paste(var, "P mg/y"),
-                             TRUE ~  paste(var, "mg/l")))
+  if(!is.null(sim_verify$recall_yr)){
+    df <- sim_verify$recall_yr[, -c(1:3,6)] %>%
+      .[, colSums(.!= 0) > 0] %>%
+      mutate(yr = as.factor(yr),
+             name = gsub("hru00", "ps", name))
+    if(conc){
+      df <- df %>%
+        pivot_longer(-c(yr, name, flo), names_to = 'var', values_to = 'Values') %>%
+        mutate(Values = ifelse(var == "sed", (Values/flo)*(1000000/(24*69*60*365.25)),
+                               (Values/flo)*(1000/(24*69*60*365.25)))) %>%
+        select(yr, name, var, Values) %>%
+        bind_rows(df[c("yr", "name", "flo")] %>% mutate(var = "flo") %>% rename(Values = flo)) %>%
+        mutate(var = case_when(var == 'flo' ~ "flo m3/s",
+                               var %in% c("orgn", "no3", "nh3", "no2") ~ paste(var, "N mg/y"),
+                               var %in% c("sedp", "solp") ~ paste(var, "P mg/y"),
+                               TRUE ~  paste(var, "mg/l")))
+    } else {
+      df <- df %>%
+        pivot_longer(-c(yr, name), names_to = 'var', values_to = 'Values') %>%
+        mutate(var = case_when(var == 'flo' ~ "flo m3/s",
+                               var == 'sed' ~ "sed t/y",
+                               var %in% c("orgn", "no3", "nh3", "no2") ~ paste(var, "N kg/y"),
+                               var %in% c("sedp", "solp") ~ paste(var, "P kg/y"),
+                               TRUE ~  paste(var, "kg/y")))
+    }
+    fig <- ggplot(df, aes(x=yr, y=Values,  group=name, colour=name))+
+      geom_line(size=1.5)+
+      facet_wrap(~var, scales = "free_y")+
+      labs(color='Point sources', x = 'Year') +
+      theme_bw()+
+      theme(strip.background = element_rect(fill = "deepskyblue3", colour = "azure3"),
+            strip.text = element_text(color = "white", face="bold"),
+            panel.border = element_rect(colour = "azure3"),
+            axis.text.x = element_text(angle = 25, hjust=1))
+
+    return(fig)
   } else {
-    df <- df %>%
-      pivot_longer(-c(yr, name), names_to = 'var', values_to = 'Values') %>%
-      mutate(var = case_when(var == 'flo' ~ "flo m3/s",
-                             var == 'sed' ~ "sed t/y",
-                             var %in% c("orgn", "no3", "nh3", "no2") ~ paste(var, "N kg/y"),
-                             var %in% c("sedp", "solp") ~ paste(var, "P kg/y"),
-                             TRUE ~  paste(var, "kg/y")))
+    print("No point sources exists in this model setup!!!")
   }
-  fig <- ggplot(df, aes(x=yr, y=Values,  group=name, colour=name))+
-    geom_line(size=1.5)+
-    facet_wrap(~var, scales = "free_y")+
-    labs(color='Point sources', x = 'Year') +
-    theme_bw()+
-    theme(strip.background = element_rect(fill = "deepskyblue3", colour = "azure3"),
-          strip.text = element_text(color = "white", face="bold"),
-          panel.border = element_rect(colour = "azure3"),
-          axis.text.x = element_text(angle = 25, hjust=1))
-  return(fig)
 }
 
 #' Print the average annual qtile for HRUs

R/print_mgt.R

@@ -42,18 +42,21 @@ print_triggered_mgt <- function(sim_verify, hru_id, years = 1900:2100) {
 #' @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()}
+#' @param write_report (optional) Boolean TRUE for writing output to 'schedule_report.txt' file,
+#' FALSE - not preparing this file. Default \code{write_report = FALSE}.
 #'
 #' @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 dplyr filter group_by group_split lead left_join mutate rename select slice_sample summarise %>% rename_with full_join ends_with
 #' @importFrom purrr map
-#' @importFrom stringr str_sub
+#' @importFrom stringr str_sub str_remove
+#' @importFrom readr write_delim write_lines
 #'
 #' @export
 #'
-report_mgt <- function(sim_verify) {
+report_mgt <- function(sim_verify, write_report = FALSE) {
   yr_start <- min(sim_verify$mgt_out$year)
   mgt_lbl <- unique(sim_verify$lum_mgt$mgt)
   mgt_lbl <- mgt_lbl[!is.na(mgt_lbl)]
@@ -90,12 +93,14 @@ report_mgt <- function(sim_verify) {
     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")) %>%
+  schdl_join <- full_join(schdl_mgt, mgt_i,
+                          by = c("schedule", "year",  "mon", "day", "op_typ", "op_data1" = "op_data1_trig"), keep = TRUE) %>%
+    select(-ends_with(".y")) %>%
+    rename_with(~str_remove(., '.x')) %>%
     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)
+    filter(op_issue & year <= max(sim_verify$mgt_out$year) - yr_start)
 
   schdl_report <- schdl_join %>%
     select(schedule, op_issue) %>%
@@ -112,6 +117,20 @@ report_mgt <- function(sim_verify) {
   schdl_report <- schdl_report %>%
     mutate(schedule_report = ops_detail)
 
+  if(write_report){
+    print("Writing schedule_report.txt")
+    write(paste("File was written with SWATdoctR at", Sys.time( )), file = "schedule_report.txt")
+    for (i in seq(1, length(schdl_report$schedule_report))){
+      mgt <- schdl_report$schedule[[i]]
+      id <- get_hru_id_by_attribute(sim_verify, mgt = mgt)$id[1]
+      write_lines(" ", "schedule_report.txt", append = TRUE)
+      write_lines(paste("HRU number -", id, "- management name:", mgt), "schedule_report.txt", append = TRUE)
+      write_lines(" ", "schedule_report.txt", append = TRUE)
+      write_delim(schdl_report$schedule_report[[i]], "schedule_report.txt", delim = "\t", append = TRUE, col_names = TRUE)
+    }
+    print(paste("The file schedule_report.txt was written in", getwd( ), "directory."))
+  }
+
   return(schdl_report)
 }
 

R/run_swat_verify.R

@@ -69,7 +69,6 @@ run_swat_verification <- function(project_path, outputs = c('wb', 'mgt', 'plt'),
     model_output <- err_msg
   } else if(nchar(msg$stderr) == 0) {
     model_output <- list()
-
     if ('plt' %in% outputs) {
       model_output$hru_pw_day <- read_tbl('hru_pw_day.txt', run_path, 3)
     }
@@ -77,7 +76,12 @@ run_swat_verification <- function(project_path, outputs = c('wb', 'mgt', 'plt'),
       model_output$basin_wb_day <- read_tbl('basin_wb_day.txt', run_path, 3)
       model_output$basin_pw_day <- read_tbl('basin_pw_day.txt', run_path, 3)
       model_output$hru_wb_aa <- read_tbl('hru_wb_aa.txt', run_path, 3)
-      model_output$recall_yr <- read_tbl('recall_yr.txt', run_path, 3)
+      tryCatch({
+        model_output$recall_yr <- read_tbl('recall_yr.txt', run_path, 3)
+      },
+      error = function(e) {
+        model_output$recall_yr <- NULL
+      })
     }
     if ('mgt' %in% outputs) {
       model_output$mgt_out <- read_mgt(run_path)

man/remove_tail.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/helper.R
+\name{remove_tail}
+\alias{remove_tail}
+\title{Remove tail endings for management, plant community, land use classes}
+\usage{
+remove_tail(f, pattern)
+}
+\arguments{
+\item{f}{multiline character}
+
+\item{pattern}{pattern after which to remove tail}
+}
+\value{
+corrected multiline character
+}
+\description{
+This function is required for SWATfarmR generated management files
+as management.sch, plant.ini, landuse.lum and hru-data.hru can get too
+long names for swat executable.
+}
+\examples{
+\dontrun{
+library(readr)
+landuse <- read_lines(paste0(project_path,'/landuse.lum'), lazy = FALSE)
+landuse  <- remove_tail(landuse, "lum")
+landuse  <- remove_tail(landuse, "comm")
+landuse  <- remove_tail(landuse, "mgt")
+write_lines(landuse, paste0(project_path,'/landuse_new.lum'))
+}
+}
+\keyword{internal}

man/report_mgt.Rd

@@ -4,12 +4,15 @@
 \alias{report_mgt}
 \title{Generate a report table that compares the scheduled and triggered managements}
 \usage{
-report_mgt(sim_verify)
+report_mgt(sim_verify, write_report = FALSE)
 }
 \arguments{
 \item{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()}}
+
+\item{write_report}{(optional) Boolean TRUE for writing output to 'schedule_report.txt' file,
+FALSE - not preparing this file. Default \code{write_report = FALSE}.}
 }
 \value{
 Returns a tibble that summarises all management schedules for