From 5ed13c21325f757afd8e2b5ef1dd50c24f312880 Mon Sep 17 00:00:00 2001 From: Tam Nguyen Date: Sun, 11 Feb 2024 18:58:55 +0100 Subject: [PATCH] feat: add more vignettes and update help --- NAMESPACE | 2 + R/userObjFunction.R | 58 ++++ R/userReadSwatOutput.R | 18 ++ .../HTML/helpCheckCurrentSimulation.html | 10 + inst/R-SWAT/HTML/helpOutputExtraction.html | 5 +- inst/R-SWAT/HTML/helpRunSWAT.html | 10 + inst/R-SWAT/R/runSWATUI.R | 137 ++++----- inst/R-SWAT/server.R | 101 ++++++- man/userObjFunction.Rd | 59 ++++ man/userReadSwatOutput.Rd | 19 ++ vignettes/userReadSwatOutput.R | 98 +++++++ vignettes/userReadSwatOutput.Rmd | 129 +++++++++ vignettes/userReadSwatOutput.html | 273 ++++++++++++++++++ vignettes/user_objective_function.R | 7 +- vignettes/user_objective_function.Rmd | 15 +- vignettes/user_objective_function.html | 19 +- 16 files changed, 872 insertions(+), 88 deletions(-) create mode 100644 R/userObjFunction.R create mode 100644 R/userReadSwatOutput.R create mode 100644 inst/R-SWAT/HTML/helpCheckCurrentSimulation.html create mode 100644 inst/R-SWAT/HTML/helpRunSWAT.html create mode 100644 man/userObjFunction.Rd create mode 100644 man/userReadSwatOutput.Rd create mode 100644 vignettes/userReadSwatOutput.R create mode 100644 vignettes/userReadSwatOutput.Rmd create mode 100644 vignettes/userReadSwatOutput.html diff --git a/NAMESPACE b/NAMESPACE index 64384aa..e6bd129 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -33,6 +33,8 @@ export(updateCalibrationFile) export(updateMultiFile) export(updateSingleFile) export(updatedFileContent) +export(userObjFunction) +export(userReadSwatOutput) export(yearlyOutputLoc) importFrom(doParallel,registerDoParallel) importFrom(foreach,"%dopar%") diff --git a/R/userObjFunction.R b/R/userObjFunction.R new file mode 100644 index 0000000..f99cab7 --- /dev/null +++ b/R/userObjFunction.R @@ -0,0 +1,58 @@ + +#' User-defined objective function +#' +#' @description +#' This is a dummy function. There are countless number of objective functions, +#' which RSWAT cannot include all of them in here. Instead, RSWAT only +#' provides some of the most commonly used objective functions, such as the NSE, +#' KGE, aBIAS, R2. User can implement their own objective function and replace +#' this function. For more detail see RSWAT vignettes (user_objective_function). +#' +#' @examples +#' \donttest{ +#' # Create example data of observed and simulated +#' obs <- list() +#' obs[[1]] <- runif(100) +#' obs[[2]] <- runif(100) +#' +#' # Simulated data +#' sim <- list() +#' sim[[1]] <- runif(100) +#' sim[[2]] <- runif(100) +#' +#' # Lets say now our objective function is the correlation R2 and the weight +#' # for the first variable (obs[[1]]) is 1 and for the second variable is 2 +#' +#' # Create a custom objective function for this task +#' updatedUserObjFunction <- function(obs, sim){ +#' +#' # Define output variable +#' output <- list() +#' output$perCriteria <- list() +#' +#' # R2 of the first variable +#' output$perCriteria[[1]] <- cor(obs[[1]], sim[[1]])**2 +#' +#' # R2 of the second variable +#' output$perCriteria[[2]] <- cor(obs[[2]], sim[[2]])**2 +#' +#' # Final objective function value (with different weights), must be with the name "output" +#' output$overalPerCriteria <- (1 * output$perCriteria[[1]] + 2 * output$perCriteria[[2]])/3 +#' +#' for (i in 1:length(output$perCriteria)){ +#' output$perCriteria[[i]] <- data.frame(userObjFunc = output$perCriteria[[i]]) +#' } +#' +#' return(output) +#' } +#' +#' # Overwrite the userObjFunction with our updatedUserObjFunction +#' environment(updatedUserObjFunction) <- asNamespace('RSWAT') +#' assignInNamespace("userObjFunction", updatedUserObjFunction, ns = "RSWAT") +#' } +#' +#' @export + +userObjFunction <- function(obs, sim){ + output <- NA +} diff --git a/R/userReadSwatOutput.R b/R/userReadSwatOutput.R new file mode 100644 index 0000000..a993740 --- /dev/null +++ b/R/userReadSwatOutput.R @@ -0,0 +1,18 @@ + +#' User-defined output extraction +#' +#' @description +#' This is a dummy function. As SWAT/SWAT+ have many outputs, RSWAT only provides +#' some standard output extraction. Users want to extract other model outputs can +#' implement their own function and replace this function. For more detail see +#' RSWAT vignettes (userReadSwatOutput). +#' +#' @examples +#' +#' # Please see RSWAT vignettes for an example +#' +#' @export + +userReadSwatOutput <- function(){ + output <- NA + } diff --git a/inst/R-SWAT/HTML/helpCheckCurrentSimulation.html b/inst/R-SWAT/HTML/helpCheckCurrentSimulation.html new file mode 100644 index 0000000..af32a34 --- /dev/null +++ b/inst/R-SWAT/HTML/helpCheckCurrentSimulation.html @@ -0,0 +1,10 @@ + + + + + + +

You can only open this files when all SWAT simulations are finished. If SWAT is running on background, you can manually go to the working folder ./Output/CurrentSimulationReport.log and open it with any text editor (e.g., notepad)

+ + + diff --git a/inst/R-SWAT/HTML/helpOutputExtraction.html b/inst/R-SWAT/HTML/helpOutputExtraction.html index 6bd6f2a..4e9e5c8 100644 --- a/inst/R-SWAT/HTML/helpOutputExtraction.html +++ b/inst/R-SWAT/HTML/helpOutputExtraction.html @@ -15,16 +15,15 @@

SWAT project

  • → Input to the Column should be '7, 8', to the Reach should be
    '1, 2 * 1, 2, 3 * 3'
    • -
  • If you want to read from other files, please modified the source code file ./R/userReadSwatOutput.R, more information about this could be found in the Section 4 of R-SWAT wiki page https://github.com/tamnva/R-SWAT/wiki/R-SWAT-User-Manual
    • +
  • If you want to read from other files, please create a "userReadSwatOutput.R" and load this file to RSWAT (by click the check box below this table. For detail on how to create this file, please see RSWAT vignettes "userReadSwatOutput".
  • Please check the tick box below (Display corresponding observed file names) to ensure that all numbers you enter here appear in the display table. The information from this text box is very important, as the observed data files should have the same name as listed in here

    • SWAT+ project

    - diff --git a/inst/R-SWAT/HTML/helpRunSWAT.html b/inst/R-SWAT/HTML/helpRunSWAT.html new file mode 100644 index 0000000..d90baf0 --- /dev/null +++ b/inst/R-SWAT/HTML/helpRunSWAT.html @@ -0,0 +1,10 @@ + + + + + + +

    When you click this button, all settings are saved to the file 'RSWATObject.rds' in the working directory folder. The parameter sets are generated and SWAT are run in parallel. Running can take time, R is busy while calling SWAT on the background therefore, it might not response to any anything. Don't turn of R. You can check the current simulation status in the file ./Output/CurrentSimulationReport.log You still go to step 4 and click the 'Open file CurrentSimulationReport.log'. When all simulations are finished, you will see a table appear

    + + + diff --git a/inst/R-SWAT/R/runSWATUI.R b/inst/R-SWAT/R/runSWATUI.R index 0f50a22..12d65da 100644 --- a/inst/R-SWAT/R/runSWATUI.R +++ b/inst/R-SWAT/R/runSWATUI.R @@ -5,112 +5,117 @@ runSwatUI <- function(id) { # shiny::NS(id) returns a namespace function, which was save as `ns` and will # invoke later. - + ns <- shiny::NS(id) - + tagList( - + fluidRow( #------------------------------------------------------------------------- # 1. Define model outputs for extraction - #------------------------------------------------------------------------- + #------------------------------------------------------------------------- column(width = 10, HTML("","1. Define model outputs for extraction",""), ), column(width = 1, - actionButton("helpOutputExtraction", + actionButton("helpOutputExtraction", "Help", buttonType = "default", style="background-color: none; border-color: none", class = NULL), ), - + column(width = 10, - excelR::excelOutput("tableOutputExtraction", - width = "100%", + excelR::excelOutput("tableOutputExtraction", + width = "100%", height = "1px"), + span(textOutput("messageUserReadSwatOutput"), style="color:red"), ), - + column(width = 5, - checkboxInput('checkOutputExtractionDisplayOnly', - 'Display corresponding observed file names', + checkboxInput('checkOutputExtractionDisplayOnly', + 'Display corresponding observed file names', value = FALSE, width = NULL), ), - - + + conditionalPanel( condition = "input.checkOutputExtractionDisplayOnly == 1", + column(width = 10, + actionButton("getUserReadSwatOutput", + "Load userReadSwatOutput.R", + buttonType = "default", + style="background-color: #87CEFA; border-color: #0d0c0c", + class = NULL), + ), + # Display file name + column(width = 10, + verbatimTextOutput("userReadSwatOutputFile", placeholder = TRUE), + ), + column(width = 10, dataTableOutput('tableOutputExtractionDisplayOnly'), ), ), - + #------------------------------------------------------------------------- # 2. Select date range for calibration - #------------------------------------------------------------------------- + #------------------------------------------------------------------------- column(width = 10, dateRangeInput("dateRangeCali", "2. Select date range", start = "2001-01-01", end = "2010-12-31"), - + ), - + column(width = 1, - actionButton("helpDateRangeCali", + actionButton("helpDateRangeCali", "Help", buttonType = "default", style="background-color: none; border-color: none", class = NULL), ), - + #------------------------------------------------------------------------- # 3. Select number of parallel runs (cores) - #------------------------------------------------------------------------- + #------------------------------------------------------------------------- column(width = 10, - sliderInput("ncores", - "3. Select number of parallel runs (threads)", - value = 4, - min = 1, + sliderInput("ncores", + "3. Select number of parallel runs (threads)", + value = 4, + min = 1, max = parallel::detectCores(), step = 1, round = TRUE), ), - + column(width = 1, - actionButton("helpNumberofThreads", + actionButton("helpNumberofThreads", "Help", buttonType = "default", style="background-color: none; border-color: none", class = NULL), ), - + #------------------------------------------------------------------------- # 4. Run SWAT - #------------------------------------------------------------------------- - div( style = "margin-top: 5em", + #------------------------------------------------------------------------- + div( style = "margin-top: 5em", column(width = 10, HTML("","4. Run SWAT",""), ), ), column(width = 1, - tippy::tippy("Help", tooltip = " - When you click this button, all settings are saved to the file - 'RSWATObject.rds' in the working directory folder. The parameter - sets are generated and SWAT are run in parallel. Running can - can take time, R is busy while calling SWAT on the background - therefore, it might not response to any anything. Don't turn of R. - You can check the current simulation status in the file - ./Output/CurrentSimulationReport.log You still go to step 4 and click - the 'Open file CurrentSimulationReport.log'. When all simulations - are finished, you will see a table appear - ", - allowHTML = TRUE, - trigger = "click", - theme = "translucent"), - ), - + actionButton("helpRunSWAT", + "Help", + buttonType = "default", + style="background-color: none; border-color: none", + class = NULL), + ), + + column(width = 10, actionButton("runSWAT", "Click here to run SWAT", @@ -120,46 +125,42 @@ runSwatUI <- function(id) { #------------------------------------------------------------------------- # 5. See simulation report - #------------------------------------------------------------------------- - div( style = "margin-top: 15em", + #------------------------------------------------------------------------- + div( style = "margin-top: 15em", column(width = 10, HTML("","5. See simulation report",""), ), ), column(width = 1, - tippy::tippy("Help", tooltip = " - You can only open this files when all SWAT simulations are - finished. If SWAT is running on background, you can manually - go to the working folder .\\Output\\CurrentSimulationReport.log - and open it with any text editor (e.g., notepad) - ", - allowHTML = TRUE, - trigger = "click", - theme = "translucent"), - ), - + actionButton("helpCheckCurrentSimulation", + "Help", + buttonType = "default", + style="background-color: none; border-color: none", + class = NULL), + ), + column(width = 5, - checkboxInput('checkCurrentSimulation', - 'Open file CurrentSimulationReport.log', + checkboxInput('checkCurrentSimulation', + 'Open file CurrentSimulationReport.log', value = FALSE, width = NULL), ), - + column(width = 5, - checkboxInput('checkDisplayParameterSet', - 'Display all parameter sets', + checkboxInput('checkDisplayParameterSet', + 'Display all parameter sets', value = FALSE, width = NULL), ), - - + + conditionalPanel( condition = "input.checkCurrentSimulation == 1", column(width = 10, uiOutput('tableCurrentSimulation'), - + ), ), - + conditionalPanel( condition = "input.checkDisplayParameterSet == 1", column(width = 10, @@ -167,7 +168,7 @@ runSwatUI <- function(id) { ), ), #------------------------------------------------------------------------- - + ) )} diff --git a/inst/R-SWAT/server.R b/inst/R-SWAT/server.R index d63e173..3e3f60f 100644 --- a/inst/R-SWAT/server.R +++ b/inst/R-SWAT/server.R @@ -698,7 +698,8 @@ server <- function(input, output, session) { showModal(modalDialog( title = "Help: 4. Select executable SWAT", - "Select the executable SWAT or SWAT+ file, for example, swat_32debug.exe", + "Select the executable SWAT or SWAT+ file, for example, swat_32debug.exe, + you could download these files here https://swat.tamu.edu/software/", easyClose = TRUE )) }) @@ -1195,6 +1196,20 @@ server <- function(input, output, session) { # Check if this option is activated globalVariable$userReadSwatOutput <<- OutputVar$userReadSwatOutput + # Display message + spsComps::shinyCatch( + if (TRUE %in% globalVariable$userReadSwatOutput){ + output$messageUserReadSwatOutput <- renderText( + "MUST check the box below to load 'userReadSwatOutput.R' file") + output$userReadSwatOutputFile <- renderText( + "Please load 'userReadSwatOutput.R' file") + } else { + output$messageUserReadSwatOutput <- renderText(" ") + output$userReadSwatOutputFile <- renderText( + "No input file is needed") + }, + blocking_level = "error") + # Display table of observed file names needed for calibration/optimization output$tableOutputExtractionDisplayOnly <- renderDataTable( printVariableNameObservedFiles(outputExtraction) @@ -1211,6 +1226,41 @@ server <- function(input, output, session) { }) + # **************************************************************************** + # Get userObjFunction.R file file + # **************************************************************************** + observe({ + + req(input$getUserReadSwatOutput) + + # Display message + spsComps::shinyCatch( + if (TRUE %in% globalVariable$userReadSwatOutput){ + output$userReadSwatOutputFile <- renderText( + "Please load 'userReadSwatOutput.R' file") + } else { + output$userReadSwatOutputFile <- renderText( + "No input file is needed") + }, + blocking_level = "error") + + + # Get full path to userObjFunction.R file + shinyjs::disable("getUserReadSwatOutput") + spsComps::shinyCatch(globalVariable$getUserReadSwatOutput <<- file.choose(), + blocking_level = "none") + shinyjs::enable("getUserReadSwatOutput") + + spsComps::shinyCatch( + if (grepl(".R", globalVariable$getUserReadSwatOutput, fixed = TRUE)){ + output$userReadSwatOutputFile <- renderText(globalVariable$getUserReadSwatOutput) + source(globalVariable$getUserReadSwatOutput) + } else { + output$userReadSwatOutputFile <- renderText("Error: The selected file must be '.R' extention") + }, + blocking_level = "error") + }) + # **************************************************************************** # Help output extraction # **************************************************************************** @@ -1264,6 +1314,19 @@ server <- function(input, output, session) { globalVariable$dateRangeCali <<- input$dateRangeCali }) + # **************************************************************************** + # Help button select file SWAT (or SWAT+) parameter file + # **************************************************************************** + observe({ + req(input$helpDateRangeCali) + + showModal(modalDialog( + title = "Help: 2. Select date range for calibration", + HTML(readLines(file.path(globalVariable$HTMLdir,"HTML", + "helpDateRangeCali.html"),warn=FALSE)), + easyClose = TRUE + )) + }) # **************************************************************************** # Help button select file SWAT (or SWAT+) parameter file @@ -1302,6 +1365,33 @@ server <- function(input, output, session) { )) }) + # **************************************************************************** + # Help button helpRunSWAT + # **************************************************************************** + observe({ + req(input$helpRunSWAT) + + showModal(modalDialog( + title = "Help: 4. Run SWAT", + HTML(readLines(file.path(globalVariable$HTMLdir,"HTML", + "helpRunSWAT.html"),warn=FALSE)), + easyClose = TRUE + )) + }) + + # **************************************************************************** + # Help button helpCheckCurrentSimulation + # **************************************************************************** + observe({ + req(input$helpCheckCurrentSimulation) + + showModal(modalDialog( + title = "Help: 5. See Simulation report", + HTML(readLines(file.path(globalVariable$HTMLdir,"HTML", + "helpCheckCurrentSimulation.html"),warn=FALSE)), + easyClose = TRUE + )) + }) # **************************************************************************** # Run SWAT # **************************************************************************** @@ -1840,13 +1930,13 @@ server <- function(input, output, session) { }) # **************************************************************************** - # Get executable SWAT file + # Get userObjFunction.R file file # **************************************************************************** observe({ req(input$getUserObjFunction) - # Get full path to SWAT exe file + # Get full path to userObjFunction.R file shinyjs::disable("getUserObjFunction") spsComps::shinyCatch(globalVariable$getUserObjFunction <<- file.choose(), blocking_level = "none") @@ -1968,12 +2058,9 @@ server <- function(input, output, session) { observe({ req(input$checkDisplayObsVar) - # Display content of the observed data files - observedData <- mergeDataFrameDiffRow(globalVariable$observedData) - # Display observed data in table spsComps::shinyCatch( - output$tableObsVarDisplay <- renderDataTable(observedData, + output$tableObsVarDisplay <- renderDataTable(mergeDataFrameDiffRow(globalVariable$observedData), server = FALSE, extensions = c("Buttons"), rownames = FALSE, diff --git a/man/userObjFunction.Rd b/man/userObjFunction.Rd new file mode 100644 index 0000000..c2f661e --- /dev/null +++ b/man/userObjFunction.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/userObjFunction.R +\name{userObjFunction} +\alias{userObjFunction} +\title{User-defined objective function} +\usage{ +userObjFunction(obs, sim) +} +\description{ +This is a dummy function. There are countless number of objective functions, +which RSWAT cannot include all of them in here. Instead, RSWAT only +provides some of the most commonly used objective functions, such as the NSE, +KGE, aBIAS, R2. User can implement their own objective function and replace +this function. For more detail see RSWAT vignettes (user_objective_function). +} +\examples{ +\donttest{ +# Create example data of observed and simulated +obs <- list() +obs[[1]] <- runif(100) +obs[[2]] <- runif(100) + +# Simulated data +sim <- list() +sim[[1]] <- runif(100) +sim[[2]] <- runif(100) + +# Lets say now our objective function is the correlation R2 and the weight +# for the first variable (obs[[1]]) is 1 and for the second variable is 2 + +# Create a custom objective function for this task +updatedUserObjFunction <- function(obs, sim){ + + # Define output variable + output <- list() + output$perCriteria <- list() + + # R2 of the first variable + output$perCriteria[[1]] <- cor(obs[[1]], sim[[1]])**2 + + # R2 of the second variable + output$perCriteria[[2]] <- cor(obs[[2]], sim[[2]])**2 + + # Final objective function value (with different weights), must be with the name "output" + output$overalPerCriteria <- (1 * output$perCriteria[[1]] + 2 * output$perCriteria[[2]])/3 + + for (i in 1:length(output$perCriteria)){ + output$perCriteria[[i]] <- data.frame(userObjFunc = output$perCriteria[[i]]) + } + + return(output) +} + +# Overwrite the userObjFunction with our updatedUserObjFunction +environment(updatedUserObjFunction) <- asNamespace('RSWAT') +assignInNamespace("userObjFunction", updatedUserObjFunction, ns = "RSWAT") +} + +} diff --git a/man/userReadSwatOutput.Rd b/man/userReadSwatOutput.Rd new file mode 100644 index 0000000..cbce2ea --- /dev/null +++ b/man/userReadSwatOutput.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/userReadSwatOutput.R +\name{userReadSwatOutput} +\alias{userReadSwatOutput} +\title{User-defined output extraction} +\usage{ +userReadSwatOutput() +} +\description{ +This is a dummy function. As SWAT/SWAT+ have many outputs, RSWAT only provides +some standard output extraction. Users want to extract other model outputs can +implement their own function and replace this function. For more detail see +RSWAT vignettes (userReadSwatOutput). +} +\examples{ + +# Please see RSWAT vignettes for an example + +} diff --git a/vignettes/userReadSwatOutput.R b/vignettes/userReadSwatOutput.R new file mode 100644 index 0000000..b6c832e --- /dev/null +++ b/vignettes/userReadSwatOutput.R @@ -0,0 +1,98 @@ +## ----include = FALSE---------------------------------------------------------- +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) + +## ----message=FALSE, eval = FALSE---------------------------------------------- +# # TODO change file path to your userObjFunction.R file +# source("C:/example/userReadSwatOutput.R") + +## ----message=FALSE, eval = FALSE---------------------------------------------- +# +# #' User-defined function for reading SWAT/SWAT+ +# #' +# #' @description +# #' This is a user-defined function for reading SWAT/SWAt+ outputs, do not use +# #' as it is now, please modify the source code of this function if you use +# #' according to your need and then install RSWAT app again from your local +# #' folder to update this function.DO NOT CHANGE the name of this function +# #' (mus be updateUserReadSwatOutput). ONLY CHANGE the code at the place where indicates +# #' "START TO CHANGE FROM HERE" and STOP at "END OF CHANGE". This functions +# #' must NOT receive any input. By default, you are NOW INSIDE the TxtInOut folder +# #' and you can read any output files there by just using the file name. +# #' RSWAT will use this function to get SWAT outputs (from the respective core) +# #' after each model run and save it in combination with other outputs. +# #' +# #' Please TEST your function before running R-SWAT +# #' +# #' @return a list of vector (of simulated data) +# #' @importFrom stats aggregate +# #' +# #' +# #' @export +# #' +# +# updateUserReadSwatOutput <- function(){ +# +# output <- list() +# # -------------------------------------------------------------------------# +# # Delete the existing code below and add your code below this line # +# # START TO CHANGE FROM HERE # +# # -------------------------------------------------------------------------# +# # Example: This function extracts data in the 7th column of the file output.rch +# # and aggregate to monthly +# +# # -------------------------------------------------------------------------- +# date <- seq(from = as.Date("2010-01-01", "%Y-%m-%d"), +# to = as.Date("2020-12-31", "%Y-%m-%d"), +# by = 1) +# year <- as.numeric(format(date, "%Y")) +# month <- as.numeric(format(date, "%m")) +# +# # Reach number to extract +# reachNumber <- c(17, 42, 48, 61) +# +# # -------------------------------------------------------------------------- +# +# # Read all data from output.rch +# getOutputRsvData <- read.table("output.rch", header = FALSE, sep = "", skip = 9) +# +# # Only select column 7 (this is the outflow column) +# flowOut <- getOutputRsvData[,7] +# +# # Total number of reach +# totalNumberOfReach <- max(getOutputRsvData[,2]) +# +# # Get daily outflow of each reach and aggregate to monthly flow (unit m3/month) +# for (i in 1:length(reachNumber)){ +# +# # Get daily outflow of reach reachNumber[i] +# output[[i]] <- flowOut[seq(reachNumber[i], length(flowOut), totalNumberOfReach)] +# +# # Put daily outflow to a data frame of 3 columns (month, year, and daily Q) +# dataFrame <- data.frame(month = month, +# year = year, +# Q = output[[i]]) +# +# # Aggregate to monthly +# dataFrameMonthly <- aggregate(.~ month + year, dataFrame, FUN = sum) +# +# # Only get the values of Q +# output[[i]] <- dataFrameMonthly$Q +# +# } +# +# # ---------------------------------------------------------------------------- +# # END OF CHANGE: Don't modify anything after this line +# # ---------------------------------------------------------------------------- +# +# return(output) +# +# } +# +# # Overwrite the userReadSwatOutput with our updateUserReadSwatOutput +# environment(updateUserReadSwatOutput) <- asNamespace('RSWAT') +# assignInNamespace("userReadSwatOutput", updateUserReadSwatOutput, ns = "RSWAT") +# + diff --git a/vignettes/userReadSwatOutput.Rmd b/vignettes/userReadSwatOutput.Rmd new file mode 100644 index 0000000..50f0098 --- /dev/null +++ b/vignettes/userReadSwatOutput.Rmd @@ -0,0 +1,129 @@ +--- +title: "Use user-defined output extraction" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Use user-defined output extraction} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +### 1. Overview +As SWAT/SWAT+ have many outputs, RSWAT only provides some standard output extraction. Users want to extract other model outputs can implement their own output extraction function and replace the userReadSwatOutput function in RSWAT + +### 2. Import your design objective function into RSWAT +Depending on whether you use RSWAT with our without the GUI + +* Case 1: When you used the GUI of RSWAT, the user objective function can be imported in step 3. Run SWAT &rarr. 1. Define model outputs for extraction + +* Case 2: When using RSWAT without the GUI, user needs to add the following line to their script: + +```{r, message=FALSE, eval = FALSE} +# TODO change file path to your userObjFunction.R file +source("C:/example/userReadSwatOutput.R") +``` + +### 3. How to create userObjFunction.R file? + +Below is a minimum example of a user defined output extraction. Lets say we run SWAT model and want to extract data in the 7th column of the file output.rch and aggregate to monthly. + +Here is the content of the "userReadSwatOutput.R" file for such a task + +```{r, message=FALSE, eval = FALSE} + +#' User-defined function for reading SWAT/SWAT+ +#' +#' @description +#' This is a user-defined function for reading SWAT/SWAt+ outputs, do not use +#' as it is now, please modify the source code of this function if you use +#' according to your need and then install RSWAT app again from your local +#' folder to update this function.DO NOT CHANGE the name of this function +#' (mus be updateUserReadSwatOutput). ONLY CHANGE the code at the place where indicates +#' "START TO CHANGE FROM HERE" and STOP at "END OF CHANGE". This functions +#' must NOT receive any input. By default, you are NOW INSIDE the TxtInOut folder +#' and you can read any output files there by just using the file name. +#' RSWAT will use this function to get SWAT outputs (from the respective core) +#' after each model run and save it in combination with other outputs. +#' +#' Please TEST your function before running R-SWAT +#' +#' @return a list of vector (of simulated data) +#' @importFrom stats aggregate +#' +#' +#' @export +#' + +updateUserReadSwatOutput <- function(){ + + output <- list() + # -------------------------------------------------------------------------# + # Delete the existing code below and add your code below this line # + # START TO CHANGE FROM HERE # + # -------------------------------------------------------------------------# + # Example: This function extracts data in the 7th column of the file output.rch + # and aggregate to monthly + + # -------------------------------------------------------------------------- + date <- seq(from = as.Date("2010-01-01", "%Y-%m-%d"), + to = as.Date("2020-12-31", "%Y-%m-%d"), + by = 1) + year <- as.numeric(format(date, "%Y")) + month <- as.numeric(format(date, "%m")) + + # Reach number to extract + reachNumber <- c(17, 42, 48, 61) + + # -------------------------------------------------------------------------- + + # Read all data from output.rch + getOutputRsvData <- read.table("output.rch", header = FALSE, sep = "", skip = 9) + + # Only select column 7 (this is the outflow column) + flowOut <- getOutputRsvData[,7] + + # Total number of reach + totalNumberOfReach <- max(getOutputRsvData[,2]) + + # Get daily outflow of each reach and aggregate to monthly flow (unit m3/month) + for (i in 1:length(reachNumber)){ + + # Get daily outflow of reach reachNumber[i] + output[[i]] <- flowOut[seq(reachNumber[i], length(flowOut), totalNumberOfReach)] + + # Put daily outflow to a data frame of 3 columns (month, year, and daily Q) + dataFrame <- data.frame(month = month, + year = year, + Q = output[[i]]) + + # Aggregate to monthly + dataFrameMonthly <- aggregate(.~ month + year, dataFrame, FUN = sum) + + # Only get the values of Q + output[[i]] <- dataFrameMonthly$Q + + } + + # ---------------------------------------------------------------------------- + # END OF CHANGE: Don't modify anything after this line + # ---------------------------------------------------------------------------- + + return(output) + +} + +# Overwrite the userReadSwatOutput with our updateUserReadSwatOutput +environment(updateUserReadSwatOutput) <- asNamespace('RSWAT') +assignInNamespace("userReadSwatOutput", updateUserReadSwatOutput, ns = "RSWAT") + +``` + + + + diff --git a/vignettes/userReadSwatOutput.html b/vignettes/userReadSwatOutput.html new file mode 100644 index 0000000..7a0b5dd --- /dev/null +++ b/vignettes/userReadSwatOutput.html @@ -0,0 +1,273 @@ + + + + + + + + + + + + + + +Use user-defined output extraction + + + + + + + + + + + + + + + + + + + + + + + + + + +

    Use user-defined output extraction

    + + + +
    +

    1. Overview

    +

    As SWAT/SWAT+ have many outputs, RSWAT only provides some standard output extraction. Users want to extract other model outputs can implement their own output extraction function and replace the userReadSwatOutput function in RSWAT

    +
    +
    +

    2. Import your design objective function into RSWAT

    +

    Depending on whether you use RSWAT with our without the GUI

    +
      +

    • Case 1: When you used the GUI of RSWAT, the user objective function can be imported in step 3. Run SWAT &rarr. 1. Define model outputs for extraction

      • +

    • Case 2: When using RSWAT without the GUI, user needs to add the following line to their script:

      • +
    +
    # TODO change file path to your userObjFunction.R file
+source("C:/example/userReadSwatOutput.R")
    +
    +
    +

    3. How to create userObjFunction.R file?

    +

    Below is a minimum example of a user defined output extraction. Lets say we run SWAT model and want to extract data in the 7th column of the file output.rch and aggregate to monthly.

    +

    Here is the content of the “userReadSwatOutput.R” file for such a task

    +
    
+#' User-defined function for reading SWAT/SWAT+
+#'
+#' @description
+#' This is a user-defined function for reading SWAT/SWAt+ outputs, do not use
+#' as it is now, please modify the source code of this function if you use
+#' according to your need and then install RSWAT app again from your local
+#' folder to update this function.DO NOT CHANGE the name of this function
+#' (mus be updateUserReadSwatOutput). ONLY CHANGE the code at the place where indicates
+#' "START TO CHANGE FROM HERE" and STOP at "END OF CHANGE". This functions
+#' must NOT receive any input. By default, you are NOW INSIDE the TxtInOut folder
+#' and you can read any output files there by just using the file name.
+#' RSWAT will use this function to get SWAT outputs (from the respective core)
+#' after each model run and save it in combination with other outputs.
+#'
+#' Please TEST your function before running R-SWAT
+#'
+#' @return a list of vector (of simulated data)
+#' @importFrom stats aggregate
+#'
+#'
+#' @export
+#'
+
+updateUserReadSwatOutput <- function(){
+  
+  output <- list()
+  # -------------------------------------------------------------------------#
+  #       Delete the existing code below and add your code below this line   #
+  #                 START TO CHANGE FROM HERE                                #
+  # -------------------------------------------------------------------------#
+  # Example: This function extracts data in the 7th column of the file  output.rch
+  #          and aggregate to monthly
+  
+  # --------------------------------------------------------------------------
+  date <- seq(from = as.Date("2010-01-01", "%Y-%m-%d"),
+              to = as.Date("2020-12-31", "%Y-%m-%d"),
+              by = 1)
+  year <- as.numeric(format(date, "%Y"))
+  month <- as.numeric(format(date, "%m"))
+  
+  # Reach number to extract
+  reachNumber <- c(17, 42, 48, 61)
+  
+  # --------------------------------------------------------------------------
+  
+  # Read all data from output.rch
+  getOutputRsvData <- read.table("output.rch", header = FALSE, sep = "", skip = 9)
+  
+  # Only select column 7 (this is the outflow column)
+  flowOut <- getOutputRsvData[,7]
+  
+  # Total number of reach
+  totalNumberOfReach <- max(getOutputRsvData[,2])
+  
+  # Get daily outflow of each reach and aggregate to monthly flow (unit m3/month)
+  for (i in 1:length(reachNumber)){
+    
+    # Get daily outflow of reach reachNumber[i]
+    output[[i]] <- flowOut[seq(reachNumber[i], length(flowOut), totalNumberOfReach)]
+    
+    # Put daily outflow to a data frame of 3 columns (month, year, and daily Q)
+    dataFrame <- data.frame(month = month,
+                            year = year,
+                            Q = output[[i]])
+    
+    # Aggregate to monthly
+    dataFrameMonthly <- aggregate(.~ month + year, dataFrame, FUN = sum)
+    
+    # Only get the values of Q
+    output[[i]] <- dataFrameMonthly$Q
+    
+  }
+  
+  # ----------------------------------------------------------------------------
+  # END OF CHANGE: Don't modify anything after this line
+  # ----------------------------------------------------------------------------
+  
+  return(output)
+  
+}
+
+# Overwrite the userReadSwatOutput with our updateUserReadSwatOutput
+environment(updateUserReadSwatOutput) <- asNamespace('RSWAT')
+assignInNamespace("userReadSwatOutput", updateUserReadSwatOutput, ns = "RSWAT")
    +
    + + + + + + + + + + + diff --git a/vignettes/user_objective_function.R b/vignettes/user_objective_function.R index 11345a0..467c496 100644 --- a/vignettes/user_objective_function.R +++ b/vignettes/user_objective_function.R @@ -68,7 +68,7 @@ knitr::opts_chunk$set( # output$perCriteria <- list() # # # -------------------------------------------------------------------------# -# # Delete the existing code below and add your code below this line # +# # TODO: MODIFY the existing code below and add your code below this line # # # START TO CHANGE FROM HERE # # # -------------------------------------------------------------------------# # # In this example, lets say you extracted two outputs and want to calculate @@ -100,4 +100,9 @@ knitr::opts_chunk$set( # return(output) # } # +# +# # Overwrite the userObjFunction with our updatedUserObjFunction +# environment(updatedUserObjFunction) <- asNamespace('RSWAT') +# assignInNamespace("userObjFunction", updatedUserObjFunction, ns = "RSWAT") +# diff --git a/vignettes/user_objective_function.Rmd b/vignettes/user_objective_function.Rmd index 966a932..7ac87a9 100644 --- a/vignettes/user_objective_function.Rmd +++ b/vignettes/user_objective_function.Rmd @@ -15,12 +15,14 @@ knitr::opts_chunk$set( ``` ### 1. Overview -When the build-in objective functions of RSWAT (e.g., NSE, KGE, PBIAS, ...) does not suit your need, here is the place you can define a custom objective function. +When the build-in objective functions of RSWAT (e.g., NSE, KGE, PBIAS, ...) do not suit your need, here is the place you can define a custom objective function. ### 2. Import your design objective function into RSWAT Depending on whether you use RSWAT with our without the GUI - - Case 1: When you used the GUI of RSWAT, the user objective function can be imported in step 4.1. Objective function → 1. Select objective function (userObjFunction) → Load userObjFunction.R - - Case 2: When using RSWAT without the GUI, user need to add the following lines to their script: + +* Case 1: When you used the GUI of RSWAT, the user objective function can be imported in step 4.1. Objective function → 1. Select objective function (userObjFunction) → Load userObjFunction.R + +* Case 2: When using RSWAT without the GUI, user needs to add the following line to their script: ```{r, message=FALSE, eval = FALSE} # TODO change file path to your userObjFunction.R file @@ -29,7 +31,7 @@ source("C:/example/userObjFunction.R") ### 3. How to create userObjFunction.R file? -Below is a minimum example of a user defined objective function. Lets say we simulated for streamflow (Q) in two gauging stations (station 1 and station 2). In the first gauging stations, we use the Root Mean Square Error (RMSE) as an objective function but put more weight on streamflow of the second gauging station. Our final RMSE should has the following form: +Below is a minimum example of a user defined objective function. Lets say we simulate for streamflow (Q) in two gauging stations (station 1 and station 2). In the first gauging stations, we use the Root Mean Square Error (RMSE) as an objective function but put more weight on streamflow of the second gauging station. Our final RMSE should has the following form: $$ R^2 = \frac{1 \cdot R^2_{Q_1} + 2 \cdot R^2_{Q_2}}{1 + 2} $$ Here is the content of the "userObjFunction.R" file @@ -126,6 +128,11 @@ userObjFunction <- function(obs, sim){ return(output) } + +# Overwrite the userObjFunction with our updatedUserObjFunction +environment(updatedUserObjFunction) <- asNamespace('RSWAT') +assignInNamespace("userObjFunction", updatedUserObjFunction, ns = "RSWAT") + ``` diff --git a/vignettes/user_objective_function.html b/vignettes/user_objective_function.html index a8b6610..dd6a29d 100644 --- a/vignettes/user_objective_function.html +++ b/vignettes/user_objective_function.html @@ -151,17 +151,21 @@

    Use user-defined objective function

    1. Overview

    -

    When the build-in objective functions of RSWAT (e.g., NSE, KGE, PBIAS, …) does not suit your need, here is the place you can define a custom objective function.

    +

    When the build-in objective functions of RSWAT (e.g., NSE, KGE, PBIAS, …) do not suit your need, here is the place you can define a custom objective function.

    2. Import your design objective function into RSWAT

    -

    Depending on whether you use RSWAT with our without the GUI - Case 1: When you used the GUI of RSWAT, the user objective function can be imported in step 4.1. Objective function → 1. Select objective function (userObjFunction) → Load userObjFunction.R - Case 2: When using RSWAT without the GUI, user need to add the following lines to their script:

    +

    Depending on whether you use RSWAT with our without the GUI

    +
      +

    • Case 1: When you used the GUI of RSWAT, the user objective function can be imported in step 4.1. Objective function → 1. Select objective function (userObjFunction) → Load userObjFunction.R

      • +

    • Case 2: When using RSWAT without the GUI, user needs to add the following line to their script:

      • +
    # TODO change file path to your userObjFunction.R file
 source("C:/example/userObjFunction.R")

    3. How to create userObjFunction.R file?

    -

    Below is a minimum example of a user defined objective function. Lets say we simulated for streamflow (Q) in two gauging stations (station 1 and station 2). In the first gauging stations, we use the Root Mean Square Error (RMSE) as an objective function but put more weight on streamflow of the second gauging station. Our final RMSE should has the following form:

    +

    Below is a minimum example of a user defined objective function. Lets say we simulate for streamflow (Q) in two gauging stations (station 1 and station 2). In the first gauging stations, we use the Root Mean Square Error (RMSE) as an objective function but put more weight on streamflow of the second gauging station. Our final RMSE should has the following form:

    \[ R^2 = \frac{1 \cdot R^2_{Q_1} + 2 \cdot R^2_{Q_2}}{1 + 2} \] Here is the content of the “userObjFunction.R” file

    #' User-defined objective function - DO NOT USE AS IT IS NOW
 #'
@@ -222,7 +226,7 @@ 
    3. How to create userObjFunction.R file?
    
   output$perCriteria <- list()
 
   # -------------------------------------------------------------------------#
-  #       Delete the existing code below and add your code below this line   #
+  #  TODO: MODIFY the existing code below and add your code below this line  #
   #                 START TO CHANGE FROM HERE                                #
   # -------------------------------------------------------------------------#
   # In this example, lets say you extracted two outputs and want to calculate
@@ -252,7 +256,12 @@ 
    3. How to create userObjFunction.R file?
    
   }
 
   return(output)
-}
    +} + + +# Overwrite the userObjFunction with our updatedUserObjFunction +environment(updatedUserObjFunction) <- asNamespace('RSWAT') +assignInNamespace("userObjFunction", updatedUserObjFunction, ns = "RSWAT")