diff --git a/DESCRIPTION b/DESCRIPTION index 0f3901a..e0f9e40 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: SWATprepR Title: SWAT+ input data preparation tool -Version: 0.1.6 -Date: 2023-12-04 +Version: 1.0.0 +Date: 2023-12-29 Author: c(person("Svajunas", "Plunge", email = "svajunas.plunge@gmail.com", role = c("aut", "cre"))) diff --git a/NAMESPACE b/NAMESPACE index 3f32711..5fdc6a7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,20 +1,17 @@ # Generated by roxygen2: do not edit by hand export(add_atmo_dep) -export(add_missing_pcp_zero) export(add_weather) export(clean_outliers) export(clean_wq) export(df_to_txt) export(extract_rotation) -export(fill_with_closest) export(get_atmo_dep) export(get_lu_points) export(get_usersoil_table) export(interpolate) export(load_netcdf_weather) export(load_swat_weather) -export(load_swat_weather2) export(load_template) export(plot_cal_data) export(plot_fractions) @@ -26,7 +23,6 @@ export(plot_wgn_comparison) export(prepare_climate) export(prepare_ps) export(prepare_wgn) -export(read_tbl) export(update_wst_txt) export(usersoil_to_sol) importFrom(DBI,dbConnect) @@ -166,7 +162,6 @@ importFrom(sp,CRS) importFrom(sp,over) importFrom(stats,aggregate) importFrom(stats,sd) -importFrom(stats,setNames) importFrom(stringr,str_extract) importFrom(stringr,str_replace_all) importFrom(stringr,str_split) diff --git a/NEWS.md b/NEWS.md index 1f10346..99c631b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,16 @@ +# SWATprepR 1.0.0 + +* Reviewed and updated function documentation, removed deprecated functions, made internal functions invisible, updated examples, provided additional information in links, added references where needed, and connected functions with the 'See Also' section. +* Minor bug fixes. + +# SWATprepR 0.1.6 + +* Bug fixes to `prepare_ps()` and `get_soil_parameters()`. + # SWATprepR 0.1.5 * Bug fixes to `prepare_wgn()`, `prepare_climate()`,`load_netcdf_weather()` and other functions. - # SWATprepR 0.1.4 * `load_swat_weather2()` function was added to provide quicker option for weather file loading. More 20 times faster comparing to `load_swat_weather()` function. diff --git a/R/helper.R b/R/helper.R index 9703c56..23a5d31 100644 --- a/R/helper.R +++ b/R/helper.R @@ -413,6 +413,7 @@ update_wst_id <- function(tname, db_path, wst_cli){ #' rep('%8s', 4), '%12s', '%8s', rep('%12s', 2)) #' update_wst_txt("reservoir.con", "model_folder", wst_sf, spacing) #' } +#' @keywords internal update_wst_txt <- function(fname, write_path, wst_sf, spacing, folder_to_save = "temp"){ ##Making heading text @@ -675,26 +676,39 @@ my.pcpmhhr <- function(x, na.rm = FALSE){ # this is an alternative way to calcul # Cleaning data ---------------------------------------------------------------- -#' Function to clean outliers outside by some standard deviations +#' Clean outliers outside specified standard deviations +#' +#' This function cleans outliers from a dataframe based on some standard deviations. #' -#' @param df dataframe with columns c("Station", "DATE", "Variables", "Values", "Source"). -#' @param times_sd numeric value representing multiplication factor for standard deviation. -#' Values outside mean - sd X times_sd, mean + sd X times_sd are identified as outliers. -#' Optional with default value 3. -#' @return list of two dataframes. *newdf* dataframe contains dataframe cleaned from outliers. -#' *dropped* dataframe contains data, which was removed from *newdf* dataframe. +#' @param df A dataframe with columns "Station", "DATE", "Variables", "Values", +#' "Source". The "Variables" column should contain the names of the variables. +#' @param times_sd (optional) A numeric value representing the multiplication factor for +#' standard deviation. Values outside mean - sd X times_sd and mean + sd X +#' times_sd are identified as outliers. Default \code{times_sd = 3}. +#' @return A list of two dataframes. +#' *newdf* contains the dataframe cleaned from outliers. +#' *dropped* contains the data that was removed from *newdf*. #' @importFrom dplyr mutate %>% group_by summarise left_join #' @importFrom lubridate month #' @export #' #' @examples -#' temp_path <- system.file("extdata", "calibration_data.xlsx", package = "SWATprepR") -#' cal_data <- load_template(temp_path) -#' lst <- clean_outliers(cal_data$data) -#' ##Looking at data to be removed -#' print(head(lst$dropped)) -#' ##Updating data -#' cal_data$data <- lst$newdf +#' \dontrun{ +#' # Load calibration data from an Excel file +#' temp_path <- system.file("extdata", "calibration_data.xlsx", package = "SWATprepR") +#' cal_data <- load_template(temp_path) +#' +#' # Clean outliers from the data +#' lst <- clean_outliers(cal_data$data) +#' +#' # Display data to be removed +#' print(head(lst$dropped)) +#' +#' # Update the original data with cleaned data +#' cal_data$data <- lst$newdf +#' } +#' @keywords cleaning +#' @seealso \code{\link{load_template}} clean_outliers <- function(df, times_sd = 3){ ##Calculating monthly min, max values @@ -714,17 +728,29 @@ clean_outliers <- function(df, times_sd = 3){ dropped = df[df$P == F, c("Station", "DATE", "Variables", "Values", "Source")])) } -#' Clean water quality data from most typical issues +#' Clean water quality data from common issues #' -#' @param df dataframe with water quality data with with columns c("Station", "DATE", "Variables", "Values", "Source"). -#' @param zero_to_min numeric coefficient to zeros by min variable value X zero_to_min. Optional, default 0.5. -#' @return cleaned dataframe +#' This function cleans water quality data by addressing common issues. +#' +#' @param df A dataframe with water quality data, including columns "Station", +#' "DATE", "Variables", "Values", "Source". +#' @param zero_to_min (optional) A numeric coefficient to replace zeros by the +#' minimum variable value multiplied by zero_to_min. +#' Default is \code{zero_to_min = 0.5} . +#' @return A cleaned dataframe. #' @export #' @importFrom dplyr mutate left_join distinct filter summarise select group_by #' @examples -#' temp_path <- system.file("extdata", "calibration_data.xlsx", package = "SWATprepR") -#' cal_data <- load_template(temp_path) -#' cal_data$data <- clean_wq(cal_data$data) +#' \dontrun{ +#' # Load calibration data from an Excel file +#' temp_path <- system.file("extdata", "calibration_data.xlsx", package = "SWATprepR") +#' cal_data <- load_template(temp_path) +#' +#' # Clean water quality data +#' cal_data$data <- clean_wq(cal_data$data) +#' } +#' @keywords cleaning +#' @seealso \code{\link{load_template}} clean_wq <- function(df, zero_to_min = 0.5){ ##Cleaning common problems @@ -759,34 +785,67 @@ clean_wq <- function(df, zero_to_min = 0.5){ return(df) } -#' Replace empty PCP entry with 0 +#' Replace very low or empty PCP entries with valid data or 0 #' -#' @param df_to_correct dataframe to correct for PCP variable with "DATE" and "PCP" columns. -#' @param df_valid (optional) dataframe with valid data for PCP variable with "DATE" and "PCP" columns. -#' Also should overlap with df_to_correct data. -#' @param value_to_zero (optional) numeric value of daily PCP. Only NA values can be set to 0 when df_valid PCP -#' values are below or equal to value_to_zero (default 0.2). +#' This function replaces deals with suspiciously low, missing PCP entries +#' in the provided dataframe. +#' +#' @param df_to_correct The dataframe to correct for the PCP variable with +#' "DATE" and "PCP" columns. +#' @param df_valid (optional) The dataframe with valid data for the PCP variable, +#' having "DATE" and "PCP" columns. If not provided, the function will use the +#' df_to_correct data. It should overlap with df_to_correct data. +#' @param value_to_zero (optional) The numeric value of daily PCP. Only NA values +#' can be set to 0 when df_valid PCP values are below or equal to value_to_zero +#' (default is 0.2). #' @importFrom dplyr left_join mutate case_when filter select -#' @return updated dataframe -#' @export +#' @return Updated dataframe #' #' @examples #' \dontrun{ -#' met_lst$data$ID8$PCP <- add_missing_pcp_zero(met_lst$data$ID8$PCP, met_lst$data$ID9$PCP) +#' # Get the current date as a POSIXct object +#' today <- as.POSIXct(Sys.Date()) +#' # Set the end date as 10 days from the current date +#' end_day <- as.POSIXct(Sys.Date() + 10) +#' +#' # Create a dataframe with a sequence of dates and corresponding PCP values +#' df_to_correct <- data.frame( +#' DATE = seq.POSIXt(today, end_day, by = "1 day"), # Create a daily sequence of dates +#' PCP = c(0.1, NA, 0.3, NA, 0.5, NA, 0.7, NA, 0.9, NA, 1.1) +#' ) +#' +#' # Create a dataframe with valid PCP values for the same date range +#' df_valid <- data.frame( +#' DATE = seq.POSIXt(today, end_day, by = "1 day"), # Create a daily sequence of dates +#' PCP = c(0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.2) +#' ) +#' +#' # Apply the function to replace missing PCP values with zero +#' add_missing_pcp_zero(df_to_correct, df_valid, 0.3) #' } -add_missing_pcp_zero <- function(df_to_correct, df_valid = NULL, value_to_zero = .2){ - df <- data.frame(DATE = seq.POSIXt(df_to_correct[[1,"DATE"]], df_to_correct[[nrow(df_to_correct),"DATE"]], by="day")) +#' @keywords internal + +add_missing_pcp_zero <- function(df_to_correct, df_valid = NULL, value_to_zero = 0.2) { + # Create a dataframe with a sequence of dates + df <- data.frame(DATE = seq.POSIXt(df_to_correct[[1, "DATE"]], + df_to_correct[[nrow(df_to_correct), "DATE"]], by = "day")) + + # Left join the sequence dataframe with the input dataframe based on the "DATE" column df <- left_join(df, df_to_correct, by = "DATE") - if(is.null(df_valid)){ + + # Replace missing values with zero if df_valid is NULL; otherwise, apply additional logic + if (is.null(df_valid)) { df[is.na(df)] <- 0 } else { df <- df %>% left_join(rename(df_valid, P = 2), by = "DATE") %>% - mutate(PCP = case_when(is.na(PCP) & P <= value_to_zero ~ 0, - !is.na(PCP) ~ PCP)) %>% + mutate(PCP = case_when(is.na(PCP) | PCP <= value_to_zero ~ P, + !is.na(PCP) & PCP > value_to_zero ~ PCP)) %>% filter(!is.na(PCP)) %>% select(DATE, PCP) } + + # Return the updated dataframe return(df) } diff --git a/R/loading.R b/R/loading.R index 855de9c..dea7d17 100644 --- a/R/loading.R +++ b/R/loading.R @@ -1,14 +1,20 @@ # Loading templates -------------------------------------------------------------------- -#' Function providing loading for data templates (with single and multiple data sheets) -#' (data should have been cleaned before). +#' Load Data Templates #' -#' @param template_path path to *.xlsx file. -#' @param epsg_code EPSG code for station coordinates (default 4326 for WGS 84 coordinate system) system -#' @return list of two: stations dataframe, which contains station information, -#' second member of list contains contains measurement data in dataframe (if data is in one sheet) -#' or nested list of dataframes with each parameter in separate dataframe. +#' This function facilitates the loading of data templates, which include +#' both station information and measurement data. The provided data should +#' be pre-cleaned. +#' +#' @param template_path Character, the path to the *.xlsx file containing the data template. +#' @param epsg_code (optional) Integer, EPSG code for station coordinates. +#' Default \code{epsg_code = 4326}, which stands for WGS 84 coordinate system. +#' @return A nested list with dataframes. +#' Nested structure: \code{meteo_lst -> data -> Station ID -> Parameter -> +#' Dataframe (DATE, PARAMETER)}, +#' \code{meteo_lst -> stations -> Dataframe (ID, Name, Elevation, Source, +#' geometry, Long, Lat)}. #' @importFrom dplyr mutate %>% #' @importFrom readxl read_xlsx excel_sheets #' @importFrom tidyr drop_na @@ -16,16 +22,17 @@ #' @export #' #' @examples -#' ##Two types of templates could be used +#' ## Two types of templates could be used #' # 1) Example of template for weather data #' temp_path <- system.file("extdata", "weather_data.xlsx", package = "SWATprepR") #' met_lst <- load_template(temp_path, 3035) #' str(met_lst) +#' #' ## 2) Example of template for calibration data #' temp_path <- system.file("extdata", "calibration_data.xlsx", package = "SWATprepR") #' cal_data <- load_template(temp_path) #' str(cal_data) - +#' @keywords loading load_template <- function(template_path, epsg_code = 4326){ print("Loading data from template.") @@ -170,12 +177,12 @@ load_climate <- function(f_path, f_lst = list("PCP" = "prec-1", "SLR" = "solarRa #' @importFrom dplyr %>% mutate across all_of bind_rows #' @importFrom purrr map map_lgl map_df set_names #' @return dataframe with information from text file -#' @export #' #' @examples #' \dontrun{ #' df <- read_tbl('rout_unit.con', 'model_folder', 3, 2) #' } +#' @keywords internal read_tbl <- function(tbl_name, proj_path, row_data_start = 3, row_col_names = 2) { tbl_path <- paste(proj_path, tbl_name, sep = '/') @@ -214,103 +221,13 @@ read_tbl <- function(tbl_name, proj_path, row_data_start = 3, row_col_names = 2) return(tbl) } -#' Loading SWAT+ weather files to R -#' -#' @param input_folder character, path to folder with SWAT+ weather input files (example "my_model"). -#' @importFrom sf st_as_sf -#' @importFrom stringr str_extract -#' @importFrom dplyr bind_rows mutate select -#' @importFrom stats setNames -#' @return nested list of lists with dataframes. Nested structure list -> stations, -#' list -> Variable -> Dataframe (DATE, VARIABLE). -#' @export -#' -#' @examples -#' \dontrun{ -#' met_lst <- load_swat_weather("my_folder") -#' } - -load_swat_weather <- function(input_folder){ - .Deprecated("load_swat_weather") - print(paste0("Loading of SWAT+ weather data is started from ", input_folder, " directory.")) - ##Identifying all weather files - fs <- list.files(input_folder, recursive = F, pattern="*.pcp|*.slr|*.hmd|*.tmp|*.wnd") - if(length(fs)==0){ - stop(paste0("No SWAT+ weather files have been found in ", input_folder, " directory!!!")) - } - ##Preparing list and dics required for loop - rlist <- list() ##resulting nested list of lists - stations <- NULL ##dataframe for station data - p_lst <- list("pcp" = c("PCP"), - "slr" = c("SLR"), - "hmd" = c("RELHUM"), - "tmp" = c("TMP_MAX", "TMP_MIN"), - "wnd" = c("WNDSPD")) ##Parameters dics - s_info <- unlist(strsplit(input_folder, "/")) ##source information - s_info <- paste0(s_info[c(length(s_info)-1, length(s_info))], collapse = '/') - nb <- length(fs) - ##Main loop - for (i in seq(1,nb)){ - ##Getting variable type - f_type <- p_lst[sub(".*\\.", "", fs[i])][[1]] - ##Loading data from text file - df <- read_tbl(fs[i], input_folder) - ##Getting station ID and saving it into dafaframe - id <- str_extract(toupper(fs[i]), "ID([\\d]+)") - if(!is.na(id)){ - st_info <- data.frame(ID = id) - } else { - if(!is.null(stations)){ - st_info <- data.frame(ID = max(as.numeric(str_extract(stations$ID, "(?<=ID)\\d+")))+1) - } else { - st_info <- data.frame(ID = 1) - } - id <- st_info$ID - } - ##Filling station information for the file laoded - st_info[c("Name", "Elevation", "Source", "Long", "Lat")] <- list(gsub("\\..*","",fs[i]), - as.numeric(df[[1,"elev"]]), - s_info, - as.numeric(df[[1,"lon"]]), - as.numeric(df[[1,"lat"]])) - st_info <- st_as_sf(st_info, coords = c("Long", "Lat"), crs = 4326, remove = F) - ##Checking is station information alreade in stations dataframe - if(!st_info$geometry %in% stations$geometry){ - if(!is.null(stations)){ - stations <- bind_rows(stations, st_info) - } else { - stations <- st_info - } - } - ##Identifying if file is for temperature or other parameters, processing and saving time series data - if(length(f_type)==1){ - ts <- df[2:dim(df)[1], 1:3] %>% - mutate(DATE = as.POSIXct(strptime(paste(nbyr, tstep), format="%Y %j", tz = "UTC"))) %>% - select(DATE, lat) %>% - setNames(c("DATE",f_type)) - ##If PCP below 0.2, than 0 - if(f_type == "PCP" && min(ts[["PCP"]], na.rm = TRUE) < 0.2){ - ts$PCP <- ifelse(ts[["PCP"]] < 0.2, 0, ts[["PCP"]]) - } - rlist[[id]][[f_type]] <- ts - } else if(length(f_type)==2){ - ts <- df[2:dim(df)[1], 1:4] %>% - mutate(DATE = as.POSIXct(strptime(paste(nbyr, tstep), format="%Y %j", tz = "UTC"))) %>% - select(DATE, lat, lon) %>% - setNames(c("DATE",f_type)) - rlist[[id]][[f_type[1]]] <- ts[,c("DATE", f_type[1])] - rlist[[id]][[f_type[2]]] <- ts[,c("DATE", f_type[2])] - } - cat("\014") - print(paste0(format(round(100*i/nb, 2), nsmall = 2), "% of data are loaded.")) - } - print("Data loading finished succesfully.") - return(list(stations = stations, data = rlist)) -} - -#' Loading SWAT+ weather files to R (>20 times faster version) +#' Load SWAT+ weather text files into R +#' +#' This function reads SWAT+ weather input files from a specified folder into R, +#' organizing the data into a nested list structure for easy access and analysis. #' -#' @param input_folder character, path to folder with SWAT+ weather input files (example "my_model"). +#' @param input_folder character, path to folder with SWAT+ weather input files +#' (e.g., "my_model"). #' @importFrom sf st_as_sf #' @importFrom purrr map pmap map_df map2 #' @importFrom vroom vroom_lines @@ -318,16 +235,21 @@ load_swat_weather <- function(input_folder){ #' @importFrom dplyr bind_rows mutate select group_by ungroup everything #' @importFrom tibble enframe #' @importFrom tidyr unnest spread -#' @return nested list of lists with dataframes. Nested structure list -> stations, -#' list -> Variable -> Dataframe (DATE, VARIABLE). +#' @return +#' A nested list of lists with dataframes. +#' Nested structure: \code{meteo_lst -> data -> Station ID -> Parameter -> +#' Dataframe (DATE, PARAMETER)}, +#' \code{meteo_lst -> stations -> Dataframe (ID, Name, Elevation, Source, +#' geometry, Long, Lat)}. #' @export #' #' @examples #' \dontrun{ -#' met_lst <- load_swat_weather2("my_folder") +#' met_lst <- load_swat_weather("my_folder") #' } +#' @keywords loading -load_swat_weather2 <- function(input_folder){ +load_swat_weather <- function(input_folder){ ##Set function execution timer start_t <- Sys.time() print(paste0("Loading of SWAT+ weather data is started from ", input_folder, " directory.")) @@ -426,27 +348,46 @@ load_swat_weather2 <- function(input_folder){ #' Extract EMEP atmospheric deposition data for a catchment #' -#' @param catchment_boundary_path path to basin boundary shape file. -#' @param t_ext string, which EMEP data to access 'year' for yearly averages, 'month' - monthly averages. Optional (default - 'year'). -#' @param start_year integer year to start data extraction. Optional (default - 1990). -#' @param end_year integer year to end data extraction. Optional (default - 2020). +#' This function extracts EMEP atmospheric deposition data averaged for +#' a specified catchment. +#' +#' @param catchment_boundary_path Path to the basin boundary shape file. +#' @param t_ext (optional) String, specifying the EMEP data to access. +#' 'year' for yearly averages, 'month' for monthly averages. Default +#' \code{t_ext = 'year'}. +#' @param start_year (optional) Integer representing the starting year for data +#' extraction. Default \code{start_year = 1990}. +#' @param end_year Integer representing the ending year for data extraction. +#' Default \code{end_year = 2020}. #' @importFrom sf st_transform st_read st_bbox #' @importFrom RNetCDF open.nc var.get.nc #' @importFrom dplyr bind_rows -#' @return dafaframe with "DATE", "NH4_RF", "NO3_RF" , "NH4_DRY" and "NO3_DRY" columns. Values in SWAT+ units. -#' "NH4_RF" - ammonia in rainfall (mg/l), "NO3_RF" - nitrate in rainfall (mg/l), -#' NH4_RF - ammonia deposition (kg/ha/yr), "NO3_DRY" - nitrate dry deposition (kg/ha/yr) +#' @return A dataframe with columns "DATE", "NH4_RF", "NO3_RF", "NH4_DRY", and +#' "NO3_DRY". +#' Values are in SWAT+ units. +#' "NH4_RF" - ammonia in rainfall (mg/l), "NO3_RF" - nitrate in +#' rainfall (mg/l), +#' NH4_RF - ammonia deposition (kg/ha/yr), "NO3_DRY" - nitrate dry deposition +#' (kg/ha/yr). #' @export #' @examples #' \dontrun{ -#' basin_path <- system.file("extdata", "GIS/basin.shp", package = "SWATprepR") -#' df <- get_atmo_dep(basin_path) -#' ##Plot results -#' ggplot(pivot_longer(df, !DATE, names_to = "par", values_to = "values"), aes(x = DATE, y = values))+ -#' geom_line()+ -#' facet_wrap(~par, scales = "free_y")+ -#' theme_bw() +#' # Specify the path to the basin boundary shape file +#' basin_path <- system.file("extdata", "GIS/basin.shp", package = "SWATprepR") +#' +#' # Get atmospheric deposition data for the catchment +#' df <- get_atmo_dep(basin_path) +#' +#' # Plot results +#' ggplot(pivot_longer(df, !DATE, names_to = "par", values_to = "values"), +#' aes(x = DATE, y = values))+ +#' geom_line()+ +#' facet_wrap(~par, scales = "free_y")+ +#' theme_bw() #' } +#' @references +#' See the EMEP website for more information: \url{https://www.emep.int/mscw/mscw_moddata.html} +#' @keywords loading get_atmo_dep <- function(catchment_boundary_path, t_ext = "year", start_year = 1990, end_year = 2020){ ##Part url link to emep data (more info found here https://www.emep.int/mscw/mscw_moddata.html) @@ -521,31 +462,46 @@ get_atmo_dep <- function(catchment_boundary_path, t_ext = "year", start_year = 1 return(df[c("DATE", "NH4_RF", "NO3_RF" , "NH4_DRY", "NO3_DRY")]) } -#' Extract climate data into nested list of lists +#' Extract Climate Data from CORDEX NetCDF into Nested List of Lists +#' +#' This function extracts climate data from the CORDEX-BC dataset and organizes +#' it into a nested list of lists. #' -#' @param dir_path character, path to CORDEX-BC folder (example climate/CORDEX-BC"). -#' @param location character or list. In case of character, path should be provided to -#' catchment boundary file (example GIS/basin.shp). In case of list, nested list of lists -#' with dataframes. Nested structure meteo_lst -> data -> Station ID -> Parameter -> -#' Dataframe (DATE, PARAMETER). List of list could be obtained using \code{load_template()} -#' with prepared excel template. +#' @param dir_path Character, path to the CORDEX-BC folder (e.g., "climate/CORDEX-BC"). +#' NefCDF data to be recognized by function should be saved with these file names: +#' "prec.nc" (precipitation), "relHum.nc" (relative humidity), "solarRad.nc" +#' (solar radiation), "Tmax.nc" (maximum daily temperature), "Tmin.nc" +#' (minimum daily temperature), "windSpeed.nc" (wind speed). +#' @param location Character or list. If character, provide the path to the catchment +#' boundary file (e.g., "GIS/basin.shp"). If a list, use the nested list of lists with +#' dataframes. The nested structure is same as prepared by +#' using \code{load_template()} function. #' @importFrom elevatr get_elev_point #' @importFrom sf st_read st_transform st_as_sf st_crs st_overlaps st_centroid #' @importFrom raster brick rasterToPolygons extract #' @importFrom dplyr select rename mutate #' @importFrom tidyr drop_na #' @importFrom purrr map -#' @return Nested lists of lists. First nesting level is for RCP, second for RCM model numbers, -#' the rest is the same as in meteo_lst. This part could be used with other package functions -#' (example plot_weather(result$rcp26$"1"), "PCP", "month", "sum"). +#' @return Nested list. The first nesting level is for RCP, the second for RCM model numbers, +#' and the rest follows the structure of meteo_lst. Nested structure: \code{meteo_lst -> +#' data -> Station ID -> Parameter -> Dataframe (DATE, PARAMETER)}, +#' \code{meteo_lst -> stations -> Dataframe (ID, Name, Elevation, Source, geometry, +#' Long, Lat)}. This nested list structure can be used with +#' other package functions (e.g., \code{plot_weather(result$rcp26$"1", "PCP", "month", "sum")}). #' @export #' #' @examples #' \dontrun{ -#' basin_path <- system.file("extdata", "GIS/basin.shp", package = "SWATprepR") -#' data_path <- "climate/CORDEX-BC" -#' result <- load_netcdf_weather(data_path, basin_path) +#' # Specify the path to the catchment boundary file +#' basin_path <- system.file("extdata", "GIS/basin.shp", package = "SWATprepR") +#' +#' # Specify the path to the CORDEX-BC data +#' data_path <- "climate/CORDEX-BC" +#' +#' # Extract and organize climate data +#' result <- load_netcdf_weather(data_path, basin_path) #' } +#' @keywords loading load_netcdf_weather <- function(dir_path, location){ ##Checking inputs diff --git a/R/plotting.R b/R/plotting.R index e3b9ac9..b4afae4 100644 --- a/R/plotting.R +++ b/R/plotting.R @@ -1,25 +1,33 @@ # Plotting time series ---------------------------------------------------- -#' Plotting calibration data +#' Plot Calibration Data #' -#' @param df dataframe with formatted data (Station, DATE, Variables and Values columns are needed) -#' @param stations character vector listing stations, which should be selected for figure. -#' @param variables optional parameter of character vector, which parameters should be in figure. -#' @return plotly object of interactive figure. +#' This function generates an interactive plot of calibration data based on the +#' provided data. +#' +#' @param df Dataframe with formatted data (requires "Station", "DATE", " +#' Variables", and "Values" columns). +#' @param stations Character vector listing stations to be selected for the figure. +#' @param variables (Optional) Character vector specifying which parameters +#' should be included in the figure. Default \code{variables = NULL}, all available +#' variables will be plotted. #' @importFrom dplyr filter mutate group_by %>% group_map #' @importFrom ggplot2 ggplot aes facet_wrap geom_line geom_point #' @importFrom plotly plot_ly subplot ggplotly #' @importFrom comprehenr to_vec +#' @return Plotly object of an interactive figure. #' @export #' #' @examples +#' # Example using calibration data #' temp_path <- system.file("extdata", "calibration_data.xlsx", package = "SWATprepR") #' cal_data <- load_template(temp_path) -#' plot_cal_data(cal_data$data, stations = c("1", "2", "3","10"), variables = -#' c("PT", "Q")) +#' plot_cal_data(cal_data$data, stations = c("1", "2", "3", "10"), variables = c("PT", "Q")) +#' @keywords plotting -plot_cal_data <- function(df, stations, variables = levels(as.factor(df$Variables))) { +plot_cal_data <- function(df, stations, variables = NULL) { + if (is.null(variables)) variables = unique(df$Variables) df = subset(df, Station %in% stations & Variables %in% variables) if (nrow(df)==0) stop("Non existing station or variable") df_gaps = data.frame (matrix(nrow = 0, ncol = length(colnames (df)))) @@ -121,7 +129,7 @@ plot_ts_fig <- function(station, df){ #' temp_path <- system.file("extdata", "calibration_data.xlsx", package = "SWATprepR") #' cal_data <- load_template(temp_path) #' plot_monthly(cal_data$data, station = "4") -#' +#' @keywords plotting plot_monthly <- function(df, station, variables = levels(as.factor(df$Variables))){ @@ -150,27 +158,36 @@ plot_monthly <- function(df, station, hide_show() } -#' Plot regression and fractions for each month between parts of nutrient and total +#' Plot Regression and Fractions for Each Month #' -#' @param df dataframe with formatted data (Station, DATE, Variables and Values columns are needed). -#' @param station character vector indicating station/s, which should be selected for figure. -#' @param total_var character vector for variable selected to represent total of certain variable. -#' @param min_vars character vector for variable/s selected to represent mineral or organic of certain variable. +#' This function generates two sets of plots for monthly regression and fractions +#' between nutrient parts and the total. +#' +#' @param df Dataframe with formatted data (requires "Station", "DATE", +#' "Variables", and "Values" columns). +#' @param station Character vector indicating the station/s to be selected for +#' the figure. +#' @param total_var Character vector for the variable selected to represent the +#' total of a certain nutrient. +#' @param min_vars Character vector for the variable/s selected to represent the +#' mineral or organic fraction of a certain nutrient. #' @importFrom dplyr filter select mutate group_by %>% summarise_all ungroup arrange #' @importFrom tidyr drop_na pivot_wider #' @importFrom lubridate month #' @importFrom ggplot2 ggplot aes geom_point geom_smooth facet_wrap theme_bw theme #' element_text geom_boxplot xlab ylab after_stat #' @importFrom ggpmisc stat_poly_eq -#' @return list of two ggplot objects: regression - monthly regression plots for total vs some part -#' (i.e. mineral or organic), fraction - monthly fraction values. +#' @return A list of two ggplot objects: "regression" for monthly regression +#' plots and "fraction" for monthly fraction values. #' @export #' #' @examples +#' # Example using calibration data #' temp_path <- system.file("extdata", "calibration_data.xlsx", package = "SWATprepR") #' cal_data <- load_template(temp_path) #' plot_fractions(cal_data$data, c("4"), c("NT"), c("N-NO3", "N-NH4", "N-NO2")) #' plot_fractions(cal_data$data, c("4"), c("PT"), c("P-PO4")) +#' @keywords plotting plot_fractions <- function(df, station, total_var, min_vars){ ##Preparing df for regression @@ -217,28 +234,36 @@ plot_fractions <- function(df, station, total_var, min_vars){ # Plotting maps ----------------------------------------------------------- -#' Preparing interactive map of monitoring points +#' Prepare Interactive Map of Monitoring Points +#' +#' This function generates an interactive map with monitoring points, +#' allowing users to click on points to view data. #' -#' @param df dataframe with formatted data (Station, DATE, Variables and Values columns are needed). -#' @param df_station dataframe with formatted station data (ID, geometry columns are needed). -#' @param rch sf dataframe for reaches (id, geometry columns are needed). -#' @param shp sf dataframe for basin (name, geometry columns are needed). -#' @return leaflet object of interactive map with monitoring data opening while pressing on points. +#' @param df Dataframe with formatted data (requires "Station", "DATE", +#' "Variables", and "Values" columns). +#' @param df_station Dataframe with formatted station data (requires "ID" and +#' "geometry" columns). +#' @param rch sf dataframe for reaches (requires "id" and "geometry" columns). +#' @param shp sf dataframe for basin (requires "name" and "geometry" columns). #' @importFrom leaflet leaflet addProviderTiles addPolygons addPolylines addMarkers #' addLayersControl layersControlOptions #' @importFrom leafpop addPopupGraphs +#' @return Leaflet object of an interactive map with monitoring data displayed +#' when points are clicked. #' @export #' #' @examples #' library(sf) +#' +#' # Example using calibration data #' temp_path <- system.file("extdata", "calibration_data.xlsx", package = "SWATprepR") #' reach_path <- system.file("extdata", "GIS/reaches.shp", package = "SWATprepR") #' basin_path <- system.file("extdata", "GIS/basin.shp", package = "SWATprepR") #' cal_data <- load_template(temp_path, 4326) #' reach <- st_transform(st_read(reach_path), 4326) -#' basin <-st_transform(st_read(basin_path), 4326) +#' basin <- st_transform(st_read(basin_path), 4326) #' plot_map(cal_data$data, cal_data$stations, reach, basin) - +#' @keywords plotting plot_map <- function(df, df_station, rch, shp){ if (st_crs(rch)$input == "EPSG:4326" & @@ -273,26 +298,36 @@ plot_map <- function(df, df_station, rch, shp){ # Plotting weather data --------------------------------------------------- -#' Prepare the plotly figure for weather data +#' Prepare Plotly Figure for Weather Data #' -#' @param meteo_lst nested list of lists with dataframes. -#' Nested structure meteo_lst -> data -> Station ID -> Parameter -> Dataframe (DATE, PARAMETER). -#' @param par character marking weather variable to extract (i.e. "PCP", "SLR", etc). -#' @param period character describing, which time interval to display (default is "day", -#' other examples are "week", "month", etc). -#' @param fn_summarize function to recalculate to time interval (default is "mean", other examples -#' are "median", "sum", etc). +#' This function generates a Plotly figure for weather data visualization based +#' on user-defined parameters. +#' +#' @param meteo_lst A nested list with dataframes. +#' Nested structure: \code{meteo_lst -> data -> Station ID -> Parameter -> +#' Dataframe (DATE, PARAMETER)}, +#' \code{meteo_lst -> stations -> Dataframe (ID, Name, Elevation, Source, +#' geometry, Long, Lat)}. +#' @param par Character, the weather variable to extract (e.g., "PCP", "SLR"). +#' @param period (optional) Character describing the time interval to display. +#' Default \code{period = "day"}, other examples are "week", "month", "year". +#' See [lubridate::floor_date](https://www.rdocumentation.org/packages/lubridate/versions/1.3.3/topics/floor_date) for details. +#' @param fn_summarize (optional) Function to recalculate to the specified time interval. +#' Default \code{fn_summarize ="mean"}, other examples are "median", "sum". +#' See [dplyr::summarise](https://dplyr.tidyverse.org/reference/summarise.html) for details. #' @importFrom lubridate floor_date #' @importFrom plotly plot_ly layout #' @importFrom dplyr bind_rows %>% rename summarize mutate left_join arrange #' @importFrom sf st_drop_geometry -#' @return plotly figure object with displayed weather data +#' @return Plotly figure object with displayed weather data. #' @export #' #' @examples +#' library(SWATprepR) #' temp_path <- system.file("extdata", "weather_data.xlsx", package = "SWATprepR") #' met_lst <- load_template(temp_path, 4326) #' plot_weather(met_lst, "PCP", "month", "sum") +#' @keywords plotting plot_weather <- function(meteo_lst, par, period = "day", fn_summarize = "mean"){ station <- meteo_lst$stations %>% @@ -340,29 +375,40 @@ plot_weather <- function(meteo_lst, par, period = "day", fn_summarize = "mean"){ hide_show()) } -#' Plotting figure to comparing two datasets with weather data +#' Plotting Figure to Compare Two Datasets with Weather Data +#' +#' This function generates a Plotly figure to compare weather data between two datasets based on user-defined parameters. #' -#' @param meteo_lst1 first nested list of lists with dataframes. -#' Nested structure meteo_lst -> data -> Station ID -> Parameter -> Dataframe (DATE, PARAMETER). -#' @param meteo_lst2 second nested list of lists with dataframes. -#' Nested structure meteo_lst -> data -> Station ID -> Parameter -> Dataframe (DATE, PARAMETER). -#' @param par character marking weather variable to extract (i.e. "PCP", "SLR", etc). -#' @param period character describing, which time interval to display (default is "day", -#' other examples are "week", "month", etc). -#' @param fn_summarize function to recalculate to time interval (default is "mean", other examples -#' are "median", "sum", etc). -#' @param name_set1 character to name first dataset. -#' @param name_set2 character to name second dataset. +#' @param meteo_lst1 First nested list with dataframes. +#' Nested structure: \code{meteo_lst -> data -> Station ID -> Parameter -> +#' Dataframe (DATE, PARAMETER)}, +#' \code{meteo_lst -> stations -> Dataframe (ID, Name, Elevation, Source, +#' geometry, Long, Lat)}. +#' @param meteo_lst2 Second nested list with dataframes. Same structure as \code{meteo_lst1}. +#' @param par Character vector, weather variable to extract (e.g., "PCP", "SLR"). +#' @param period (optional) Character, the time interval to display. Default +#' \code{period = "day"}, , other examples are "week", "month", "year". +#' See [lubridate::floor_date](https://www.rdocumentation.org/packages/lubridate/versions/1.3.3/topics/floor_date) for details. +#' @param fn_summarize (optional) Function to recalculate to the specified time interval. +#' Default \code{fn_summarize ="mean"}, other examples are "median", "sum". +#' See [dplyr::summarise](https://dplyr.tidyverse.org/reference/summarise.html) for details. +#' @param name_set1 (optional) Character, to name the first dataset. Default +#' \code{name_set1 = "dataset 1"}. +#' @param name_set2 (optional) Character, to name the second dataset. Default +#' \code{name_set2 = "dataset 2"}. #' @importFrom plotly layout subplot -#' @return plotly figure object with displayed weather data for two datasets. +#' @return Plotly figure object with displayed weather data for two datasets. #' @export #' #' @examples -#' temp_path <- system.file("extdata", "weather_data.xlsx", package = "SWATprepR") -#' met_lst1 <- load_template(temp_path, 4326) -#' temp_path <- system.file("extdata", "weather_data_raw.xlsx", package = "SWATprepR") -#' met_lst2 <- load_template(temp_path, 4326) +#' ##Loading data +#' temp_path1 <- system.file("extdata", "weather_data.xlsx", package = "SWATprepR") +#' met_lst1 <- load_template(temp_path1) +#' temp_path2 <- system.file("extdata", "weather_data_raw.xlsx", package = "SWATprepR") +#' met_lst2 <- load_template(temp_path2) +#' ##Plotting #' plot_weather_compare(met_lst1, met_lst2, "PCP", "month", "mean", "clean", "raw") +#' @keywords plotting plot_weather_compare <- function(meteo_lst1, meteo_lst2, par, period = "day", fn_summarize = "mean", name_set1 = "dataset 1", name_set2 = "dataset 2"){ @@ -384,33 +430,40 @@ plot_weather_compare <- function(meteo_lst1, meteo_lst2, par, period = "day", fn return(fig) } -#' Plot wgn parameters comparison +#' Plot WGN Parameters Comparison +#' +#' This function generates a ggplot figure for comparing WGN parameters between two datasets for specified stations. #' -#' @param meteo_lst1 first nested list of lists with dataframes. -#' meteo_lst nested list of lists with dataframes. -#' Nested structure meteo_lst -> data -> Station ID -> Parameter -> Dataframe (DATE, PARAMETER). -#' Nested meteo_lst -> stations Dataframe (ID, Name, Elevation, Source, geometry, Long, Lat). -#' @param meteo_lst2 second nested list of lists with dataframes. -#' meteo_lst nested list of lists with dataframes. -#' Nested structure meteo_lst -> data -> Station ID -> Parameter -> Dataframe (DATE, PARAMETER). -#' Nested meteo_lst -> stations Dataframe (ID, Name, Elevation, Source, geometry, Long, Lat). -#' @param station1 character, id of one station in the first list selected for comparison (example "ID1"). -#' @param station2 character, id of one station in the second list selected for comparison (example "ID1"). -#' @param type1 character, naming of the first dataset (example "measured"). -#' @param type2 character, naming of the second dataset (example "netCDF"). -#' @param title character, information to be added in figure title -#' @importFrom dplyr %>% filter select mutate bind_rows +#' @param meteo_lst1 First nested list with dataframes. +#' Nested structure: \code{meteo_lst -> data -> Station ID -> Parameter -> +#' Dataframe (DATE, PARAMETER)}, +#' \code{meteo_lst -> stations -> Dataframe (ID, Name, Elevation, Source, +#' geometry, Long, Lat)}. +#' @param meteo_lst2 Second nested list with dataframes. Same structure as +#' \code{meteo_lst1}. +#' @param station1 Character, ID of one station in the first list selected for +#' comparison (example "ID1"). +#' @param station2 Character, ID of one station in the second list selected for +#' comparison (example "ID1"). +#' @param type1 (optional) Character, naming of the first dataset +#' (example "measured"). Default \code{type1 = "set 1"}. +#' @param type2 (optional) Character, naming of the second dataset +#' (example "netCDF"). Default \code{type2 = "set 2"}. +#' @param title (optional) Character, information to be added in the figure title. +#' Default \code{title = "comparison"}. +#' @importFrom dplyr %>% filter select mutate bind_rows #' @importFrom tidyr pivot_longer #' @importFrom ggplot2 ggplot geom_bar facet_wrap ggtitle aes theme_minimal labs -#' @return ggplot figure of bar plots +#' @return ggplot figure of bar plots. #' @export #' #' @examples -#' \dontrun{ +#' ##Loading data #' temp_path <- system.file("extdata", "weather_data.xlsx", package = "SWATprepR") -#' met_lst <- load_template(temp_path, 4326) +#' met_lst <- load_template(temp_path) +#' ##Plotting #' plot_wgn_comparison(met_lst, met_lst, "ID9", "ID2", "Samszyce", "Glebokie", "comparison") -#' } +#' @keywords plotting plot_wgn_comparison <- function(meteo_lst1, meteo_lst2, station1, station2, type1 = "set 1", type2 = "set 2", title = "comparison"){ ##Checking inputs diff --git a/R/preparing.R b/R/preparing.R index fdd2c65..55ee67a 100644 --- a/R/preparing.R +++ b/R/preparing.R @@ -103,30 +103,48 @@ get_interpolated_data <- function(meteo_lst, grd, par, shp, dem_data_path, idw_e return(meteo_pts) } -#' Interpolating and writing results into model input files +#' Interpolate Weather Data #' -#' @param meteo_lst nested list of lists with dataframes. -#' Nested structure meteo_lst -> data -> Station ID -> Parameter -> Dataframe (DATE, PARAMETER). -#' @param catchment_boundary_path path to basin boundary shape file. -#' @param dem_data_path path to DEM raster data in same projection as weather station. -#' @param grid_spacing numeric value for distance in grid. Units of coordinate system should be used. -#' @param p_vector character vector representing weather variables to interpolate (optional, default all variables selected -#' c("PCP", "SLR", "RELHUM", "WNDSPD", "TMP_MAX", "TMP_MIN" ). -#' @param idw_exponent numeric value for exponent parameter to be used in interpolation -#' (optional, default value is 2). +#' This function interpolates weather data for a SWAT model and saves results +#' into nested list format +#' +#' @param meteo_lst A nested list of lists with dataframes. +#' Nested structure: \code{meteo_lst -> data -> Station ID -> Parameter -> +#' Dataframe (DATE, PARAMETER)}, +#' \code{meteo_lst -> stations -> Dataframe (ID, Name, Elevation, Source, +#' geometry, Long, Lat)}. +#' @param catchment_boundary_path Character, path to the basin boundary shape file. +#' @param dem_data_path Character, path to DEM raster data in the same projection +#' as the weather station. +#' @param grid_spacing Numeric, value for the distance between grid points. +#' Units of the coordinate system should be used. +#' @param p_vector (optional) Character vector representing weather variables to +#' interpolate. Default is all variables selected +#' \code{p_vector = c("PCP", "SLR", "RELHUM", "WNDSPD", "TMP_MAX", "TMP_MIN")}. +#' @param idw_exponent (optional) Numeric value for the exponent parameter to +#' be used in interpolation. Default \code{idw_exponent = 2}. #' @importFrom sf st_zm st_bbox st_read st_crs st_transform -#' @return nested list of lists with dataframes for interpolation results. -#' Nested structure lst -> data -> Station ID -> Parameter -> Dataframe (DATE, PARAMETER). -#' Function also writes all SWAT weather text input files from the interpolation results. +#' @return A nested list of lists with interpolation results. +#' A nested list of lists with dataframes. +#' Nested structure: \code{meteo_lst -> data -> Station ID -> Parameter -> +#' Dataframe (DATE, PARAMETER)}, +#' \code{meteo_lst -> stations -> Dataframe (ID, Name, Elevation, Source, +#' geometry, Long, Lat)}. #' @export #' @examples #' \dontrun{ -#' temp_path <- system.file("extdata", "weather_data.xlsx", package = "SWATprepR") -#' DEM_path <- system.file("extdata", "GIS/DEM.tif", package = "SWATprepR") -#' basin_path <- system.file("extdata", "GIS/basin.shp", package = "SWATprepR") -#' met_lst <- load_template(temp_path, 3035) -#' interpolate(met_lst, basin_path, DEM_path, 2000) +#' # Specify paths to weather data, basing shapeand DEM +#' temp_path <- system.file("extdata", "weather_data.xlsx", package = "SWATprepR") +#' DEM_path <- system.file("extdata", "GIS/DEM.tif", package = "SWATprepR") +#' basin_path <- system.file("extdata", "GIS/basin.shp", package = "SWATprepR") +#' +#' # Load weather data template +#' met_lst <- load_template(temp_path, 3035) +#' +#' # Interpolate and write SWAT model input files +#' interpolate(met_lst, basin_path, DEM_path, 2000) #' } +#' @keywords gap-filling interpolate <- function(meteo_lst, catchment_boundary_path, dem_data_path, grid_spacing, p_vector = c("PCP", "SLR", "RELHUM", "WNDSPD", "TMP_MAX", "TMP_MIN"), idw_exponent = 2){ @@ -169,23 +187,32 @@ interpolate <- function(meteo_lst, catchment_boundary_path, dem_data_path, grid_ # Weather data ----------------------------------------------- -#' Filling missing variables from the closest stations, which has data. +#' Fill missing variables from the closest stations with available data #' -#' @param meteo_lst meteo_lst nested list of lists with dataframes. -#' Nested structure meteo_lst -> data -> Station ID -> Parameter -> Dataframe (DATE, PARAMETER). -#' Nested meteo_lst -> stations Dataframe (ID, Name, Elevation, Source, geometry, Long, Lat). -#' @param par_fill vector of variables to be filled. Optional (default is c("TMP_MAX", "TMP_MIN","PCP", "RELHUM", "WNDSPD", "SLR")). +#' This function fills missing variables by interpolating values from the +#' closest stations that have data. +#' +#' @param meteo_lst A nested list of lists with dataframes. +#' Nested structure: \code{meteo_lst -> data -> Station ID -> Parameter -> +#' Dataframe (DATE, PARAMETER)}. +#' Nested \code{meteo_lst -> stations -> Dataframe (ID, Name, Elevation, Source, +#' geometry, Long, Lat)}. +#' @param par_fill (optional) A vector of variables to be filled. Default is +#' \code{par_fill = c("TMP_MAX", "TMP_MIN","PCP", "RELHUM", "WNDSPD", "SLR")}. #' @importFrom sf st_distance #' @importFrom dplyr filter %>% -#' @return list of dataframe with filled data. Returned list is for meteo_lst$data. -#' @export +#' @return A list of dataframes with filled data. Updated list is for meteo_lst$data. #' #' @examples #' \dontrun{ -#' temp_path <- system.file("extdata", "weather_data.xlsx", package = "SWATprepR") -#' met_lst <- load_template(temp_path, 3035) -#' met_lst$data <- fill_with_closest(met_lst, c("TMP_MAX", "TMP_MIN")) +#' # Load weather data from an Excel file +#' temp_path <- system.file("extdata", "weather_data.xlsx", package = "SWATprepR") +#' met_lst <- load_template(temp_path, 3035) +#' +#' # Fill for missing variables +#' met_lst$data <- fill_with_closest(met_lst, c("TMP_MAX", "TMP_MIN")) #' } +#' @keywords internal fill_with_closest <- function(meteo_lst, par_fill = c("TMP_MAX", "TMP_MIN","PCP", "RELHUM", "WNDSPD", "SLR")){ ##Initializing vectors, lists @@ -221,46 +248,69 @@ fill_with_closest <- function(meteo_lst, par_fill = c("TMP_MAX", "TMP_MIN","PCP" return(df_list) } -#' Function to generate wgn data for the model +#' Generate Weather Generator (WGN) Data for SWAT+ Model #' -#' @param meteo_lst meteo_lst nested list of lists with dataframes. -#' Nested structure meteo_lst -> data -> Station ID -> Parameter -> Dataframe (DATE, PARAMETER). -#' Nested meteo_lst -> stations Dataframe (ID, Name, Elevation, Source, geometry, Long, Lat). -#' @param TMP_MAX dataframe with two columns: DATE : POSIXct, TMP_MAX : num. Optional (default NULL). -#' This parameter refers to data, which should be used instead, if TMP_MAX variable is missing for a station. -#' @param TMP_MIN dataframe with two columns: DATE : POSIXct, TMP_MIN : num. Optional (default NULL). -#' This parameter refers to data, which should be used instead, if TMP_MIN is missing for a station. -#' @param PCP dataframe with two columns: DATE : POSIXct, PCP : num. Optional (default NULL). -#' This parameter refers to data, which should be used instead, if PCP is missing for a station. -#' @param RELHUM dataframe with two columns: DATE : POSIXct, RELHUM : num. Optional (default NULL). -#' This parameter refers to data, which should be used instead, if RELHUM is missing for a station. -#' @param WNDSPD dataframe with two columns: DATE : POSIXct, WNDSPD : num. Optional (default NULL). -#' This parameter refers to data, which should be used instead, if WNDSPD is missing for a station. -#' @param MAXHHR dataframe with two columns: DATE : POSIXct, MAXHHR : num. Optional (default NULL). -#' This parameter refers to data, which should be used instead, if MAXHHR is missing for a station. -#' @param SLR dataframe with two columns: DATE : POSIXct, SLR : num. Optional (default NULL). -#' This parameter refers to data, which should be used instead, if SLR is missing for a station. +#' This function generates weather generator (WGN) data for a SWAT+ model +#' based on meteorological data. +#' +#' @param meteo_lst Nested list with dataframes. +#' Nested structure: \code{meteo_lst -> data -> Station ID -> Parameter -> +#' Dataframe (DATE, PARAMETER)}, +#' \code{meteo_lst -> stations -> Dataframe (ID, Name, Elevation, Source, +#' geometry, Long, Lat)}. +#' @param TMP_MAX (optional) Dataframe with two columns: DATE : POSIXct, TMP_MAX : num. +#' This parameter refers to data, which should be used instead if TMP_MAX variable +#' is missing for a station. Default \code{TMP_MAX = NULL}, data of the closest +#' station with data will be used. +#' @param TMP_MIN (optional) Dataframe with two columns: DATE : POSIXct, TMP_MIN : num. +#' This parameter refers to data, which should be used instead if TMP_MIN variable +#' is missing for a station. Default \code{TMP_MIN = NULL}, indicating that data of the closest +#' station with data will be used. +#' @param PCP (optional) Dataframe with two columns: DATE : POSIXct, PCP : num. +#' This parameter refers to data, which should be used instead if PCP variable +#' is missing for a station. Default \code{PCP = NULL}, indicating that data of the closest +#' station with data will be used. +#' @param RELHUM (optional) Dataframe with two columns: DATE : POSIXct, RELHUM : num. +#' This parameter refers to data, which should be used instead if RELHUM variable +#' is missing for a station. Default \code{RELHUM = NULL}, indicating that data of the closest +#' station with data will be used. +#' @param WNDSPD (optional) Dataframe with two columns: DATE : POSIXct, WNDSPD : num. +#' This parameter refers to data, which should be used instead if WNDSPD variable +#' is missing for a station. Default \code{WNDSPD = NULL}, indicating that data of the closest +#' station with data will be used. +#' @param MAXHHR (optional) Dataframe with two columns: DATE : POSIXct, MAXHHR : num. +#' This parameter refers to data, which should be used instead if MAXHHR variable +#' is missing for a station. Default \code{MAXHHR = NULL}, indicating that data of the closest +#' station with data will be used. +#' @param SLR (optional) Dataframe with two columns: DATE : POSIXct, SLR : num. +#' This parameter refers to data, which should be used instead if SLR variable +#' is missing for a station. Default \code{SLR = NULL}, indicating that data of the closest +#' station with data will be used. #' @importFrom stats aggregate sd #' @importFrom sf st_coordinates st_transform st_crs st_drop_geometry #' @importFrom dplyr %>% rename mutate bind_rows select #' @importFrom lubridate month #' @importFrom readr parse_number -#' @return list of two dataframes: wgn_st - wgn station data, wgn_data - wgn data +#' @return List of two dataframes: wgn_st - WGN station data, wgn_data - WGN data. #' @export +#' #' @examples #' \dontrun{ -#' temp_path <- system.file("extdata", "weather_data.xlsx", package = "SWATprepR") -#' met_lst <- load_template(temp_path, 3035) -#' TMP_MAX <- met_lst$data$ID10$TMP_MAX -#' TMP_MIN <- met_lst$data$ID10$TMP_MIN -#' PCP <- met_lst$data$ID9$PCP -#' RELHUM = met_lst$data$ID9$RELHUM -#' WNDSPD <- met_lst$data$ID12$WNDSPD -#' MAXHHR <- met_lst$data$ID11$MAXHHR -#' SLR <- met_lst$data$ID9$SLR -#' ##Does the thing -#' wgn <- prepare_wgn(met_lst, TMP_MAX, TMP_MIN, PCP, RELHUM, WNDSPD, MAXHHR, SLR) +#' # Example usage: +#' temp_path <- system.file("extdata", "weather_data.xlsx", package = "SWATprepR") +#' met_lst <- load_template(temp_path, 3035) +#' # Generate WGN data +#' wgn <- prepare_wgn(met_lst, +#' TMP_MAX = met_lst$data$ID10$TMP_MAX, +#' TMP_MIN = met_lst$data$ID10$TMP_MIN, +#' PCP = met_lst$data$ID9$PCP, +#' RELHUM = met_lst$data$ID9$RELHUM, +#' WNDSPD = met_lst$data$ID10$WNDSPD, +#' MAXHHR = met_lst$data$ID11$MAXHHR, +#' SLR = met_lst$data$ID9$SLR) #' } +#' @keywords parameters +#' @seealso \code{\link{load_template}} prepare_wgn <- function(meteo_lst, TMP_MAX = NULL, TMP_MIN = NULL, PCP = NULL, RELHUM = NULL, WNDSPD = NULL, MAXHHR = NULL, SLR = NULL){ ##Extracting relevant parts @@ -367,28 +417,36 @@ prepare_wgn <- function(meteo_lst, TMP_MAX = NULL, TMP_MIN = NULL, PCP = NULL, R return(list(wgn_st = res_wgn_stat, wgn_data = res_wgn_mon)) } -#' Function to prepare or update climate data text input files in SWAT+ model +#' Prepare or Update Climate Data Text Input Files in SWAT+ Model #' -#' @param meteo_lst meteo_lst nested list of lists with dataframes. -#' Nested structure meteo_lst -> data -> Station ID -> Parameter -> Dataframe (DATE, PARAMETER). -#' Nested meteo_lst -> stations Dataframe (ID, Name, Elevation, Source, geometry, Long, Lat). -#' @param write_path character, path to SWAT+ txtinout folder (example "my_model"). -#' @param period_starts character, date string (example '1991-01-01'). Optional (\code{default = NA}, -#' stands for all available in data). -#' @param period_ends character, date string (example '2020-12-31'). Optional (\code{default = NA}, -#' stands for all available in data). +#' This function prepares or updates climate data text input files in a SWAT+ +#' model based on the provided meteo_lst. +#' +#' @param meteo_lst Nested list with dataframes. +#' Nested structure: \code{meteo_lst -> data -> Station ID -> Parameter -> +#' Dataframe (DATE, PARAMETER)}, +#' \code{meteo_lst -> stations -> Dataframe (ID, Name, Elevation, Source, +#' geometry, Long, Lat)}. +#' @param write_path Character, path to the SWAT+ txtinout folder (example "my_model"). +#' @param period_starts (optional) Character, date string (example '1991-01-01'). +#' Default \code{period_starts = NA}, stands for all available in data. +#' @param period_ends (optional) Character, date string (example '2020-12-31'). +#' Default \code{period_ends = NA}, stands for all available in data. #' @importFrom purrr map #' @importFrom dplyr filter %>% mutate select mutate_if mutate_at mutate_all rename full_join contains #' @importFrom sf st_as_sf #' @importFrom lubridate year #' @importFrom utils read.delim -#' @return Fill or update multiple weather related weather text files. +#' @return Fills or updates multiple weather-related text files in the SWAT+ model. #' @export #' #' @examples #' \dontrun{ -#' prepare_climate(meteo_lst, "output", "1991-01-01", "2020-12-31") +#' # Example usage: +#' prepare_climate(meteo_lst, "output", "1991-01-01", "2020-12-31") #' } +#' @seealso \code{\link{load_template}} +#' @keywords writing prepare_climate <- function(meteo_lst, write_path, period_starts = NA, period_ends = NA){ ##Checking input @@ -585,36 +643,54 @@ prepare_climate <- function(meteo_lst, write_path, period_starts = NA, period_en # Preparing soils ----------------------------------------------- -#' Function to prepare user soil table for SWAT model +#' Prepare user soil table for SWAT model +#' +#' This function prepares a user soil table for the SWAT model based on the +#' provided CSV file. #' -#' @param csv_path character path to csv file (example "usersoil_lrew.csv"). File should be comma separated -#' with minimum columns of SNAM, NLAYERS and SOL_Z, CLAY, SILT, SAND, SOL_CBN for each available -#' soil layer (minimum 1). -#' @param hsg Boolean, TRUE - prepare soil hydrological groups, FALSE - no soil hydrological group -#' preparation will be done. Optional (\code{Default = FALSE}). If \code{hsg = TRUE} three additional columns -#' should be in an input table: Impervious (allowed values are "<50cm", "50-100cm", ">100cm"), Depth (allowed -#' values are "<60cm", "60-100cm", ">100cm") and Drained (allowed values are "Y" for drained areas, -#' "N" for areas without working tile drains). More information can be found in the SWAT+ modeling protocol +#' @param csv_path Character path to the CSV file (e.g., "usersoil_lrew.csv"). +#' The file should be comma-separated with minimum columns of SNAM, NLAYERS, +#' SOL_Z, CLAY, SILT, SAND, SOL_CBN +#' for each available soil layer (minimum 1). +#' @param hsg (optional) Logical, TRUE - prepare soil hydrological groups, +#' FALSE - no soil hydrological group preparation will be done. +#' Default \code{ hsg = FALSE}. If \code{hsg = TRUE}, three additional columns +#' should be in an input table: Impervious (allowed values are "<50cm", +#' "50-100cm", ">100cm"), Depth (allowed values are "<60cm", "60-100cm", ">100cm"), +#' and Drained (allowed values are "Y" for drained areas, "N" for areas without +#' working tile drains). More information can be found in the SWAT+ modeling protocol #' \href{https://doi.org/10.5281/zenodo.7463395}{Table 3.3}. -#' @param keep_values Boolean or character vector, TRUE - keep old values (new values only will be left where 0 -#' or NA values are present in an input table), FALSE - keep only new values. Character vector also could be used -#' to keep only specified columns. For instance, c("HYDGRP", "ROCK1") would keep values of soil hydro groups and -#' rock data for the first layer, while c("HYDGRP", "ROCK") would keep values in all rock data columns. -#' Optional (\code{Default = FALSE}). -#' @param nb_lyr integer, number of layers resulting user soil data should contain. Optional (\code{Default = NA}, -#' which stands for the same number as in input data). +#' @param keep_values (optional) Logical or character vector, TRUE - keep old values (new +#' values only will be left where 0 or NA values are present in an input table), +#' FALSE - keep only new values. A character vector can also be used to keep only +#' specified columns. For instance, c("HYDGRP", "ROCK1") would keep values of +#' soil hydro groups and rock data for the first layer, while c("HYDGRP", "ROCK") +#' would keep values in all rock data columns. Default \code{keep_values = FALSE}. +#' @param nb_lyr (optional) Integer, the number of layers resulting user soil +#' data should contain. Default \code{nb_lyr = NA}, which stands for the +#' same number as in the input data. #' @importFrom dplyr select ends_with starts_with left_join #' @importFrom readr parse_number #' @importFrom utils type.convert #' @importFrom methods is -#' @return dataframe with fully formatted and filled table of soil parameters for SWAT model. +#' @return A dataframe with a fully formatted and filled table of soil parameters +#' for the SWAT model. #' @export #' #' @examples #' \dontrun{ -#' usersoils <- get_usersoil_table("table.csv") -#' write.csv(usersoils, "usersoils.csv", row.names=FALSE, quote=FALSE) +#' usersoils <- get_usersoil_table("table.csv") +#' write.csv(usersoils, "usersoils.csv", row.names=FALSE, quote=FALSE) #' } +#' @references +#' SWAT+ Modeling Protocol: Soil Physical Data Chapter +#' +#' This function utilizes the PTF functions and methods described in pages 82-91. +#' For detailed information, refer to: \url{https://doi.org/10.5281/zenodo.7463395} +#' @keywords parameters +#' @seealso +#' This function requires the euptf2 package. +#' Please read more how to install, use and what is in it on \url{https://github.com/tkdweber/euptf2}. get_usersoil_table <- function(csv_path, hsg = FALSE, keep_values = FALSE, nb_lyr = NA){ ##Reading @@ -972,13 +1048,35 @@ get_hsg <- function(d_imp, d_wtr, drn, t){ return(r) } -#' Convert usersoil.csv to soils.sol +#' Convert 'usersoil.csv' to 'soils.sol' +#' +#' This function converts a user-defined soil CSV file to the soils.sol file +#' required for SWAT+ model input. #' -#' @param csv_path character path to csv file (example "usersoil_lrew.csv"") -#' @param db_path character to sqlite project database (example "output/project.sqlite"). -#' Optional, default NULL. Could be used to reduce soils.sol file, if there are less soil -#' types in sqlite database than in usersoil csv file. -#' @importFrom DBI dbConnect dbReadTable +#' @param csv_path Character, path to CSV file containing user-defined soil +#' information (example "usersoil_lrew.csv"). +#' The CSV file should have the following columns: +#' - OBJECTID: Identifier for each record. +#' - MUID: Unique identifier. +#' - SEQN: Sequence number. +#' - SNAM: Soil name. +#' - S5ID: Soil ID. +#' - CMPPCT: Component percentage. +#' - NLAYERS: Number of layers. +#' - HYDGRP: Hydrologic group. +#' - SOL_ZMX: Maximum soil depth. +#' - ANION_EXCL: Anion exclusion. +#' - SOL_CRK: Soil cracking. +#' - TEXTURE: Soil texture. +#' For each available layer (up to 10 layers): +#' - SOL_Z1, SOL_BD1, SOL_AWC1, SOL_K1, SOL_CBN1, CLAY1, SILT1, SAND1, ROCK1, SOL_ALB1, +#' USLE_K1, SOL_EC1, SOL_CAL1, SOL_PH1 (examples of the first layer) +#' @param db_path (optional) Character path to SQLite project database (example +#' "output/project.sqlite"). Default \code{db_path = NULL}, which means SWAT+ model setup +#' .sqlite database will not be used to reduce the size of the soils.sol file by +#' leveraging information from an SQLite database if there are fewer soil types +#' in the database compared to the user's soil CSV file. +#' @importFrom DBI dbConnect dbReadTable dbDisconnect #' @importFrom RSQLite SQLite #' @importFrom dplyr mutate_all %>% #' @importFrom tidyr pivot_wider pivot_longer @@ -986,15 +1084,22 @@ get_hsg <- function(d_imp, d_wtr, drn, t){ #' @importFrom purrr map2_chr #' @importFrom readr write_lines parse_number #' @importFrom utils read.csv2 -#' @return soils.sol SWAT+ model input file +#' @return Soils.sol file for SWAT+ model input. #' @export #' #' @examples #' \dontrun{ +#' # Convert user-defined soil CSV to soils.sol #' usersoil_to_sol("output/usersoil_lrew.csv") -#' ##Or +#' +#' # Convert using an SQLite project database to reduce the size of the soils.sol +#' file #' usersoil_to_sol("output/usersoil_lrew.csv", "output/project.sqlite") #' } +#' +#' @seealso \code{\link{get_usersoil_table}} +#' For details on 'soil.sol' file read [SWAT+ Soils Input](https://swatplus.gitbook.io/io-docs/introduction/soils/soils.sol) +#' @keywords writing usersoil_to_sol <- function(csv_path, db_path = NULL){ ##Reading usersoil table @@ -1066,33 +1171,49 @@ usersoil_to_sol <- function(csv_path, db_path = NULL){ # Updating .sqlite database ----------------------------------------------- -#' Update sqlite database with weather data +#' Update SQLite database with weather data #' -#' @param db_path character to sqlite database (example "./output/project.sqlite") -#' @param meteo_lst meteo_lst nested list of lists with dataframes. -#' Nested structure meteo_lst -> data -> Station ID -> Parameter -> Dataframe (DATE, PARAMETER). -#' Nested meteo_lst -> stations Dataframe (ID, Name, Elevation, Source, geometry, Long, Lat). -#' @param wgn_lst list of two dataframes: wgn_st - wgn station data, wgn_data - wgn data (prepared by \code{prepare_wgn()} function). -#' @param fill_missing Boolean, TRUE - fill data for missing stations with data from closest stations with available data. -#' FALSE - leave stations without data. Weather generator will be used to fill missing variables for a model. Optional (\code{Default = TRUE}). +#' This function updates an SQLite database with weather data, including +#' meteorological and weather generator data. +#' +#' @param db_path A character string representing the path to the SQLite database +#' (e.g., "./output/project.sqlite"). +#' @param meteo_lst A nested list of lists with dataframes. +#' Nested structure: \code{meteo_lst -> data -> Station ID -> Parameter -> +#' Dataframe (DATE, PARAMETER)}, +#' \code{meteo_lst -> stations -> Dataframe (ID, Name, Elevation, Source, +#' geometry, Long, Lat)}. +#' @param wgn_lst A list of two dataframes: wgn_st - weather generator station +#' data, wgn_data - weather generator data (prepared by \code{\link{prepare_wgn}} function). +#' @param fill_missing (optional) Boolean, TRUE - fill data for missing stations with data +#' from closest stations with available data. FALSE - leave stations without +#' data. Weather generator will be used to fill missing variables for a model. +#' Default \code{fill_missing = TRUE}. #' @importFrom sf st_transform st_coordinates st_drop_geometry -#' @importFrom dplyr select full_join mutate %>% rename +#' @importFrom dplyr select full_join mutate %>% rename #' @importFrom DBI dbConnect dbWriteTable dbDisconnect #' @importFrom lubridate yday interval years #' @importFrom RSQLite SQLite #' @importFrom utils write.table -#' @return updated sqlite database with weather data -#' @export +#' @return Updated SQLite database with weather data. +#' #' @examples #' \dontrun{ -#' ##Getting meteo data from template -#' met_lst <- load_template(temp_path, 3035) -#' ##Calculating wgn parameters -#' wgn <- prepare_wgn(met_lst, MAXHHR = met_lst$data$ID11$MAXHHR) -#' ##Writing weather input into model database -#' db_path <- "./output/test/project.sqlite" -#' add_weather(db_path, met_lst, wgn) +#' # Getting meteorological data from template +#' met_lst <- load_template(temp_path, 3035) +#' +#' # Calculating weather generator parameters +#' wgn <- prepare_wgn(met_lst) +#' +#' # Writing weather input into the model database +#' db_path <- "./output/test/project.sqlite" +#' add_weather(db_path, met_lst, wgn) #' } +#' +#' @export +#' @seealso \code{\link{load_template}}, \code{\link{prepare_wgn}}, +#' \code{\link{prepare_climate}} +#' @keywords writing add_weather <- function(db_path, meteo_lst, wgn_lst, fill_missing = TRUE){ ##Path to the folder to write weather files (same as sql db) @@ -1228,25 +1349,32 @@ add_weather <- function(db_path, meteo_lst, wgn_lst, fill_missing = TRUE){ return(print(paste("Weather data was successfuly added to", gsub(".*/","",db_path)))) } -#' Update sqlite database with atmospheric deposition data +#' Update SQLite database with atmospheric deposition data +#' +#' This function updates an SQLite database with atmospheric deposition data. #' -#' @param df dafaframe with "DATE", "NH4_RF", "NO3_RF" , "NH4_DRY" and "NO3_DRY" columns obtained from \code{\link{get_atmo_dep}}) function. -#' @param db_path character to sqlite database (example "./output/project.sqlite") -#' @param t_ext string, 'year' for yearly averages, 'month' - monthly averages -#' and 'annual' for average of all period. Optional (default - "year"). +#' @param df A data frame containing columns "DATE," "NH4_RF," "NO3_RF," +#' "NH4_DRY," and "NO3_DRY" obtained from the \code{\link{get_atmo_dep}} function. +#' @param db_path A character string representing the path to the SQLite +#' database (e.g., "./output/project.sqlite"). +#' @param t_ext (optional) A string indicating the type of time aggregation: 'year' for +#' yearly averages, 'month' for monthly averages, and 'annual' for the average +#' of the entire period. Default default \code{t_ext = "year"}. #' @importFrom DBI dbConnect dbWriteTable dbDisconnect dbReadTable #' @importFrom RSQLite SQLite #' @importFrom utils write.table -#' @return write data in 'atmodep.cli' file and updated sqlite database with codes and connection -#' to atmospheric deposition data +#' @return Writes data to 'atmodep.cli' file and updates the SQLite database +#' with codes and connections to atmospheric deposition data. #' @export #' @examples #' \dontrun{ -#' basin_path <- system.file("extdata", "GIS/basin.shp", package = "SWATprepR") -#' df <- get_atmo_dep(basin_path) -#' db_path <- "./output/test/project.sqlite" -#' add_atmo_dep(df, db_path) +#' basin_path <- system.file("extdata", "GIS/basin.shp", package = "SWATprepR") +#' df <- get_atmo_dep(basin_path) +#' db_path <- "./output/test/project.sqlite" +#' add_atmo_dep(df, db_path) #' } +#' @seealso \code{\link{get_atmo_dep}} +#' @keywords writing add_atmo_dep <- function(df, db_path, t_ext = "year"){ ##Path to the folder to write weather files (same as sql db) @@ -1310,35 +1438,49 @@ add_atmo_dep <- function(df, db_path, t_ext = "year"){ # Land use and management ----------------------------------------------- -#' Preparing training points for remote sensing algorithm +#' Prepare training points for remote sensing algorithm #' -#' @param df sf data.frame with land use. "type" column should be present. -#' @param year numeric value, year of land use. -#' @param lookup dataframe with "lc1" column for numeric codes and "type" column -#' for text. -#' @param lu_constant vector of strings with land uses to be kept constant in -#' land use (i.e. water, urban areas, etc.) -#' @param nb_pts numeric, number of points per land use/crop class. Optional, default 100. -#' @param col_name string with name of column to be used representing type of crops/land use. -#' Optional, default "type". +#' This function prepares training points for a remote sensing algorithm based on +#' land use and crop classes. +#' +#' @param df An sf data.frame with land use. The "type" column should be present. +#' @param year A numeric value representing the year of land use. +#' @param lookup A dataframe with a "lc1" column for numeric codes and a "type" +#' column for text. +#' @param lu_constant (optional) A vector of strings with land uses to be kept constant in +#' land use (e.g., water, urban areas, etc.). Default \code{lu_constant = c()}. +#' @param nb_pts (optional) A numeric value representing the number of points per land use/crop +#' class. Default \code{nb_pts = 100}. +#' @param col_name A string with the name of the column to be used representing +#' the type of crops/land use. Default \code{col_name = "type"}. #' @importFrom sf st_as_sf st_join st_transform st_sample #' @importFrom dplyr rename mutate left_join select filter sample_n ungroup -#' @return sf data.frame with point input for remote sensing training algorithm. +#' @return An sf data.frame with point input for a remote sensing training algorithm. #' @export #' @examples #' \dontrun{ -#' library(sf) -#' ##Loading land use/crop layer -#' lu_path <- system.file("extdata", "GIS/lu_layer.shp", package = "SWATprepR") -#' lu <- st_read(lu_path, quiet = TRUE) -#' ##Preparing lookup table -#' lookup <- data.frame(lc1 = seq(1:length(unique(c(lu$type)))), -#' type = unique(c(lu$type))) -#' lu_constant <- c("fesc", "orch", "frst", "frse", "frsd", "urld", "urhd", -#' "wetl", "past", "watr", "agrl") -#' ##Getting training points -#' pts <- get_lu_points(lu, 2021, lookup, lu_constant) +#' library(sf) +#' +#' # Loading land use/crop layer +#' lu_path <- system.file("extdata", "GIS/lu_layer.shp", package = "SWATprepR") +#' lu <- st_read(lu_path, quiet = TRUE) +#' +#' # Preparing lookup table +#' lookup <- data.frame(lc1 = seq(1:length(unique(c(lu$type)))), +#' type = unique(c(lu$type))) +#' +#' # Setting land uses to be kept constant +#' lu_constant <- c("fesc", "orch", "frst", "frse", "frsd", "urld", "urhd", +#' "wetl", "past", "watr", "agrl") +#' +#' # Getting training points +#' pts <- get_lu_points(lu, 2021, lookup, lu_constant) #' } +#' @references +#' Mészáros, J., & Szabó, B. (2022). Script to derive and apply crop +#' classification based on Sentinel 1 satellite radar images in Google Earth +#' Engine platform. \url{https://doi.org/10.5281/zenodo.6700122} +#' @keywords remote-sensing get_lu_points <- function(df, year, lookup, lu_constant = c(), nb_pts = 100, col_name = "type"){ df <- df[col_name] %>% @@ -1359,35 +1501,47 @@ get_lu_points <- function(df, year, lookup, lu_constant = c(), nb_pts = 100, co #' Extract rotation information from raster file #' -#' @param df sf data.frame with land use. "id" and "type" columns should be present. -#' @param start_year numeric, representing a year from which data begins. -#' @param tif_name string for name of .tif raster file. -#' @param r_path string for path to .tif file. -#' @param lookup dataframe with "lc1" column for numeric codes and "type" column -#' for text. -#' @param lu_constant vector of strings with land uses to be kept constant in -#' land use (i.e. water, urban areas, etc.) +#' This function extracts crop rotation information from a raster file and +#' amends the land use data accordingly. +#' +#' @param df An sf data.frame with land use. Columns "id" and "type" should be +#' present. +#' @param start_year A numeric value representing the year from which data begins. +#' @param tif_name A string for the name of the .tif raster file. +#' @param r_path A string for the path to the .tif file. +#' @param lookup A dataframe with a "lc1" column for numeric codes and a "type" +#' column for text. +#' @param lu_constant (optional) A vector of strings with land uses to be kept constant in +#' land use (e.g., water, urban areas). Default \code{lu_constant = c()}. #' @importFrom raster raster nbands extract #' @importFrom dplyr left_join mutate_at all_of mutate select vars starts_with #' @importFrom sf st_point_on_surface st_transform st_drop_geometry st_crs -#' @return sf data.frame with land use amended with crop rotation information +#' @return An sf data.frame with land use amended with crop rotation information. #' @export #' @examples #' \dontrun{ -#' library(sf) -#' ##Loading land use/crop layer -#' lu_path <- system.file("extdata", "GIS/lu_layer.shp", package = "SWATprepR") -#' lu <- st_read(lu_path, quiet = TRUE) %>% mutate(id = row_number()) -#' ##Preparing lookup table -#' lookup <- data.frame(lc1 = seq(1:length(unique(c(lu$type)))), -#' type = unique(c(lu$type))) -#' lu_constant <- c("fesc", "orch", "frst", "frse", "frsd", "urld", "urhd", -#' "wetl", "past", "watr", "agrl") +#' library(sf) +#' +#' # Loading land use/crop layer +#' lu_path <- system.file("extdata", "GIS/lu_layer.shp", package = "SWATprepR") +#' lu <- st_read(lu_path, quiet = TRUE) %>% mutate(id = row_number()) +#' +#' # Preparing lookup table +#' lookup <- data.frame(lc1 = seq(1:length(unique(c(lu$type)))), +#' type = unique(c(lu$type))) +#' lu_constant <- c("fesc", "orch", "frst", "frse", "frsd", "urld", "urhd", +#' "wetl", "past", "watr", "agrl") #' -#' ##Extracting rotation information from raster -#' ##Raster information should have been prepared with remote sensing -#' lu_rot <- extract_rotation(lu, 2015, "cropmaps.tif", "./output/", lookup, lu_constant) +#' # Extracting rotation information from raster +#' # Raster information should have been prepared with remote sensing +#' lu_rot <- extract_rotation(lu, 2015, "cropmaps.tif", "./output/", lookup, +#' lu_constant) #' } +#' @references +#' Mészáros, J., & Szabó, B. (2022). Script to derive and apply crop +#' classification based on Sentinel 1 satellite radar images in Google Earth +#' Engine platform. \url{https://doi.org/10.5281/zenodo.6700122} +#' @keywords remote-sensing extract_rotation <- function(df, start_year, tif_name, r_path, lookup, lu_constant = c()){ r <- raster(paste0(r_path, tif_name), band = 1) @@ -1421,33 +1575,45 @@ extract_rotation <- function(df, start_year, tif_name, r_path, lookup, lu_consta # Point source data ----------------------------------------------- -#' Prepare point source data model text files. -#' -#' The function could be used to prepare the simple cases of point source data input -#' with yearly values, where point sources are discharging to a single channels. +#' Prepare Point Source Data Model Text Files #' -#' @param pt_lst nested list of lists with dataframes. -#' Nested structure pt_lst -> data -> Dataframe (name, DATE, flo, ...) -#' pt_lst -> st -> Dataframe (name, Lat, Long) -#' @param project_path character, path to SWAT+ txtinout folder (example "my_model"). -#' @param write_path character, path to SWAT+ txtinout folder (example "my_model"). Optional (\code{default = project_path}. -#' @param cha_shape_path character, path to SWAT+ channel shapefile. 'id' column should be present in attributes with -#' numeric values representing channel ids, the same as in 'chandeg.con' file. Optional (\code{default = FALSE}. +#' This function prepares text files for a SWAT+ model to represent point source +#' data. It is designed for simple cases with yearly values, +#' where point sources discharge to a single channel. +#' +#' @param pt_lst Nested list with dataframes. +#' Nested structure: \code{pt_lst -> data -> Dataframe (name, DATE, flo, ...)}, +#' \code{pt_lst -> st -> Dataframe (name, Lat, Long)}. +#' Additional information on the input variables, which could be used in the template +#' files can be found in the SWAT+ documentation: ['filename'.rec](https://swatplus.gitbook.io/io-docs/introduction/point-sources-and-inlets/filename.rec) +#' @param project_path Character, path to the SWAT+ project folder (example "my_model"). +#' @param write_path (optional) Character, path to SWAT+ txtinout folder (example "my_model"). +#' Default \code{write_path = NULL}, which is the same as \code{project_path}. +#' @param cha_shape_path (optional) Character, path to SWAT+ channel shapefile. +#' 'id' column should be present in attributes with numeric values representing channel ids, +#' the same as in 'chandeg.con' file. Default \code{cha_shape_path = FALSE}, +#' which assigns point sources to the will be assigned based on nearest center +#' point in 'chandeg.con' #' @importFrom sf st_as_sf st_nearest_feature st_crs st_drop_geometry st_transform read_sf #' @importFrom lubridate year #' @importFrom dplyr select left_join #' -#' @return text files for SWAT+ model in write_path +#' @return Text files for SWAT+ model in write_path. #' @export #' #' @examples #' \dontrun{ -#' temp_path <- system.file("extdata", "pnt_data.xls", package = "SWATprepR") -#' pnt_data <- load_template(temp_path) -#' prepare_pt_source(pnt_data, "txtinout") +#' # Example usage: +#' temp_path <- system.file("extdata", "pnt_data.xls", package = "SWATprepR") +#' pnt_data <- load_template(temp_path) +#' prepare_pt_source(pnt_data, "my_model") #' } +#' @keywords writing -prepare_ps <- function(pt_lst, project_path, write_path = project_path, cha_shape_path = FALSE){ +prepare_ps <- function(pt_lst, project_path, write_path = NULL, cha_shape_path = FALSE){ + if(is.null(write_path)){ + write_path <- project_path + } if(project_path == write_path){ print(paste0("Files in ", project_path, " will be overwritten!!!")) } diff --git a/README.Rmd b/README.Rmd index a6fe99f..aac76ad 100644 --- a/README.Rmd +++ b/README.Rmd @@ -70,7 +70,7 @@ In order to use *SWATprepR* package functions with your data you should prepare - **calibration_data.xlsx** - template for loading calibration (water flow and water quality variables) data. - **weather_data.xlsx** - template for loading weather variables. - **usersoils.csv** - example of loading soil parameters dataset. -- **pnt_data.xlsx** - example of point source dataset. +- **pnt_data.xlsx** - template of point source dataset. - **GIS/** - folder with GIS layers needed to run some functions. Data prepared according to templates can be directly loaded into R and all the functions applied as described. diff --git a/README.md b/README.md index b19a445..7547eea 100644 --- a/README.md +++ b/README.md @@ -3,7 +3,7 @@ Introduction to SWATprepR # SWATprepR -[![](https://img.shields.io/badge/devel%20version-0.1.6-gold.svg)](https://github.com/biopsichas/SWATprepR) +[![](https://img.shields.io/badge/devel%20version-1.0.0-gold.svg)](https://github.com/biopsichas/SWATprepR) [![](https://img.shields.io/github/last-commit/biopsichas/SWATprepR.svg)](https://github.com/biopsichas/SWATprepR/commits/green) [![](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) [![Project Status: Active - The project has reached a stable, usable @@ -63,6 +63,12 @@ lines below. Please run it on your system to find it for you. ``` r library(SWATprepR) +#> Loading required package: euptf2 +#> Loading required package: plyr +#> Loading required package: stringr +#> Loading required package: data.table +#> Warning: package 'data.table' was built under R version 4.2.3 +#> Loading required package: ranger temp_path <- system.file("extdata", package = "SWATprepR") print(temp_path) #> [1] "C:/Users/laptop/AppData/Local/R/win-library/4.2/SWATprepR/extdata" @@ -78,7 +84,7 @@ prepare your data to be inline with templates we have provided in flow and water quality variables) data. - **weather_data.xlsx** - template for loading weather variables. - **usersoils.csv** - example of loading soil parameters dataset. -- **pnt_data.xlsx** - example of point source dataset. +- **pnt_data.xlsx** - template of point source dataset. - **GIS/** - folder with GIS layers needed to run some functions. Data prepared according to templates can be directly loaded into R and diff --git a/docs/404.html b/docs/404.html index bfa351b..3bd1a9d 100644 --- a/docs/404.html +++ b/docs/404.html @@ -31,7 +31,7 @@ SWATprepR - 0.1.6 + 1.0.0