├── man ├── .Rapp.history ├── write_log.Rd ├── add_dates.Rd ├── read_output_filter.Rd ├── IOin_output_vars.Rd ├── separate_canopy_output.Rd ├── check_params.Rd ├── change_def_file.Rd ├── get_waterYearDay.Rd ├── IOin_tec_std.Rd ├── patch_fam_agg.Rd ├── RHESSysIOinR.Rd ├── watbal_basin.Rd ├── write_run_info.Rd ├── IOin_def_pars_sobol.Rd ├── IOin_output_filters.Rd ├── watbal_basin_of.Rd ├── read_clim.Rd ├── write_output_filter.Rd ├── select_output_variables.Rd ├── compile_rhessys.Rd ├── IOin_def_pars_latin_hypercube.Rd ├── select_output_variables_w_awk.Rd ├── cleanup_rhessys.Rd ├── build_redefine.Rd ├── IOin_def_pars_simple.Rd ├── insert_in_worldfile.Rd ├── tec_repeat.Rd ├── IOin_hdr.Rd ├── make_hdr_file.Rd ├── build_output_filter.Rd ├── modify_output_filter.Rd ├── output_control.Rd ├── readin_rhessys_output_cal.Rd ├── IOin_clim.Rd ├── write_sample_clim.Rd ├── select_output_variables_R.Rd ├── IOin_rhessys_input.Rd ├── readin_rhessys_output.Rd ├── rhessys_command.Rd ├── watbal_patch_mult.Rd ├── watbal_patch.Rd ├── IOin_cmd_pars.Rd ├── run_rhessys_multi.Rd ├── run_rhessys_single.Rd └── IOin_tec_all_options.Rd ├── vignettes ├── .gitignore └── RHESSysIOinR_utilities_examples.Rmd ├── inst └── extdata │ ├── out │ └── placeholder.txt │ ├── defs │ ├── basin.def │ ├── hill.def │ ├── lu_undev.def │ ├── zone.def │ ├── soil_sandyloam.def │ └── veg_douglasfir.def │ ├── tecfiles │ ├── tec.test │ ├── w8TC.tec │ └── test_output_filter.yml │ ├── worldfiles │ ├── w8TC.hdr │ └── w8TC │ │ └── w8TC.hdr │ └── clim │ └── w8_base ├── .Rbuildignore ├── R ├── .gitignore ├── utils.R ├── IOin_output_vars.R ├── separate_canopy_output.R ├── RHESSysIOinR.R ├── add_dates.R ├── IOin_output_filters.R ├── get_waterYearDay.R ├── watbal_basin.R ├── write_log.R ├── select_output_variables_w_awk.R ├── patch_fam_agg.R ├── generateTargets.R ├── IOin_tec_std.R ├── select_output_variables.R ├── IOin_hdr.R ├── read_output_filter.R ├── modify_output_filter.R ├── watbal_basin_of.R ├── cleanup_rhessys.R ├── watbal_patch_mult.R ├── IOin_def_pars_sobol.R ├── output_control.R ├── IOin_def_pars_latin_hypercube.R ├── build_output_filter.R ├── IOin_clim.R ├── make_hdr_file.R ├── insert_in_worldfile.R ├── change_def_file.R ├── tec_repeat.R ├── readin_rhessys_output_cal.R ├── watbal_patch.R ├── IOin_cmd_pars.R ├── write_output_filter.R ├── write_run_info.R ├── compile_rhessys.R ├── rhessys_command.R ├── IOin_rhessys_input.R ├── write_sample_clim.R ├── IOin_def_pars_simple.R ├── check_params.R ├── read_clim.R └── build_redefine.R ├── tests ├── testthat.R └── testthat │ └── test-single_run.R ├── p301h2_filter.yml ├── p301h2_filter_OLD.yml ├── deprecated_functions ├── mkdate.R ├── select_evaluation_criteria.R ├── make_tec_file.R ├── make_dated_seq.R ├── cal.wyd.R ├── rhessys_setup.R ├── evaluation.R ├── make_hdr_file.R ├── make_clim_base_file.R ├── process_input_preexisting_table.R └── make_option_set_combinations.R ├── RHESSysIOinR.Rproj ├── DESCRIPTION ├── .gitignore ├── NAMESPACE ├── README.md └── README.Rmd /man/.Rapp.history: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /inst/extdata/out/placeholder.txt: -------------------------------------------------------------------------------- 1 | keep this dir -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | -------------------------------------------------------------------------------- /inst/extdata/defs/basin.def: -------------------------------------------------------------------------------- 1 | 1.000000 basin_default_ID 2 | -------------------------------------------------------------------------------- /R/.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | misc_code.R 5 | *.swp 6 | -------------------------------------------------------------------------------- /inst/extdata/defs/hill.def: -------------------------------------------------------------------------------- 1 | 1.000000 hillslope_default_ID 2 | 0.0 gw_loss_coeff 3 | -------------------------------------------------------------------------------- /inst/extdata/tecfiles/tec.test: -------------------------------------------------------------------------------- 1 | 1989 10 1 1 print_daily_on 2 | 1989 10 1 2 print_daily_growth_on 3 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(RHESSysIOinR) 3 | 4 | test_check("RHESSysIOinR") 5 | -------------------------------------------------------------------------------- /inst/extdata/tecfiles/w8TC.tec: -------------------------------------------------------------------------------- 1 | 1998 10 1 1 print_daily_on 2 | 1998 10 1 2 print_daily_growth_on 3 | 2000 10 0 1 output_current_state 4 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | # file to contain small utility functions that don't need to be exposed to users (not exported) 2 | # 3 | # ---------- Function to test if filter is valid ---------- 4 | valid_filter = function(f) { 5 | 6 | return(TRUE) 7 | 8 | } 9 | -------------------------------------------------------------------------------- /inst/extdata/defs/lu_undev.def: -------------------------------------------------------------------------------- 1 | 1.000000 landuse_default_ID 2 | 0.000000 irrigation 3 | 0.000000 fertilizer_NO3 4 | 0.000000 fertilizer_NH4 5 | 0.000000 septic_NO3_load 6 | 0.000000 septic_water_load 7 | 0.000000 detention_store_size 8 | -------------------------------------------------------------------------------- /inst/extdata/tecfiles/test_output_filter.yml: -------------------------------------------------------------------------------- 1 | filter: 2 | timestep: daily 3 | output: 4 | format: csv 5 | path: ./out 6 | filename: basin_daily 7 | basin: 8 | ids: 1 9 | variables: patch.total_water_in, patch.streamflow 10 | -------------------------------------------------------------------------------- /inst/extdata/worldfiles/w8TC.hdr: -------------------------------------------------------------------------------- 1 | 2 | 1 3 | defs/basin.def 4 | 1 5 | defs/hill.def 6 | 1 7 | defs/zone.def zone_default_filename 8 | 1 9 | defs/soil_sandyloam.def 10 | 1 11 | defs/lu_undev.def 12 | 1 13 | defs/veg_douglasfir.def veg_default_filename 14 | 1 15 | clim/w8_base 16 | -------------------------------------------------------------------------------- /p301h2_filter.yml: -------------------------------------------------------------------------------- 1 | filter: 2 | timestep: daily 3 | output: 4 | format: csv 5 | path: ./output/ 6 | filename: p301_h2_std 7 | basin: 8 | ids: 1 9 | variables: patch.evaporation, patch.transpiration_sat_zone, patch.transpiration_unsat_zone, patch.rz_storage, patch.rz_transfer, patch.totalc, stratum.cs.net_psn, patch.Qout, patch.streamflow 10 | -------------------------------------------------------------------------------- /p301h2_filter_OLD.yml: -------------------------------------------------------------------------------- 1 | filter: 2 | timestep: daily 3 | output: 4 | format: csv 5 | path: ./output/ 6 | filename: p301_h2_std 7 | basin: 8 | ids: 1 9 | variables: patch.evaporation, patch.transpiration_sat_zone, patch.transpiration_unsat_zone, 10 | patch.rz_storage, patch.rz_transfer, patch.totalc, stratum.cs.net_psn, patch.Qout, 11 | patch.streamflow 12 | -------------------------------------------------------------------------------- /man/write_log.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/write_log.R 3 | \name{write_log} 4 | \alias{write_log} 5 | \title{write_log} 6 | \usage{ 7 | write_log( 8 | input_rhessys, 9 | output_filter, 10 | return_cmd, 11 | run_ct, 12 | log_loc = "~/rhessys_run_log.csv" 13 | ) 14 | } 15 | \description{ 16 | write or append to a log file, by row 17 | } 18 | -------------------------------------------------------------------------------- /deprecated_functions/mkdate.R: -------------------------------------------------------------------------------- 1 | #' Date code used in RHESSys 2 | #' 3 | #' Description... 4 | #' 5 | #' @param x RHESSys output in data.frame/data.table form 6 | #' 7 | #' @export 8 | mkdate = function (x) 9 | { 10 | x$date = as.Date(paste(x$year, x$month, x$day, sep = "-")) 11 | x$wy = ifelse(x$month >= 10, x$year + 1, x$year) 12 | x$yd = as.integer(format(as.Date(x$date), format = "%j")) 13 | x$wyd = cal.wyd(x) 14 | x 15 | } 16 | -------------------------------------------------------------------------------- /man/add_dates.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add_dates.R 3 | \name{add_dates} 4 | \alias{add_dates} 5 | \title{add_dates} 6 | \usage{ 7 | add_dates(DF) 8 | } 9 | \arguments{ 10 | \item{DF}{input Data Frame or Data Table} 11 | } 12 | \description{ 13 | Add dates, day of year, water year, water year day to RHESSys output (as appropriate for time step) 14 | } 15 | \author{ 16 | Will Burke 17 | } 18 | -------------------------------------------------------------------------------- /inst/extdata/defs/zone.def: -------------------------------------------------------------------------------- 1 | 2 | 1.000000 zone_default_ID 3 | 0.000029 atm_trans_lapse_rate 4 | 0.001500 dewpoint_lapse_rate 5 | 10.000000 max_effective_lai 6 | 0.006400 lapse_rate 7 | 0.025400 pptmin 8 | 0.750000 sea_level_clear_sky_trans 9 | 0.400000 temcf 10 | 0.003000 trans_coeff1 11 | 2.200000 trans_coeff2 12 | 1.000000 wind 13 | 1.000000 max_snow_temp 14 | 0.000000 min_rain_temp 15 | 0.031600 n_deposition 16 | 180.000000 wind_direction 17 | -0.005053 lapse_rate_precip_default -------------------------------------------------------------------------------- /man/read_output_filter.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read_output_filter.R 3 | \name{read_output_filter} 4 | \alias{read_output_filter} 5 | \title{read_output_filter} 6 | \usage{ 7 | read_output_filter(filter_in) 8 | } 9 | \arguments{ 10 | \item{filter_in}{Path to the yaml filter file} 11 | } 12 | \description{ 13 | Reads a yaml format RHESSys output filter and creates a R list. Handles tabs in input file, 14 | } 15 | \author{ 16 | Will Burke 17 | } 18 | -------------------------------------------------------------------------------- /RHESSysIOinR.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace,vignette 22 | -------------------------------------------------------------------------------- /deprecated_functions/select_evaluation_criteria.R: -------------------------------------------------------------------------------- 1 | #' Select approach to evaluate objective function output 2 | #' 3 | #' Description... 4 | #' 5 | #' 6 | #' @export 7 | select_parameter_sets <- function(obj_function_all, obj_function_selection, method, num_ps=1, ...){ 8 | 9 | if (method == "single_objective_function"){ 10 | o <- order(obj_func) 11 | top_ps <- obj_func[o<=num_ps] 12 | 13 | } 14 | 15 | 16 | if (method == composite){ 17 | 18 | } 19 | 20 | if (method == pareto){ 21 | 22 | } 23 | 24 | return(top_ps) 25 | } 26 | -------------------------------------------------------------------------------- /inst/extdata/clim/w8_base: -------------------------------------------------------------------------------- 1 | 101 base_station_id 2 | 100 x_coordinate 3 | 100 y_coordinate 4 | 975 z_coordinate 5 | 3.5 effective_lai 6 | 160 screen_height 7 | annual annual_climate_prefix 8 | 0 number_non_critical_annual_sequences 9 | monthly monthly_climate_prefix 10 | 0 number_non_critical_monthly_sequences 11 | clim/w8_daily daily_climate_prefix 12 | 0 number_non_critical_daily_sequences 13 | hourly hourly_climate_prefix 14 | 0 number_non_critical_hourly_sequences 15 | -------------------------------------------------------------------------------- /inst/extdata/worldfiles/w8TC/w8TC.hdr: -------------------------------------------------------------------------------- 1 | 1 num_basin_default_files 2 | defs/basin.def basin_default_file 3 | 1 num_hillslope_default_files 4 | defs/hill.def hillslope_default_file 5 | 1 num_zone_default_files 6 | defs/zone.def zone_default_file 7 | 1 num_soil_default_files 8 | defs/soil_sandyloam.def soil_default_file 9 | 1 num_landuse_default_files 10 | defs/lu_undev.def landuse_default_file 11 | 1 num_stratum_default_files 12 | defs/veg_douglasfir.def stratum_default_file 13 | 1 num_base_stations_files 14 | clim/w8_base base_stations_file 15 | -------------------------------------------------------------------------------- /deprecated_functions/make_tec_file.R: -------------------------------------------------------------------------------- 1 | #' Make Tec File from R 2 | #' 3 | #' Description... 4 | #' 5 | #' @param tec_file Name and directory of tec file to be created 6 | #' @param tec_data Data frame containing the data needed for the tec file. Data 7 | #' frame columns include 'year', 'month', 'day', 'hour' and the name of tec 8 | #' command (e.g. "print_daily_on"). 9 | #' 10 | #' @export 11 | make_tec_file <- function(tec_file, tec_data){ 12 | 13 | # Add some data checks here 14 | 15 | write.table(tec_data, file = tec_file, col.names = FALSE, row.names=FALSE, quote = FALSE) 16 | } 17 | -------------------------------------------------------------------------------- /man/IOin_output_vars.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/IOin_output_vars.R 3 | \name{IOin_output_vars} 4 | \alias{IOin_output_vars} 5 | \title{IOin_output_vars} 6 | \usage{ 7 | IOin_output_vars(...) 8 | } 9 | \arguments{ 10 | \item{...}{Any number of two element character vectors or dataframes, each specifying the output file using "pd", "pdg", "cd", "cdg" 11 | style format in the first item/column and the variable of interest in the second item/column.} 12 | } 13 | \description{ 14 | IOin_output_vars 15 | } 16 | \author{ 17 | Will Burke 18 | } 19 | -------------------------------------------------------------------------------- /deprecated_functions/make_dated_seq.R: -------------------------------------------------------------------------------- 1 | #' Make Dated Sequence File from R 2 | #' 3 | #' Description... 4 | #' 5 | #' @param input_dated_seq Data frame ... 6 | #' @param dated_seq_file File ... 7 | #' 8 | #' @export 9 | make_dated_seq <- function(input_dated_seq, dated_seq_file){ 10 | 11 | # Add some data checks here 12 | 13 | dated_seq_l <- length(input_dated_seq$year) 14 | dated_seq_final = dplyr::bind_rows(c(year=dated_seq_l, month=NA, day=NA, hour=NA, value=NA),input_dated_seq) 15 | write.table(dated_seq_final, file = dated_seq_file, na="", col.names = FALSE, row.names=FALSE, quote = FALSE) 16 | 17 | } 18 | 19 | 20 | -------------------------------------------------------------------------------- /man/separate_canopy_output.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/separate_canopy_output.R 3 | \name{separate_canopy_output} 4 | \alias{separate_canopy_output} 5 | \title{Separate Canopy Output by Layers} 6 | \usage{ 7 | separate_canopy_output(data, num_canopies = 2) 8 | } 9 | \arguments{ 10 | \item{data}{Data frame with variables that need to be separated.} 11 | 12 | \item{num_canopies}{Number of canopy (stratum) per patch} 13 | } 14 | \description{ 15 | Function separates RHESSys canopy output by canopy and outputs a data frame that 16 | may be analyzed via \code{ggplot}. 17 | } 18 | -------------------------------------------------------------------------------- /deprecated_functions/cal.wyd.R: -------------------------------------------------------------------------------- 1 | #' Code used to calculate wateryear day in RHESSys 2 | #' 3 | #' Description... 4 | #' 5 | #' @param x ??? 6 | #' 7 | #' @export 8 | cal.wyd = function (x) { 9 | tmp = aggregate(x$yd, by = list(x$year), max) 10 | colnames(tmp) = c("year", "n") 11 | tmp$year = as.integer(as.character(tmp$year)) 12 | x$wyd = 0 13 | tmp2 = subset(tmp, tmp$n == 365) 14 | new = ifelse((x$year %in% tmp2$year), ifelse(x$yd >= 274, 15 | x$yd - 273, x$yd + 92), ifelse(x$yd >= 275, x$yd - 274, 16 | x$yd + 92)) 17 | new 18 | } 19 | -------------------------------------------------------------------------------- /man/check_params.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check_params.R 3 | \name{check_params} 4 | \alias{check_params} 5 | \title{check_params} 6 | \usage{ 7 | check_params(rh_file, def_file) 8 | } 9 | \arguments{ 10 | \item{rh_file}{Path to the appropriate construct file in the RHESSys source code, e.g. construct_stratum_defaults.c} 11 | 12 | \item{def_file}{Path to a appropriate parameter definition file to be compared to the RHESSys defaults} 13 | } 14 | \description{ 15 | Function to check if parameters are valid and compare them to default parameters from a version of RHESSys 16 | } 17 | \author{ 18 | Will Burke 19 | } 20 | -------------------------------------------------------------------------------- /man/change_def_file.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/change_def_file.R 3 | \name{change_def_file} 4 | \alias{change_def_file} 5 | \title{Replaces parameters in a def file} 6 | \usage{ 7 | change_def_file(def_file, par_sets, file_name_ext = NULL) 8 | } 9 | \arguments{ 10 | \item{def_file}{Path and name of def file} 11 | 12 | \item{par_sets}{Data frame with parameter names as colnames and a single row of parameter values} 13 | 14 | \item{file_name_ext}{Optional extension to add to file name} 15 | } 16 | \description{ 17 | This function reads a def file, replaces the values of selected parameters, and writes a new def file. 18 | } 19 | -------------------------------------------------------------------------------- /man/get_waterYearDay.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_waterYearDay.R 3 | \name{get_waterYearDay} 4 | \alias{get_waterYearDay} 5 | \title{Day of water year} 6 | \source{ 7 | https://rdrr.io/github/USGS-R/EflowStats/src/R/get_waterYearDay.R 8 | x <- seq(from=as.Date("2010-01-01"),to=as.Date("2016-01-01"),by="1 days") 9 | get_waterYearDay(x) 10 | } 11 | \usage{ 12 | get_waterYearDay(x) 13 | } 14 | \arguments{ 15 | \item{x}{A vector of class date.} 16 | } 17 | \value{ 18 | A numeric vector of day of water year 19 | } 20 | \description{ 21 | Given a vector of dates, calculates day of water year accounting for leap years. 22 | } 23 | -------------------------------------------------------------------------------- /man/IOin_tec_std.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/IOin_tec_std.R 3 | \name{IOin_tec_std} 4 | \alias{IOin_tec_std} 5 | \title{IOin_tec_std} 6 | \usage{ 7 | IOin_tec_std(start, end, output_state = TRUE) 8 | } 9 | \arguments{ 10 | \item{start}{start date of run} 11 | 12 | \item{end}{End date of run - the last entire day to be run} 13 | 14 | \item{output_state}{TRUE/FALSE if an output_current_state tec event should be scheduled at the end of the simulation} 15 | } 16 | \description{ 17 | Input function to construct a dataframe of standard tec events, including start, grow start, and output state 18 | } 19 | \author{ 20 | Will Burke 21 | } 22 | -------------------------------------------------------------------------------- /deprecated_functions/rhessys_setup.R: -------------------------------------------------------------------------------- 1 | #' Functions for producing RHESSys folders 2 | #' 3 | #' Description. Note that many RHESSys files are produced via GRASS 4 | 5 | 6 | #' @export 7 | make_rhessys_folders <- function(extra_folders=NA){ 8 | # Code currently only works with one extra folder input 9 | 10 | tmp <- sprintf("mkdir analysis; mkdir auxdata; mkdir awks; mkdir clim; mkdir defs; 11 | mkdir flowtables; mkdir out; mkdir R; mkdir tecfiles; mkdir worldfiles") 12 | system(tmp) 13 | 14 | if (is.na(extra_folders) == F){ 15 | tmp1 <- function(x){paste("mkdir ", x, sep="")} 16 | tmp2 <- as.vector(sapply(extra_folders, tmp1)) 17 | system(tmp2) 18 | } 19 | } 20 | 21 | 22 | 23 | 24 | 25 | 26 | -------------------------------------------------------------------------------- /man/patch_fam_agg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patch_fam_agg.R 3 | \name{patch_fam_agg} 4 | \alias{patch_fam_agg} 5 | \title{patch_fam_agg} 6 | \usage{ 7 | patch_fam_agg(X, areas = NULL, na.rm = FALSE) 8 | } 9 | \arguments{ 10 | \item{X}{Data Frame or Data Table to aggregate} 11 | 12 | \item{areas}{Data frame (or table) of patch IDs and associated areas. 13 | Needed for stratum outputs which don't include area.} 14 | 15 | \item{na.rm}{Should NAs ne removed when calculating weighed average (passed through to weighted.mean)} 16 | } 17 | \description{ 18 | Aggregate (aspatial) patches back to spatial patches via weighted mean. 19 | Add in exceptions if you want to aggregate via different methods. 20 | } 21 | -------------------------------------------------------------------------------- /inst/extdata/defs/soil_sandyloam.def: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 3.000000 patch_default_ID 5 | 2.000000 theta_psi_curve 6 | 3.000000 Ksat_0 7 | 0.120000 m 8 | 0.454380 porosity_0 9 | 4000.000000 porosity_decay 10 | 0.000000 P3 11 | 0.195750 pore_size_index 12 | 0.798750 psi_air_entry 13 | 0.010000 psi_max 14 | 200.000000 soil_depth 15 | 0.400000 m_z 16 | 0.000000 detention_store_size 17 | 1.000000 deltaZ 18 | 10.000000 active_zone_z 19 | -10.000000 maximum_snow_energy_deficit 20 | 0.000000 snow_water_capacity 21 | 10000.000000 snow_light_ext_coef 22 | 0.050000 snow_melt_Tcoef 23 | 0.000000 max_heat_capacity 24 | 0.000000 min_heat_capacity 25 | 0.280000 albedo 26 | 0.000000 NO3_adsorption_rate 27 | 0.120000 N_decay 28 | 0.700000 sand 29 | 0.100000 clay 30 | 0.200000 silt 31 | 0.0 sat_to_gw_coeff 32 | 0.5 nitrif_parm_smax -------------------------------------------------------------------------------- /man/RHESSysIOinR.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RHESSysIOinR.R 3 | \docType{package} 4 | \name{RHESSysIOinR} 5 | \alias{-package} 6 | \alias{RHESSysIOinR} 7 | \alias{.datatable.aware} 8 | \title{RHESSysIOinR} 9 | \format{ 10 | An object of class \code{logical} of length 1. 11 | } 12 | \usage{ 13 | .datatable.aware 14 | } 15 | \description{ 16 | RHESSysIOinR contains functions for running [RHESSys](https://github.com/RHESSys/RHESSys) in R 17 | and processing output. The objective of this package is to clearly and efficiently produce R code 18 | that can be used to setup RHESSys, conduct calibrations and simulations, and process output. This 19 | package supports a long(er)-term goal of having experiments involving RHESSys be reproducible. 20 | } 21 | \keyword{datasets} 22 | -------------------------------------------------------------------------------- /R/IOin_output_vars.R: -------------------------------------------------------------------------------- 1 | #' IOin_output_vars 2 | #' 3 | #' @param ... Any number of two element character vectors or dataframes, each specifying the output file using "pd", "pdg", "cd", "cdg" 4 | #' style format in the first item/column and the variable of interest in the second item/column. 5 | #' 6 | #' @author Will Burke 7 | #' 8 | #' @export 9 | 10 | # setting it up so you can either input a single df, seperate dfs that get combined, or individual vectors that get combined 11 | 12 | IOin_output_vars = function(...) { 13 | 14 | pars = list(...) 15 | 16 | if (length(pars) > 1 && is.data.frame(pars[[1]])) { 17 | pars = do.call(rbind, pars) 18 | } else if (length(pars) > 1) { 19 | pars = as.data.frame(do.call(rbind, pars)) 20 | } else { 21 | pars = as.data.frame(pars) 22 | } 23 | 24 | return(pars) 25 | 26 | } 27 | -------------------------------------------------------------------------------- /man/watbal_basin.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/watbal_basin.R 3 | \name{watbal_basin} 4 | \alias{watbal_basin} 5 | \title{watbal_basin.R} 6 | \usage{ 7 | watbal_basin(bd) 8 | } 9 | \arguments{ 10 | \item{bd}{The basin daily outputs from rhessys, most easily retrieved via `readin_rhessys_output()`} 11 | } 12 | \description{ 13 | Water balance for basin daily RHESSys output. To run, if your basin output is called "bd" type "bd=watbal(bd)". 14 | This will add a number of fields to your basin output file, the last of which will be called "watbal". 15 | This is your water balance error. You should see a minor numerical error here even if your water balances 16 | (on the order of 10^-6). If your watbal values are negative then water inputs are less than water outputs, and vice versa. 17 | } 18 | -------------------------------------------------------------------------------- /man/write_run_info.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/write_run_info.R 3 | \name{write_run_info} 4 | \alias{write_run_info} 5 | \title{write_run_info} 6 | \usage{ 7 | write_run_info( 8 | rhessys_version, 9 | world_file, 10 | world_hdr_file, 11 | tec_file, 12 | flow_file, 13 | start_date, 14 | end_date, 15 | output_path = NULL, 16 | input_parameters, 17 | output_filter = NULL, 18 | run_metadata_basename = "run_metadata", 19 | command_options, 20 | prefix_command = NULL, 21 | return_cmd = FALSE 22 | ) 23 | } 24 | \description{ 25 | Write a text file containing metadata for each RHESSys run, including date and time, RHESSys binary used, 26 | input files used, and if output files were created and where they are located. Defaulting to write the file where your output is. 27 | } 28 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: RHESSysIOinR 2 | Type: Package 3 | Title: Tools for Running RHESSys from R 4 | Version: 2.1.0 5 | Date: 2016-09-11 6 | Author: Ryan R. Bart, Will Burke 7 | Maintainer: Ryan R. Bart 8 | Description: This package contains functions for the setup of RHESSys files, 9 | calibration and simulation of RHESSys, and the analysis of RHESSys output. 10 | License: GPL (>= 2) 11 | LazyData: TRUE 12 | Imports: 13 | chron, 14 | dplyr, 15 | tidyr, 16 | lubridate, 17 | tools, 18 | data.table, 19 | sensitivity, 20 | yaml, 21 | zoo, 22 | magrittr, 23 | readr, 24 | rlang, 25 | lhs, 26 | ncdf4 27 | RoxygenNote: 7.3.3 28 | Suggests: 29 | testthat (>= 3.0.0), 30 | knitr, 31 | rmarkdown, 32 | gert 33 | VignetteBuilder: knitr 34 | Encoding: UTF-8 35 | Config/testthat/edition: 3 36 | -------------------------------------------------------------------------------- /man/IOin_def_pars_sobol.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/IOin_def_pars_sobol.R 3 | \name{IOin_def_pars_sobol} 4 | \alias{IOin_def_pars_sobol} 5 | \title{IOin_def_pars_sobol} 6 | \usage{ 7 | IOin_def_pars_sobol( 8 | ..., 9 | nboot = 100, 10 | rm_dup, 11 | sobolfunction = sensitivity::sobol2007, 12 | return_sobol = FALSE 13 | ) 14 | } 15 | \arguments{ 16 | \item{...}{Any number of lists, each containing 3 elements in format: list("", "", )} 17 | 18 | \item{nboot}{The number of bootstraps to run for sobol2007} 19 | 20 | \item{rm_dup}{TRUE/FALSE should duplicate def file + variable entries be automatically removed? A warning will occur regardless.} 21 | } 22 | \description{ 23 | Geneartes multiple def file changes based on sobol sensativity. 24 | } 25 | \author{ 26 | Will Burke 27 | } 28 | -------------------------------------------------------------------------------- /man/IOin_output_filters.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/IOin_output_filters.R 3 | \name{IOin_output_filters} 4 | \alias{IOin_output_filters} 5 | \title{IOin_output_filters} 6 | \usage{ 7 | IOin_output_filters(..., file_name = NULL, filter_in = NULL) 8 | } 9 | \arguments{ 10 | \item{...}{Any number of valid filter objects (R lists), to be written to the same output filter file.} 11 | 12 | \item{file_name}{The name of the output filter file created. if left NULL an autogenerated file name will be used.} 13 | 14 | \item{filter_in}{Path to an existing yaml filter file.} 15 | } 16 | \description{ 17 | Reads in and/or combines filters into a single R list filter object. Also checks that all filters are valid and contain the required fields 18 | with valid options when possible to check. 19 | } 20 | \author{ 21 | Will Burke 22 | } 23 | -------------------------------------------------------------------------------- /man/watbal_basin_of.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/watbal_basin_of.R 3 | \name{watbal_basin_of} 4 | \alias{watbal_basin_of} 5 | \title{watbal_basin_of.R} 6 | \usage{ 7 | watbal_basin_of(bd) 8 | } 9 | \arguments{ 10 | \item{bd}{The basin daily outputs from rhessys, most easily retrieved via `readin_rhessys_output()`} 11 | } 12 | \description{ 13 | Water balance for basin daily RHESSys output, as generated by outputfilters. To run, if your basin output is called "bd" type "bd=watbal(bd)". 14 | This will add a number of fields to your basin output file, the last of which will be called "watbal". 15 | This is your water balance error. You should see a minor numerical error here even if your water balances 16 | (on the order of 10^-6). If your watbal values are negative then water inputs are less than water outputs, and vice versa. 17 | } 18 | -------------------------------------------------------------------------------- /man/read_clim.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read_clim.R 3 | \name{read_clim} 4 | \alias{read_clim} 5 | \title{read_clim} 6 | \usage{ 7 | read_clim(clim_in, dates_out = FALSE, return_base = FALSE) 8 | } 9 | \arguments{ 10 | \item{clim_in}{Climate file - prefix will return all matching data, including suffix returns just that time series 11 | (e.g. 'site.rain' only return the precipitation time series).} 12 | 13 | \item{dates_out}{Should start and end dates be output?} 14 | 15 | \item{return_base}{Should info from the basestation only be returned. If FALSE, data will be returned.} 16 | } 17 | \description{ 18 | Read in rhessys formatted climate to R - works for any daily input, can have mismatched dates, missing values will be filled by NA. 19 | Works for both standard and netcdf clim, if you specify a basestation. 20 | } 21 | \author{ 22 | Will Burke 23 | } 24 | -------------------------------------------------------------------------------- /man/write_output_filter.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/write_output_filter.R 3 | \name{write_output_filter} 4 | \alias{write_output_filter} 5 | \title{write_output_filter} 6 | \usage{ 7 | write_output_filter(output_filter, runID = NULL) 8 | } 9 | \arguments{ 10 | \item{output_filter}{An output filter, either an R list with 1 to n number of filters read in/modified/generated via IOin_output_filter.R 11 | (or associated functions - build_output_filter.R, read_output_filter.R, modify_output_filter.R), or a file path pointing to an 12 | existing output filter.} 13 | 14 | \item{runID}{The unique ID used to track input and output files if running multiple scenarios, and thus multiple instances of run_rhessys_core.} 15 | } 16 | \description{ 17 | Writes an output filter file based on an input R list containing the needed elements. 18 | } 19 | \author{ 20 | Will Burke 21 | } 22 | -------------------------------------------------------------------------------- /R/separate_canopy_output.R: -------------------------------------------------------------------------------- 1 | #' Separate Canopy Output by Layers 2 | #' 3 | #' Function separates RHESSys canopy output by canopy and outputs a data frame that 4 | #' may be analyzed via \code{ggplot}. 5 | #' 6 | #' @param data Data frame with variables that need to be separated. 7 | #' @param num_canopies Number of canopy (stratum) per patch 8 | #' 9 | #' @export 10 | separate_canopy_output <- function(data, num_canopies = 2){ 11 | 12 | select_rows <- function(x,y,z) y[seq(x,nrow(y),z), , drop=FALSE] 13 | variables_by_canopy <- lapply(seq_len(num_canopies), select_rows, y=data, z=num_canopies) 14 | names_by_canopy <- lapply(seq_len(num_canopies), function(x,y) rep(x,nrow(y)), y=variables_by_canopy[[1]]) 15 | 16 | tmp <- lapply(seq_len(num_canopies), function(x,y,z) cbind(y[[x]],canopy_layer=z[[x]]), y=variables_by_canopy, z=names_by_canopy) 17 | canopy_df <- Reduce(rbind, tmp) 18 | 19 | return(canopy_df) 20 | } 21 | -------------------------------------------------------------------------------- /man/select_output_variables.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/select_output_variables.R 3 | \name{select_output_variables} 4 | \alias{select_output_variables} 5 | \title{Selects RHESSys output variables} 6 | \usage{ 7 | select_output_variables( 8 | output_variables, 9 | output_folder, 10 | run, 11 | output_initiation 12 | ) 13 | } 14 | \arguments{ 15 | \item{output_variables}{A data frame containing containing variable of interest, location/name of awk file (relative to 16 | output_file location), and the location/name of rhessys output file with variable 17 | of interest.} 18 | 19 | \item{output_folder}{Folder where rhessys output is located (e.g. 'out')} 20 | 21 | \item{run}{Simulation number. Used to reset files in allsim at beginning of simulation} 22 | 23 | \item{output_initiation}{For multiple scenarios} 24 | } 25 | \description{ 26 | for now simply paralleling the approach used with awks but with R input 27 | } 28 | -------------------------------------------------------------------------------- /man/compile_rhessys.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/compile_rhessys.R 3 | \name{compile_rhessys} 4 | \alias{compile_rhessys} 5 | \title{compile_rhessys} 6 | \usage{ 7 | compile_rhessys( 8 | location, 9 | delete_objs = TRUE, 10 | destination = NULL, 11 | make_args = NULL, 12 | ignore.stdout = FALSE 13 | ) 14 | } 15 | \arguments{ 16 | \item{location}{The file patch to where the rhessys makefile or folder is} 17 | 18 | \item{delete_objs}{TRUE/FALSE to delete objects (before and after)} 19 | 20 | \item{destination}{Optional input of where to move resulting RHESSys executable} 21 | 22 | \item{make_args}{Arguments passed to the end of the make commandline call (examples: "wmfire='T'", "clean", or "clobber", )} 23 | 24 | \item{ignore.stdout}{Passed through to system()} 25 | } 26 | \description{ 27 | Compiles rhessys, with options to delete objects and move resulting RHESSys executable 28 | } 29 | \author{ 30 | Will Burke 31 | } 32 | -------------------------------------------------------------------------------- /man/IOin_def_pars_latin_hypercube.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/IOin_def_pars_latin_hypercube.R 3 | \name{IOin_def_pars_latin_hypercube} 4 | \alias{IOin_def_pars_latin_hypercube} 5 | \title{IOin_def_pars_latin_hypercube} 6 | \usage{ 7 | IOin_def_pars_latin_hypercube(..., rm_dup = TRUE) 8 | } 9 | \arguments{ 10 | \item{...}{Any number of lists, each containing 3 elements in format: list("", "", ). The last element in the list is a vector containing the total number of parameter sets, minimum value of parameter sampling range, and maximum value of parameter sampling range. n must be equal across all lists.} 11 | 12 | \item{rm_dup}{TRUE/FALSE should duplicate def file + variable entries be automatically removed? A warning will occur regardless.} 13 | } 14 | \description{ 15 | Generates multiple def file changes based on a sample of parameter values across the full range of each parameter. 16 | } 17 | \author{ 18 | Ryan Bart 19 | } 20 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # User-specific files 9 | .Ruserdata 10 | 11 | # Example code in package build process 12 | *-Ex.R 13 | 14 | # Output files from R CMD build 15 | /*.tar.gz 16 | 17 | # Output files from R CMD check 18 | /*.Rcheck/ 19 | 20 | # RStudio files 21 | .Rproj.user/ 22 | 23 | # produced vignettes 24 | vignettes/*.html 25 | vignettes/*.pdf 26 | 27 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 28 | .httr-oauth 29 | 30 | # knitr and R markdown default cache directories 31 | *_cache/ 32 | /cache/ 33 | 34 | # Temporary files created by R markdown 35 | *.utf8.md 36 | *.knit.md 37 | 38 | # Shiny token, see https://shiny.rstudio.com/articles/shinyapps.html 39 | rsconnect/ 40 | inst/doc 41 | 42 | # Mac things 43 | .DS_Store 44 | doc 45 | Meta 46 | 47 | inst/doc 48 | 49 | # prevent readme html from accidentally getting pushed 50 | README.html 51 | .Rproj.user 52 | 53 | # ignore test stuff 54 | inst/extdata/out/w8* 55 | inst/extdata/rh_dev 56 | -------------------------------------------------------------------------------- /man/select_output_variables_w_awk.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/select_output_variables_w_awk.R 3 | \name{select_output_variables_w_awk} 4 | \alias{select_output_variables_w_awk} 5 | \title{Selects RHESSys output variables} 6 | \usage{ 7 | select_output_variables_w_awk( 8 | output_variables, 9 | output_folder, 10 | run, 11 | output_initiation 12 | ) 13 | } 14 | \arguments{ 15 | \item{output_variables}{A data frame containing containing variable of interest, location/name of awk file (relative to 16 | output_file location), and the location/name of rhessys output file with variable 17 | of interest.} 18 | 19 | \item{output_folder}{Folder where rhessys output is located (e.g. 'out')} 20 | 21 | \item{run}{Simulation number. Used to reset files in allsim at beginning of simulation} 22 | 23 | \item{output_initiation}{For multiple scenarios} 24 | } 25 | \description{ 26 | This function does etc, etc... Requires that an awk file be created that indicates 27 | the columns that correspond to the variable(s) of interest. See \code{create_awk} 28 | } 29 | -------------------------------------------------------------------------------- /man/cleanup_rhessys.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cleanup_rhessys.R 3 | \name{cleanup_rhessys} 4 | \alias{cleanup_rhessys} 5 | \title{cleanup_rhessys} 6 | \usage{ 7 | cleanup_rhessys( 8 | dir = NULL, 9 | output_name = NULL, 10 | copy = TRUE, 11 | destination = NULL 12 | ) 13 | } 14 | \arguments{ 15 | \item{dir}{Directory to look for output files within. To be safe function will not look recursively in subfolders.} 16 | 17 | \item{output_name}{The base name of the rhessys output, used to select only one set of rhessy outputs 18 | (still getting all of the varyious spatial + temporal levels for that output)} 19 | 20 | \item{copy}{TRUE/FALSE should the output be copied or just deleted} 21 | 22 | \item{destination}{Specify a destination for output to be copied to, if left NULL a folder will be 23 | generated with a unique name with format rh_out_datetime} 24 | } 25 | \description{ 26 | Function to remove rhessys output, options to move it to a specific folder or one w unique ID, 27 | only delete/move output based on a pattern 28 | } 29 | \author{ 30 | William Burke 31 | } 32 | -------------------------------------------------------------------------------- /R/RHESSysIOinR.R: -------------------------------------------------------------------------------- 1 | #' RHESSysIOinR 2 | #' 3 | #' RHESSysIOinR contains functions for running [RHESSys](https://github.com/RHESSys/RHESSys) in R 4 | #' and processing output. The objective of this package is to clearly and efficiently produce R code 5 | #' that can be used to setup RHESSys, conduct calibrations and simulations, and process output. This 6 | #' package supports a long(er)-term goal of having experiments involving RHESSys be reproducible. 7 | #' 8 | #' @docType package 9 | #' @name RHESSysIOinR 10 | #' 11 | # Import package operators 12 | #' @importFrom data.table ":=" "%like%" "%between%" 13 | #' 14 | #' @importFrom stats runif weighted.mean 15 | #' @importFrom utils read.csv read.table write.table 16 | 17 | # from data.table docs: https://cran.r-project.org/web/packages/data.table/vignettes/datatable-importing.html 18 | # Make sure data.table knows we know we're using it 19 | .datatable.aware = TRUE 20 | 21 | # Prevent R CMD check from complaining about the use of pipe expressions 22 | # standard data.table variables 23 | if (getRversion() >= "2.15.1") 24 | utils::globalVariables(c(".", ".I", ".N", ".SD"), utils::packageName()) 25 | -------------------------------------------------------------------------------- /man/build_redefine.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/build_redefine.R 3 | \name{build_redefine} 4 | \alias{build_redefine} 5 | \title{build_redefine} 6 | \usage{ 7 | build_redefine( 8 | worldfile, 9 | out_file, 10 | vars = NULL, 11 | values = NULL, 12 | std_thin = NULL, 13 | patchID = NULL, 14 | strataID = NULL, 15 | veg_parm_ID = NULL 16 | ) 17 | } 18 | \arguments{ 19 | \item{worldfile}{Source worldfile} 20 | 21 | \item{out_file}{Destination file to write} 22 | 23 | \item{vars}{variables to edit} 24 | 25 | \item{values}{values to insert for variables} 26 | 27 | \item{std_thin}{Value to insert for standard thinning state vars (replacement value or multiplier depending on usage)} 28 | 29 | \item{patchID}{Patch ID(s) to apply redefine to, can be used alone or with other subsets} 30 | 31 | \item{strataID}{Strata ID(s) to apply redefine to, can be used alone or with other subsets} 32 | 33 | \item{veg_parm_ID}{veg parm ID to apply changes to, can be used alone or with other subsets} 34 | } 35 | \description{ 36 | Create a redefine worldfile 37 | } 38 | \author{ 39 | Will Burke 40 | } 41 | -------------------------------------------------------------------------------- /man/IOin_def_pars_simple.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/IOin_def_pars_simple.R 3 | \name{IOin_def_pars_simple} 4 | \alias{IOin_def_pars_simple} 5 | \title{IOin_def_pars_simple} 6 | \usage{ 7 | IOin_def_pars_simple(..., n = 1, pct_range = 0.25, rm_dup = F) 8 | } 9 | \arguments{ 10 | \item{...}{Any number of lists, each containing 3 elements in format: list("", "", )} 11 | 12 | \item{n}{The number of parameter sets to generate.} 13 | 14 | \item{pct_range}{The percent range of variation from input values over which sampling (if any), will happen.} 15 | 16 | \item{rm_dup}{TRUE/FALSE should duplicate def file + variable entries be automatically removed? A warning will occur regardless.} 17 | } 18 | \description{ 19 | The definition file parameters to modify. This input function generates an input parameter object, either for a single simulation, 20 | or using simple random sampling over a set range (based on percent difference from input values). This later functionality can be put into 21 | a seperate funciton later if desired. 22 | } 23 | \author{ 24 | Will Burke 25 | } 26 | -------------------------------------------------------------------------------- /man/insert_in_worldfile.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/insert_in_worldfile.R 3 | \name{insert_in_worldfile} 4 | \alias{insert_in_worldfile} 5 | \title{Insert in Worldfile} 6 | \usage{ 7 | insert_in_worldfile( 8 | world_in, 9 | world_out, 10 | insert, 11 | insert_loc, 12 | return_data = FALSE, 13 | overwrite = FALSE 14 | ) 15 | } 16 | \arguments{ 17 | \item{world_in}{Path to input worldfile. Cannot create from scratch (use RHESSysPreprocessing)} 18 | 19 | \item{world_out}{Path to output worldfile. If set to FALSE, no file will be written.} 20 | 21 | \item{insert}{Character vector of length = 2, containing state variable and value to be inserted into a worldfile.} 22 | 23 | \item{insert_loc}{Location, in the form of an existing state variable name, for a new state variable(s) to be inserted following.} 24 | 25 | \item{return_data}{TRUE/FALSE should an R data object be returned.} 26 | 27 | \item{overwrite}{TRUE/FALSE should output worldfile overwrite existing file.} 28 | } 29 | \description{ 30 | Inserts new state variables and values into a worldfile at specified location(s). 31 | } 32 | \author{ 33 | Will Burke 34 | } 35 | -------------------------------------------------------------------------------- /man/tec_repeat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tec_repeat.R 3 | \name{tec_repeat} 4 | \alias{tec_repeat} 5 | \title{tec_repeat} 6 | \usage{ 7 | tec_repeat( 8 | start, 9 | end, 10 | interval = NULL, 11 | unit, 12 | event_name, 13 | world = NULL, 14 | redefine = NULL, 15 | overwrite = FALSE 16 | ) 17 | } 18 | \arguments{ 19 | \item{start}{Vector containing start date. Format is "c(year,month,day,hour)".} 20 | 21 | \item{end}{Vector containing end date. Format is "c(year,month,day,hour)".} 22 | 23 | \item{interval}{Interval to repeat chosen tec event. If left NULL will be executed 1 time.} 24 | 25 | \item{unit}{Unit of time for the repeat interval} 26 | 27 | \item{event_name}{The name/type of tec event to repeat.} 28 | 29 | \item{world}{Worldfile basename to modify and repeat} 30 | 31 | \item{redefine}{Redefine file to copy and rename. If NULL no files copied.} 32 | 33 | \item{overwrite}{Should existing files be overwritten} 34 | } 35 | \description{ 36 | Repeats tec events at chosen intervals. Outputs a dataframe of the events for use in the tec input for RHESSysIOinR, 37 | optionally will copy an input redefine file with generated filenames. 38 | } 39 | \author{ 40 | Will Burke 41 | } 42 | -------------------------------------------------------------------------------- /man/IOin_hdr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/IOin_hdr.R 3 | \name{IOin_hdr} 4 | \alias{IOin_hdr} 5 | \title{IOin_hdr} 6 | \usage{ 7 | IOin_hdr( 8 | basin, 9 | hillslope, 10 | zone, 11 | soil, 12 | landuse, 13 | stratum, 14 | fire = NULL, 15 | fire_grid_prefix = NULL, 16 | spinup = NULL, 17 | basestations 18 | ) 19 | } 20 | \arguments{ 21 | \item{basin}{Path to basin parameter definition file.} 22 | 23 | \item{hillslope}{Path to hillslope parameter definition file.(s)} 24 | 25 | \item{zone}{Path to zone parameter definition file(s).} 26 | 27 | \item{soil}{Path to soil parameter definition file(s).} 28 | 29 | \item{landuse}{Path to landuse parameter definition file(s).} 30 | 31 | \item{stratum}{Path to stratum parameter definition file(s).} 32 | 33 | \item{fire}{Path to fire parameter definition file.} 34 | 35 | \item{fire_grid_prefix}{Path and basename/prefix name of the fire grid files used for the RHESSys WMFire model.} 36 | 37 | \item{spinup}{Path to spinup parameter definition file(s).} 38 | 39 | \item{basestations}{Path to basin climate basestation file(s).} 40 | } 41 | \description{ 42 | Creates a header file based on specified parameter definition files and climate basestations. 43 | } 44 | \author{ 45 | Will Burke 46 | } 47 | -------------------------------------------------------------------------------- /R/add_dates.R: -------------------------------------------------------------------------------- 1 | #' add_dates 2 | #' 3 | #' Add dates, day of year, water year, water year day to RHESSys output (as appropriate for time step) 4 | #' @param DF input Data Frame or Data Table 5 | #' @author Will Burke 6 | #' 7 | #' @export 8 | 9 | # this is pretty optimized but plz continue to optimize as much as possible 10 | 11 | add_dates = function(DF) 12 | { 13 | if ("day" %in% colnames(DF)) { 14 | DF$date = lubridate::ymd(paste(DF$year, DF$month, DF$day, sep = "-")) 15 | DF$wy = data.table::fifelse(DF$month >= 10, DF$year + 1, DF$year) 16 | DF$yd = lubridate::yday(DF$date) 17 | 18 | # need to account for varing numbers of patches etc so line offsets are wrong 19 | # yd = lubridate::yday(c(DF$date, seq.Date(DF$date[length(DF$date)], by = "day", length.out = 93)[2:93])) 20 | # DF$yd = yd[1:(length(yd) - 92)] 21 | # DF$wyd = yd[93:length(yd)] 22 | 23 | # wy_date = c(clim$date[93:length(clim$date)], seq.POSIXt(from = clim$date[length(clim$date)], by = "DSTday", length.out = 93)[2:93]) 24 | # clim$wyd = lubridate::yday(wy_date) 25 | 26 | } else if (!"day" %in% colnames(DF) & "month" %in% colnames(DF)) { 27 | DF$wy = data.table::fifelse(DF$month >= 10, DF$year + 1, DF$year) 28 | DF$yr_mn = zoo::as.yearmon(paste(DF$year, DF$month, sep = "-")) 29 | 30 | } 31 | return(DF) 32 | } 33 | -------------------------------------------------------------------------------- /R/IOin_output_filters.R: -------------------------------------------------------------------------------- 1 | #' IOin_output_filters 2 | #' 3 | #' Reads in and/or combines filters into a single R list filter object. Also checks that all filters are valid and contain the required fields 4 | #' with valid options when possible to check. 5 | #' @param ... Any number of valid filter objects (R lists), to be written to the same output filter file. 6 | #' @param file_name The name of the output filter file created. if left NULL an autogenerated file name will be used. 7 | #' @param filter_in Path to an existing yaml filter file. 8 | #' 9 | #' @author Will Burke 10 | #' 11 | #' @export 12 | 13 | IOin_output_filters = function(..., 14 | file_name = NULL, 15 | filter_in = NULL) { 16 | 17 | # ---------- Read in existing yaml filter ---------- 18 | if (!is.null(filter_in)) { 19 | filter = read_output_filter(filter_in = filter_in) 20 | } else { 21 | filter = NULL 22 | } 23 | 24 | # ---------- Combine filters ---------- 25 | list_in = c(unlist(list(...), recursive = F)) 26 | if (length(list_in) > 0 && is.list(list_in)) { 27 | testvalid = lapply(X = list_in, FUN = valid_filter) 28 | filter = c(filter, list_in) 29 | } else { 30 | cat("Invalid input to '...' input argument.") 31 | } 32 | 33 | if (!is.null(file_name)) { 34 | filter$file_name = file_name 35 | } 36 | 37 | return(filter) 38 | } 39 | -------------------------------------------------------------------------------- /man/make_hdr_file.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/make_hdr_file.R 3 | \name{make_hdr_file} 4 | \alias{make_hdr_file} 5 | \title{Write Header File} 6 | \usage{ 7 | make_hdr_file(input_rhessys, hdr_files, def_files, runID) 8 | } 9 | \arguments{ 10 | \item{input_rhessys}{List containing the following named elements: "rhessys_version" (path to rhessys binary), 11 | "tec_file"(name for tec file to be built), "world_file"(path to existing worldfile), "world_hdr_prefix"(prefix for headers to create), 12 | "flow_file"(path to existing flowtable), "start_date"(format c('yyyy mm dd hr')), "end_date"(format c('yyyy mm dd hr')), 13 | "output_folder"(path to output folder), "output_filename"(prefix for output files to create), "command_options"(additional commandline options)} 14 | 15 | \item{hdr_files}{List of named elements, named for each def file type (basin_def, hillslope_def, zone_def, soil_def, landuse_def, patch_def, 16 | stratum_def) as well as an element named "base_stations". Each element should contain the path to the corresponding def file.} 17 | 18 | \item{def_files}{Data frame of def file parameter changes} 19 | 20 | \item{runID}{The unique ID used to track input and output files if running multiple scenarios, and thus multiple instances of run_rhessys_core.} 21 | } 22 | \description{ 23 | New version of header file creation function. 24 | } 25 | \author{ 26 | Will Burke 27 | } 28 | -------------------------------------------------------------------------------- /man/build_output_filter.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/build_output_filter.R 3 | \name{build_output_filter} 4 | \alias{build_output_filter} 5 | \title{build_output_filter} 6 | \usage{ 7 | build_output_filter( 8 | timestep = c("daily", "monthly", "annual", "hourly"), 9 | output_format = c("csv", "netcdf"), 10 | output_path, 11 | output_filename, 12 | spatial_level = c("basin", "hillslope", "zone", "patch", "stratum"), 13 | spatial_ID, 14 | variables 15 | ) 16 | } 17 | \arguments{ 18 | \item{timestep}{The timestep of the filter: 'daily', 'monthly', 'annual', 'hourly'} 19 | 20 | \item{output_format}{The format for the RHESSys output files to be written: 'csv' or 'netcdf'} 21 | 22 | \item{output_path}{The path where RHESSys output will be written.} 23 | 24 | \item{output_filename}{The filename for RHESSys output} 25 | 26 | \item{spatial_level}{The spatial level for output to be collected at/aggregated to: 'basin', 'hillslope', 'zone', 'patch', 'stratum'} 27 | 28 | \item{spatial_ID}{IDs to subset the spatial units by.} 29 | 30 | \item{variables}{The RHESSys internal variable names to output. If aggregating from a finer spatial level use syntax: '.'} 31 | } 32 | \description{ 33 | Creates a single output filter in R list format. This can be combined with other filters 34 | and/or written to file to be read by RHESSys when running. 35 | } 36 | \author{ 37 | Will Burke 38 | } 39 | -------------------------------------------------------------------------------- /R/get_waterYearDay.R: -------------------------------------------------------------------------------- 1 | #' Day of water year 2 | #' @description Given a vector of dates, calculates day of water year accounting for leap years. 3 | #' @param x A vector of class date. 4 | #' @return A numeric vector of day of water year 5 | #' @importFrom lubridate leap_year 6 | #' @importFrom lubridate yday 7 | #' @export 8 | #' @source https://rdrr.io/github/USGS-R/EflowStats/src/R/get_waterYearDay.R 9 | #' x <- seq(from=as.Date("2010-01-01"),to=as.Date("2016-01-01"),by="1 days") 10 | #' get_waterYearDay(x) 11 | 12 | 13 | get_waterYearDay <- function(x) { 14 | 15 | year_day <- lubridate::yday(x) 16 | yrs_leap <- lubridate::leap_year(x) 17 | 18 | # October 1st (day 1 of water year) is day 274 (or 275 in leap year) of calendar year. 19 | # (274 + years_leap) == 275 for dates in leap year and 274 for dates not in leap year. 20 | # This provides a boolean selector for days before (false) / after (true) Oct 1. 21 | after_waterday <- year_day >= (274 + yrs_leap) 22 | 23 | # 273 (or 274 in leap year) days from January 1 to October 1 24 | # This gives us 1 for October 1st and corrects everything till December 31st. 25 | year_day[after_waterday] <- year_day[after_waterday] - (273 + yrs_leap[after_waterday]) 26 | 27 | # 92 days from October 1 to January 1 28 | # This gives us 93 for January 1 and corrects everything till September 29th. 29 | year_day[!after_waterday] <- year_day[!after_waterday] + 92 30 | 31 | return(year_day) 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/modify_output_filter.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/modify_output_filter.R 3 | \name{modify_output_filter} 4 | \alias{modify_output_filter} 5 | \title{modify_output_filter} 6 | \usage{ 7 | modify_output_filter( 8 | filter_in, 9 | timestep = NULL, 10 | output_format = NULL, 11 | output_path = NULL, 12 | output_filename = NULL, 13 | spatial_level = NULL, 14 | spatial_ID = NULL, 15 | variables = NULL 16 | ) 17 | } 18 | \arguments{ 19 | \item{filter_in}{Path to the yaml filter file} 20 | 21 | \item{timestep}{The timestep of the filter: 'daily', 'monthly', 'annual', 'hourly'} 22 | 23 | \item{output_format}{The format for the RHESSys output files to be written: 'csv' or 'netcdf'} 24 | 25 | \item{output_path}{The path where RHESSys output will be written.} 26 | 27 | \item{output_filename}{The filename for RHESSys output} 28 | 29 | \item{spatial_level}{The spatial level for output to be collected at/aggregated to: 'basin', 'hillslope', 'zone', 'patch', 'stratum'} 30 | 31 | \item{spatial_ID}{IDs to subset the spatial units by.} 32 | 33 | \item{variables}{The RHESSys internal variable names to output. If aggregating from a finer spatial level use syntax: '.'} 34 | } 35 | \description{ 36 | Modify a single existing output filter, either from file or based on an existing R object. Will error if given multiple filters. 37 | This could be done via normal list modification in R as well. 38 | } 39 | \author{ 40 | Will Burke 41 | } 42 | -------------------------------------------------------------------------------- /man/output_control.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/output_control.R 3 | \name{output_control} 4 | \alias{output_control} 5 | \title{output_control} 6 | \usage{ 7 | output_control( 8 | output_method, 9 | output_variables, 10 | return_data, 11 | output_folder, 12 | output_filename, 13 | runID = 1 14 | ) 15 | } 16 | \arguments{ 17 | \item{output_method}{Output method (function) to use. "awk" will use awk, "r" will use new R based method, 18 | any other non NULL input will use the older R based output selection.} 19 | 20 | \item{output_variables}{Datafrane with two named columns: "variables" containing variables of interest 21 | found in the header of standard rhessys output files, "out_file" points to the files containing the associated variables, 22 | this can be either the path to that file, can use the abbreviation for the different output types 23 | (patch daily = pd, patch daily grow = pdg etc.) and the files in output_folder will be parsed appropriately, 24 | or can use the fully written out space.time suffix, e.g. "patch.daily" or "grow_patch.daily"} 25 | 26 | \item{return_data}{TRUE/FALSE if the function should return a data.table of the selected output - for now only works if doing 1 run} 27 | 28 | \item{output_folder}{Folder where rhessys output is located} 29 | 30 | \item{output_filename}{Base file name of standard rhessys output} 31 | 32 | \item{runID}{Integer ID of the current run, used internally} 33 | } 34 | \description{ 35 | Passes output variables to appropriate output selection method. 36 | } 37 | -------------------------------------------------------------------------------- /man/readin_rhessys_output_cal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/readin_rhessys_output_cal.R 3 | \name{readin_rhessys_output_cal} 4 | \alias{readin_rhessys_output_cal} 5 | \title{Extracts output from a multiple RHESSys runs into R} 6 | \usage{ 7 | readin_rhessys_output_cal( 8 | var_names, 9 | path, 10 | initial_date, 11 | timestep = "daily", 12 | parameter_file = NULL, 13 | num_layers = 1 14 | ) 15 | } 16 | \arguments{ 17 | \item{var_names}{Vector of the variables names that are to be imported into R. Variables should all have the same number of layers.} 18 | 19 | \item{path}{Path to the directory containing data} 20 | 21 | \item{initial_date}{Initial date for the data e.g. lubridate::ymd("1941-10-01")} 22 | 23 | \item{timestep}{Timestep used for modeling (e.g. yearly, monthly, or daily). Default is daily.} 24 | 25 | \item{parameter_file}{Optional file containing parameters to be included in analysis (e.g. RHESSysIOinR output x_parameter_sets.csv)} 26 | 27 | \item{num_layers}{Number of layers in data. For most output (e.g. patch, basin), this will generally have a value of one. The exception being when using two canopies.} 28 | } 29 | \description{ 30 | Imports multiple-run RHESSys output that has been consolidated by variable. This 31 | function imports and manipulates data so that it is 'tidy' and easily imported 32 | into ggplot. 33 | } 34 | \details{ 35 | This function processes the output from multiple run calibration or simulations which consolidate a selection of the output into the allsim folder. 36 | } 37 | -------------------------------------------------------------------------------- /vignettes/RHESSysIOinR_utilities_examples.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "RHESSysIOinR Utilities Examples" 3 | author: "Will Burke" 4 | date: "11/10/2020" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{RHESSysIOinR Utilities Examples} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | ```{r setup, include=FALSE} 13 | knitr::opts_chunk$set(echo = TRUE) 14 | ``` 15 | 16 | ## RHESSysIOinR Utilities 17 | 18 | The following are various utility functions included with RHESSysIOinR 19 | 20 | * `build_redefine()`: generates redefine worldfiles 21 | * `cal.wyd()`: calculates wateryear day 22 | * `change_def_file()`: create new def file based on existing file and input pars 23 | * `clim_auto()`: helper to simplify climate input for `run_rhessys()` 24 | * `evaluation()`: used to evaluate model output 25 | * `input_tec()`: helper to simplify input of tec events 26 | * `mkdate()`: generates wy, yd, and wyd based on day, month, year 27 | * `read_clim()`: reads rhessys formatted climate data into R 28 | * `readin_rhessys_output()`: reads rhessys output into R, includes some subsetting and simply aggregation 29 | * `readin_rhessys_output_old()`: legacy method to read in rhessys output 30 | * `tec_repeat()`: generates repeating tec events for input into `run_rhessys()`, can also copy+rename a redefine file as needed 31 | * `watbal_basin()`: Calculate water balance for a the basin 32 | * `watbal_patch()`: Calculate water balance for a single patch 33 | * `watbal_patch_multi()`: Calculate water balance for a multiple patches 34 | * `write_sample_clim()`: generate new climate based on existing climate 35 | 36 | -------------------------------------------------------------------------------- /deprecated_functions/evaluation.R: -------------------------------------------------------------------------------- 1 | #' Code for evaluating model output 2 | #' 3 | #' Description... 4 | #' 5 | #' Future iterations will account for multiple parameters and/or multiple criteria. 6 | #' Also, future iterations should will need to combine outputs from separate simulations (from parallelization) 7 | #' into a single evaluated simulation. 8 | #' 9 | #' @param sim_variables ???? 10 | #' @param obs_variables \code{obs} must have an equal number of values as \code{sim}. 11 | #' 12 | #' @export 13 | evaluation <- function(sim_variables, obs_variables, obj_function_selection, input_folder, output_folder, ..., 14 | evaluation_type = c("single_objective_function", "composite", "pareto")){ 15 | 16 | parameter_type <- match.arg(evaluation_criteria) 17 | 18 | # Remove lapply? 19 | sim = lapply(as.data.frame(read.csv(paste(input_folder,"/allsim/",sim_variables, sep="")))) 20 | obs = lapply(as.data.frame(read.csv(paste(input_folder,"/",obs_variables,sep="")))) 21 | 22 | if (length(sim) > 1 & length(obs) == 0){ 23 | # repeat obs variable so that it equals number of simulation variables 24 | } 25 | 26 | # Current implentation cannot handle multiple variables 27 | obj_function_all <- gof(sim, obs, ...) 28 | print(obj_function_all) 29 | 30 | # Selection evalutation criteria 31 | top_ps <- select_parameter_sets(obj_function_all, obj_function_selection = obj_function_selection, 32 | method = evaluation_type, ...) 33 | 34 | # Export top parameter sets 35 | write.csv(top_ps, paste(output_folder, "/", output_filename, "_top_ps.csv", sep="")) 36 | 37 | return(top_ps) 38 | } 39 | 40 | 41 | -------------------------------------------------------------------------------- /man/IOin_clim.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/IOin_clim.R 3 | \name{IOin_clim} 4 | \alias{IOin_clim} 5 | \title{IOin_clim} 6 | \usage{ 7 | IOin_clim( 8 | base_station_id, 9 | x_coordinate, 10 | y_coordinate, 11 | z_coordinate, 12 | effective_lai, 13 | screen_height, 14 | annual_prefix = "annual", 15 | num_non_critical_annual_sequences = 0, 16 | monthly_prefix = "monthly", 17 | num_non_critical_monthly_sequences = 0, 18 | daily_prefix = "daily", 19 | num_non_critical_daily_sequences = 0, 20 | hourly_prefix = "hourly", 21 | num_non_critical_hourly_sequences = 0 22 | ) 23 | } 24 | \arguments{ 25 | \item{base_station_id}{Base station ID.} 26 | 27 | \item{x_coordinate}{X coordinate.} 28 | 29 | \item{y_coordinate}{Y coordinate.} 30 | 31 | \item{z_coordinate}{Z coordinate.} 32 | 33 | \item{effective_lai}{Effective LAI.} 34 | 35 | \item{screen_height}{Screen height.} 36 | 37 | \item{annual_prefix}{Prefix for annual climate inputs.} 38 | 39 | \item{num_non_critical_annual_sequences}{Number of non critical annual climate inputs. Defaults to 0.} 40 | 41 | \item{monthly_prefix}{Prefix for monthly climate inputs.} 42 | 43 | \item{num_non_critical_monthly_sequences}{Number of non critical annual climate inputs. Defaults to 0.} 44 | 45 | \item{daily_prefix}{Prefix for daily climate inputs.} 46 | 47 | \item{num_non_critical_daily_sequences}{Number of non critical annual climate inputs. Defaults to 0.} 48 | 49 | \item{hourly_prefix}{Prefix for hourly climate inputs.} 50 | 51 | \item{num_non_critical_hourly_sequences}{Number of non critical annual climate inputs. Defaults to 0.} 52 | } 53 | \description{ 54 | Generate input for run_rhessys climate basestation input 55 | } 56 | \author{ 57 | Will Burke 58 | } 59 | -------------------------------------------------------------------------------- /R/watbal_basin.R: -------------------------------------------------------------------------------- 1 | #' watbal_basin.R 2 | #' 3 | #' Water balance for basin daily RHESSys output. To run, if your basin output is called "bd" type "bd=watbal(bd)". 4 | #' This will add a number of fields to your basin output file, the last of which will be called "watbal". 5 | #' This is your water balance error. You should see a minor numerical error here even if your water balances 6 | #' (on the order of 10^-6). If your watbal values are negative then water inputs are less than water outputs, and vice versa. 7 | #' @param bd The basin daily outputs from rhessys, most easily retrieved via `readin_rhessys_output()` 8 | #' @export 9 | 10 | watbal_basin = function(bd) { 11 | 12 | # some error checks here 13 | req_cols = c("precip", "streamflow", "trans", "evap", "sat_def", "rz_storage", "unsat_stor", 14 | "snowpack", "detention_store", "litter_store", "canopy_store", "gw.storage") 15 | if (!is.data.frame(bd) || any(!req_cols %in% colnames(bd))) { 16 | cat("Input is either not a data frame or is missing the correct columns") 17 | return(NA) 18 | } 19 | 20 | # main fluxes 21 | bd$watbal_flux = with(bd, precip - streamflow - trans - evap) 22 | 23 | # changes in stores 24 | bd$sd = with(bd, sat_def - rz_storage - unsat_stor) 25 | bd$sddiff = c(0, diff(bd$sd)) 26 | bd$snodiff = c(0, diff(bd$snowpack)) 27 | bd$detdiff = c(0, diff(bd$detention_store)) 28 | bd$litdiff = c(0, diff(bd$litter_store)) 29 | bd$candiff = c(0, diff(bd$canopy_store)) 30 | bd$gwdiff = c(0, diff(bd$gw.storage)) 31 | 32 | # fluxes minus stores 33 | bd$watbal = with(bd, watbal_flux + sddiff - snodiff - detdiff - litdiff - candiff - gwdiff) 34 | bd$watbal[1] = 0.0 35 | # max(bd$watbal) 36 | # summary(bd$watbal) 37 | # hist(bd$watbal) 38 | 39 | return(bd) 40 | 41 | } 42 | -------------------------------------------------------------------------------- /R/write_log.R: -------------------------------------------------------------------------------- 1 | #' write_log 2 | #' 3 | #' write or append to a log file, by row 4 | 5 | write_log = function (input_rhessys, 6 | output_filter, 7 | return_cmd, 8 | run_ct, 9 | log_loc = "~/rhessys_run_log.csv") { 10 | 11 | # assumes output filters 12 | if (!is.null(output_filter) & is.list(output_filter)) { 13 | output_loc = unique(lapply(output_filter[1:length(output_filter)-1], function(X) X$output$path))[1] 14 | } else { 15 | output_loc = NA 16 | } 17 | 18 | if(is.null(input_rhessys$world_hdr_path)) { 19 | headerpath = input_rhessys$world_hdr_prefix 20 | } else { 21 | headerpath = file.path(input_rhessys$world_hdr_path, input_rhessys$world_hdr_prefix) 22 | } 23 | 24 | # trying to keep this as short as possible 25 | log_tab = data.frame( 26 | Run_Count = run_ct, 27 | Date = Sys.Date(), 28 | Time = format(Sys.time(), "%I:%M:%S %p"), 29 | Working_Dir = getwd(), 30 | Worldfile = input_rhessys$world_file, 31 | Flowtable = input_rhessys$flow_file, 32 | Header = headerpath, 33 | Tecfile = input_rhessys$tec_file, 34 | Start_Date = input_rhessys$start_date, 35 | End_Date = input_rhessys$end_date, 36 | Cmd_Opts = ifelse(is.null(input_rhessys$command_options), NA, input_rhessys$command_options) 37 | ) 38 | if (!file.exists(log_loc)) { 39 | write.table(log_tab, 40 | file = log_loc, 41 | sep = ",", 42 | row.names = FALSE, 43 | col.names = TRUE, 44 | quote = FALSE) 45 | cat("Wrote first time log to: ",log_loc,"\n") 46 | } else { 47 | write.table(log_tab, 48 | file = log_loc, 49 | sep = ",", 50 | row.names = FALSE, 51 | col.names = FALSE, 52 | quote = FALSE, 53 | append = TRUE) 54 | cat("Appended log: ",log_loc,"\n") 55 | } 56 | 57 | return(NULL) 58 | 59 | } 60 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(IOin_clim) 4 | export(IOin_cmd_pars) 5 | export(IOin_def_pars_latin_hypercube) 6 | export(IOin_def_pars_simple) 7 | export(IOin_def_pars_sobol) 8 | export(IOin_hdr) 9 | export(IOin_output_filters) 10 | export(IOin_output_vars) 11 | export(IOin_rhessys_input) 12 | export(IOin_tec_all_options) 13 | export(IOin_tec_std) 14 | export(add_dates) 15 | export(build_output_filter) 16 | export(build_redefine) 17 | export(change_def_file) 18 | export(check_params) 19 | export(cleanup_rhessys) 20 | export(compare_params) 21 | export(compile_rhessys) 22 | export(get_waterYearDay) 23 | export(insert_in_worldfile) 24 | export(modify_output_filter) 25 | export(parse_rh_constr_func) 26 | export(patch_fam_agg) 27 | export(read_clim) 28 | export(read_output_filter) 29 | export(readin_rhessys_output) 30 | export(readin_rhessys_output_cal) 31 | export(rhessys_command) 32 | export(run_rhessys_multi) 33 | export(run_rhessys_single) 34 | export(select_output_variables) 35 | export(select_output_variables_R) 36 | export(select_output_variables_w_awk) 37 | export(separate_canopy_output) 38 | export(tec_repeat) 39 | export(watbal_basin) 40 | export(watbal_basin_of) 41 | export(watbal_patch) 42 | export(watbal_patch_mult) 43 | export(write_output_filter) 44 | export(write_sample_clim) 45 | importFrom(data.table,"%between%") 46 | importFrom(data.table,"%like%") 47 | importFrom(data.table,":=") 48 | importFrom(lubridate,leap_year) 49 | importFrom(lubridate,yday) 50 | importFrom(magrittr,"%>%") 51 | importFrom(ncdf4,nc_open) 52 | importFrom(ncdf4,ncvar_get) 53 | importFrom(stats,runif) 54 | importFrom(stats,weighted.mean) 55 | importFrom(stringr,str_remove) 56 | importFrom(utils,read.csv) 57 | importFrom(utils,read.table) 58 | importFrom(utils,write.table) 59 | -------------------------------------------------------------------------------- /man/write_sample_clim.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/write_sample_clim.R 3 | \name{write_sample_clim} 4 | \alias{write_sample_clim} 5 | \title{Sample RHESSys Climate Data} 6 | \usage{ 7 | write_sample_clim(prefix, clim, samplewyrs, reps = 1, startwyr = 0) 8 | } 9 | \arguments{ 10 | \item{prefix}{String giving the prefix to be used for output file names (e.g 11 | "../out/seqname")} 12 | 13 | \item{clim}{Original climate data to be sampled from, this must have the 14 | following columns; year, month, day, date, wy, rain, tmax, and tmin. Rain 15 | must be in mm, tmax and tmin in C. There must be a value for every day in 16 | each water year and it must be in sequential order. Columns can be in any 17 | order, a file created by read_RHESSys_met will work.} 18 | 19 | \item{samplewyrs}{is the vector of water years to be sampled from the 20 | original climate, in the order you want them to occur. A water year can be 21 | used more than once. samplewyrs must be included in the call to the 22 | function.} 23 | 24 | \item{reps}{Creates a sequence where your samplewyrs will be repeated. If 25 | samplewyrs=c(2004,2000) and rep=4, the sequence you will get is made from 26 | 2004,2000,2004,2000,2004,2000,2004,2000. Reps is optional and default to 1.} 27 | 28 | \item{startwyr}{is the water year to be used for the first day of the newly 29 | generated sequence thus, if startwyr=1998, the new sequence will start on 30 | 10/1/1998. startwyr is optional. If startwyr is not listed the program will 31 | use the first water year of the original climate sequence (clim)} 32 | } 33 | \description{ 34 | This function is used to generate new (artifical) RHESSys climate inputs from 35 | existing climate data the function returns a new climate data frame in R and 36 | writes .tmax, .tmin, .rain files for RHESSys met input 37 | } 38 | -------------------------------------------------------------------------------- /R/select_output_variables_w_awk.R: -------------------------------------------------------------------------------- 1 | #' Selects RHESSys output variables 2 | #' 3 | #' This function does etc, etc... Requires that an awk file be created that indicates 4 | #' the columns that correspond to the variable(s) of interest. See \code{create_awk} 5 | #' 6 | #' @param output_variables A data frame containing containing variable of interest, location/name of awk file (relative to 7 | #' output_file location), and the location/name of rhessys output file with variable 8 | #' of interest. 9 | #' @param output_folder Folder where rhessys output is located (e.g. 'out') 10 | #' @param run Simulation number. Used to reset files in allsim at beginning of simulation 11 | #' @param output_initiation For multiple scenarios 12 | #' 13 | #' @export 14 | 15 | select_output_variables_w_awk <- function(output_variables, output_folder, run, output_initiation){ 16 | 17 | if (run == 1 && output_initiation == 1){ 18 | for (dd in seq_len(nrow(output_variables))){ 19 | system(sprintf("rm %s/allsim/%s", output_folder, output_variables$variable[dd])) 20 | system(sprintf("echo > %s/allsim/%s", output_folder, output_variables$variable[dd])) 21 | } 22 | } 23 | 24 | for (cc in seq_len(nrow(output_variables))){ 25 | system(sprintf("rm %s/allsim/t%s", output_folder, output_variables$variable[cc])) 26 | system(sprintf("awk -f %s < %s/%s > %s/allsim/t%s", output_variables$awk_path[cc], output_folder, output_variables$out_file[cc], output_folder, output_variables$variable[cc])) 27 | system(sprintf("paste %s/allsim/%s %s/allsim/t%s > %s/allsim/new%s", output_folder, output_variables$variable[cc], output_folder, output_variables$variable[cc], output_folder, output_variables$variable[cc])) 28 | system(sprintf("mv %s/allsim/new%s %s/allsim/%s", output_folder, output_variables$variable[cc], output_folder, output_variables$variable[cc])) 29 | } 30 | } 31 | 32 | -------------------------------------------------------------------------------- /R/patch_fam_agg.R: -------------------------------------------------------------------------------- 1 | #' patch_fam_agg 2 | #' 3 | #' Aggregate (aspatial) patches back to spatial patches via weighted mean. 4 | #' Add in exceptions if you want to aggregate via different methods. 5 | #' @param X Data Frame or Data Table to aggregate 6 | #' @param areas Data frame (or table) of patch IDs and associated areas. 7 | #' Needed for stratum outputs which don't include area. 8 | #' @param na.rm Should NAs ne removed when calculating weighed average (passed through to weighted.mean) 9 | #' @export 10 | 11 | patch_fam_agg = function(X, areas = NULL, na.rm = FALSE) { 12 | 13 | if (!"familyID" %in% colnames(X)) { 14 | if (all(nchar(X$patchID) >= 3)) { 15 | X$familyID = floor(X$patchID/100) 16 | print(noquote("'familyID' was missing, generated based on 'patchID's.")) 17 | } else { 18 | stop(paste0("Couldn't find 'familyID' column and patchID length is too short to contain familyIDs")) 19 | } 20 | } 21 | 22 | keep_cols = c("day", "month", "year", "basinID", "hillID", "zoneID", "patchID", "stratumID", 23 | "familyID", "date","wy","yd","wyd", "area") 24 | keep_cols = keep_cols[keep_cols %in% colnames(X)] 25 | group_cols = c("date", "familyID") 26 | if ("stratumID" %in% colnames(X)) {group_cols = c(group_cols, "stratumID")} 27 | agg_cols = colnames(X)[!colnames(X) %in% keep_cols] 28 | 29 | if (!"area" %in% colnames(X)) { 30 | if (!is.null(areas)) { 31 | X = data.table::merge.data.table(x = X, y = areas, by = "patchID") 32 | } else { 33 | stop("No 'area' column found, and no dataframe of patch areas provided") 34 | } 35 | } 36 | 37 | patch_area = X[, sum(area), by = group_cols] 38 | X = data.table::merge.data.table(x = X, y = patch_area, by = group_cols) 39 | pfam = X[, lapply(.SD, stats::weighted.mean, area/V1, na.rm = na.rm), by = group_cols, .SDcols = agg_cols] 40 | 41 | return(pfam) 42 | } 43 | -------------------------------------------------------------------------------- /R/generateTargets.R: -------------------------------------------------------------------------------- 1 | # setwd("...") 2 | # 3 | # # read in, add basin, zone, stratum 4 | # hill_ID=scan(file="../auxdata/hill.jc.h77.asc", skip=6, na.strings="*") 5 | # patch_ID=scan(file="../auxdata/patch.jc.h77.asc", skip=6, na.strings="*") 6 | # zone_ID = patch_ID 7 | # stratum_ID = patch_ID 8 | # LAI=scan(file="../auxdata/lai2007.lan.h77.asc", skip=6, na.strings="*") 9 | # #LAI=round(LAI, digits=5) 10 | # 11 | # x=rep(1,length(hill_ID)) # uses the number of cases 12 | # basin_ID=x 13 | # 14 | # #combine them 15 | # tmp = as.data.frame(cbind(basin_ID,hill_ID,zone_ID,patch_ID,stratum_ID,LAI)) 16 | # tmp2 = subset(tmp, is.na(tmp$patch_ID)==F) 17 | # tmp = aggregate(tmp2, by=list(tmp2$patch_ID, tmp2$zone_ID, tmp2$hill_ID, tmp2$basin_ID), mean) 18 | # #tmp = aggregate(tmp2, by=list(tmp2$basin_ID, tmp2$hill_ID, tmp2$zone_ID,tmp2$patch_ID), mean) 19 | # 20 | # #reorder them, remove subset_key 21 | # tmp=tmp[,c(5:10)] 22 | # 23 | # # remove null values 24 | # tmp = subset(tmp, is.na(tmp$LAI)==F) 25 | # tmp = subset(tmp, !tmp$LAI==-9999) # if user has another null value, input it here 26 | # tmp = subset(tmp, !tmp$LAI==Inf) # if user has another null value, input it here 27 | # tmp = format(tmp, scientific=FALSE) 28 | # 29 | # #Export and merge with a file header and target list 30 | # newheader = sprintf("%d num_stratum\n%d num_targets", nrow(tmp), length(tmp)-5) 31 | # write(newheader, file="../tecfiles/spinup_thresholds2007.jc.h77.txt") 32 | # targets = colnames(tmp) 33 | # targets = subset(targets, !targets=="basin_ID") 34 | # targets = subset(targets, !targets=="hill_ID") 35 | # targets = subset(targets, !targets=="zone_ID") 36 | # targets = subset(targets, !targets=="patch_ID") 37 | # targets = subset(targets, !targets=="stratum_ID") 38 | # write(targets, file="../tecfiles/spinup_thresholds2007.jc.h77.txt", append=T) 39 | # write.table(tmp, file="../tecfiles/spinup_thresholds2007.jc.h77.txt", append=T, quote=F, row.names=F) 40 | -------------------------------------------------------------------------------- /man/select_output_variables_R.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/select_output_variables_R.R 3 | \name{select_output_variables_R} 4 | \alias{select_output_variables_R} 5 | \title{Selects RHESSys output variables} 6 | \usage{ 7 | select_output_variables_R( 8 | output_variables, 9 | output_folder, 10 | output_filename, 11 | run, 12 | max_run = NULL, 13 | return_data = FALSE, 14 | out = NULL, 15 | no_write = FALSE 16 | ) 17 | } 18 | \arguments{ 19 | \item{output_variables}{Datafrane with named columns: "variables" containing variables of interest 20 | found in the header of rhessys output files, "out_file" points to the files containing the associated variables, 21 | this can be either the path to that file, can use the abbreviation for the different output types 22 | (patch daily = pd, patch daily grow = pdg etc.) and the files in output_folder will be parsed appropriately, 23 | or can use the fully written out space.time suffix, e.g. "patch.daily" or "grow_patch.daily"} 24 | 25 | \item{output_folder}{Folder where rhessys output is located (e.g. 'out')} 26 | 27 | \item{output_filename}{Base file name of standard rhessys output} 28 | 29 | \item{run}{Simulation number. Used to reset files in allsim at beginning of simulation} 30 | 31 | \item{max_run}{Max number of runs to collect output for - at run == max run, output will be pivoted from long to wide, 32 | and date and spatial info will be added.} 33 | 34 | \item{return_data}{TRUE/FALSE if the function should return a data.table of the selected output - for now only works if doing 1 run} 35 | 36 | \item{out}{Output location, if not will use default "allsim" within output folder} 37 | 38 | \item{no_write}{TRUE/FALSE to only return data within R, and not write any data. Only works is return_data == TRUE} 39 | } 40 | \description{ 41 | Somewhat optimized R-based read and subsetting of RHESSys output 42 | } 43 | -------------------------------------------------------------------------------- /man/IOin_rhessys_input.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/IOin_rhessys_input.R 3 | \name{IOin_rhessys_input} 4 | \alias{IOin_rhessys_input} 5 | \title{IOin_rhessys_input} 6 | \usage{ 7 | IOin_rhessys_input( 8 | version, 9 | tec_file, 10 | world_file, 11 | world_hdr_prefix, 12 | flowtable, 13 | start, 14 | end, 15 | output_folder, 16 | output_prefix, 17 | commandline_options, 18 | world_hdr_path = NULL, 19 | prefix_command = NULL 20 | ) 21 | } 22 | \arguments{ 23 | \item{version}{Path to compiled RHESSys binary.} 24 | 25 | \item{tec_file}{Path and name of input tec file. If also supplying a dataframe of tec events as created via IOin_tec_std() to run_rhessys_single(), a new directory will be created 26 | at the supplied path and name, with a new tec file within it. If not supplying a dataframe of tec events, this input refers to an existing tec file to be used.} 27 | 28 | \item{world_file}{Path and name of input world file.} 29 | 30 | \item{world_hdr_prefix}{Path and name for new folder where newly created hdr files will go.} 31 | 32 | \item{flowtable}{Path and name of input tec file.} 33 | 34 | \item{start}{Start date of simulation.} 35 | 36 | \item{end}{End date of simulation.} 37 | 38 | \item{output_folder}{Path to folder where simulation output will go.} 39 | 40 | \item{output_prefix}{Prefix for output files.} 41 | 42 | \item{commandline_options}{Commandline options to be passed to RHESSys, e.x. '-g' or '-p'} 43 | 44 | \item{world_hdr_path}{Path to where worldfile header file should be created/located. If left NULL, 45 | will use world_hdr_prefix as both path and file name.} 46 | 47 | \item{prefix_command}{A shell command to be run previous to the RHESSys command line call. 48 | This can be used to source a shell script, which itself can run multiple commands if needed.} 49 | } 50 | \description{ 51 | Basic inputs to run RHESSys 52 | } 53 | \author{ 54 | Will Burke 55 | } 56 | -------------------------------------------------------------------------------- /man/readin_rhessys_output.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/readin_rhessys_output.R 3 | \name{readin_rhessys_output} 4 | \alias{readin_rhessys_output} 5 | \title{readin_rhessys_output} 6 | \usage{ 7 | readin_rhessys_output( 8 | pre, 9 | read_space = "dynamic", 10 | read_time = "dynamic", 11 | read_grow = "dynamic", 12 | stat = FALSE, 13 | stat_time = c("wy", "wyd"), 14 | stat_space = "b", 15 | patch_family_agg = FALSE 16 | ) 17 | } 18 | \arguments{ 19 | \item{pre}{file prefix. Does not include spatial or temporal level of aggrigation 20 | ie. "my_watershed" NOT "my_watershed_basin" or "my_watershed_basin.daily"} 21 | 22 | \item{read_space}{Spatial levels of all_files to be read. Default is "dynamic" which will get all all_files 23 | that were output (with more than 1 line) with the matching prefix. Can also input a character 24 | vector with any combination of "b", "h", "z", "p", "c", "f". Even if all_files are specified, 25 | they will be checked if they have data, and only read if they do.} 26 | 27 | \item{read_time}{Timesteps of all_files to be read. Default is "dynamic". Can specify any combination of 28 | "h", "d", "m", "y", for hourly, daily, monthly, and yearly respectively} 29 | 30 | \item{read_grow}{Should grow files be read? Default is dynamic. Can also specify TRUE or FALSE} 31 | 32 | \item{stat}{Stat to be computed. Only tested with "mean".} 33 | 34 | \item{stat_time}{Not used yet - only produces "wy", "wyd" for now.} 35 | 36 | \item{stat_space}{Not used yet. All stats aggregate to basin level. In the future will have options here 37 | to retain finer spatial resolutions.} 38 | 39 | \item{patch_family_agg}{Should additional dataframes of aggregated patch families be created?} 40 | } 41 | \description{ 42 | Pulls output from a single RHESSys run into R, optionally calculates statistics. This should 43 | be much faster than readin_rhessys_output since it uses data.table file read and aggregation methods 44 | } 45 | -------------------------------------------------------------------------------- /man/rhessys_command.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rhessys_command.R 3 | \name{rhessys_command} 4 | \alias{rhessys_command} 5 | \title{Executes single RHESSys run on command line} 6 | \usage{ 7 | rhessys_command( 8 | rhessys_version, 9 | world_file, 10 | world_hdr_file, 11 | tec_file, 12 | flow_file, 13 | start_date, 14 | end_date, 15 | output_file = NULL, 16 | input_parameters, 17 | output_filter = NULL, 18 | par_option_ID = NULL, 19 | command_options, 20 | prefix_command = NULL, 21 | return_cmd = FALSE 22 | ) 23 | } 24 | \arguments{ 25 | \item{rhessys_version}{Path and file name of compiled version of RHESSys.} 26 | 27 | \item{world_file}{Oath and file name of RHESSys world_file.} 28 | 29 | \item{world_hdr_file}{Path and file name of RHESSys header file} 30 | 31 | \item{tec_file}{Path and file name of RHESSys temporal event control (tec) file} 32 | 33 | \item{flow_file}{Path and file name of RHESSys flow table file} 34 | 35 | \item{start_date}{Start date character vector in format , delimited by spaces. Ex. '1990 12 30 01'} 36 | 37 | \item{end_date}{End date character vector, same format as start_date} 38 | 39 | \item{output_file}{Path and base file name of RHESSys output} 40 | 41 | \item{input_parameters}{Soil parameters passed to RHESSys command line.} 42 | 43 | \item{output_filter}{Path to a yaml formatted output filter.} 44 | 45 | \item{command_options}{RHESSys command line options, ex. '-g' or '-p'.} 46 | 47 | \item{prefix_command}{A shell command to be run previous to the RHESSys command line call.} 48 | 49 | \item{return_cmd}{true/false passed from run_rhessys_single 50 | This can be used to source a shell script, which itself can run multiple commands if needed.} 51 | } 52 | \description{ 53 | \code{rhessys_command} Assembles command line RHESSys call, and runs it. See the RHESSys wiki: 54 | https://github.com/RHESSys/RHESSys/wiki/RHESSys-command-line-options 55 | } 56 | -------------------------------------------------------------------------------- /R/IOin_tec_std.R: -------------------------------------------------------------------------------- 1 | #' IOin_tec_std 2 | #' 3 | #' Input function to construct a dataframe of standard tec events, including start, grow start, and output state 4 | #' 5 | #' @param start start date of run 6 | #' @param end End date of run - the last entire day to be run 7 | #' @param output_state TRUE/FALSE if an output_current_state tec event should be scheduled at the end of the simulation 8 | #' 9 | #' @author Will Burke 10 | #' 11 | #' @export 12 | 13 | IOin_tec_std = function(start, end, output_state = TRUE) { 14 | 15 | # if inputs are rhessys format 16 | # if (grepl(pattern = "\\d{4} \\d{1,2} \\d{1,2} \\d{1,2}", x = start)) { 17 | # } 18 | options(stringsAsFactors = F) 19 | 20 | if (class(start) == "Date") { 21 | start_rh = format.Date(x = start, "%Y %m %d") 22 | start_rh = paste0(start_rh, " 1") 23 | } else { 24 | start_rh = start 25 | } 26 | 27 | if (class(end) == "Date") { 28 | end_rh = format.Date(x = end, "%Y %m %d") 29 | end_rh = paste0(end_rh, " 24") 30 | } else { 31 | end_rh = end 32 | } 33 | 34 | start_split = unlist(strsplit(as.character(start_rh), split = " ")) 35 | end_split = unlist(strsplit(as.character(end_rh), split = " ")) 36 | 37 | input_tec_data <- data.frame( 38 | year = integer(), 39 | month = integer(), 40 | day = integer(), 41 | hour = integer(), 42 | name = character() 43 | ) 44 | 45 | input_tec_data[1, ] <- c(start_split, "print_daily_on") 46 | input_tec_data[2, ] <- c(start_split[1:3], as.numeric(start_split[4])+1, "print_daily_growth_on") 47 | 48 | if (output_state) { 49 | end_time = as.POSIXct(end_rh, format="%Y %m %d %H") 50 | output_time = end_time - lubridate::hours(1) 51 | if (format(output_time, "%H") == "00") { 52 | output_time = output_time - lubridate::minutes(60) 53 | } 54 | output_split = unlist(strsplit(format(output_time, "%Y %m %d %H"), split = " ")) 55 | input_tec_data[3, ] <- c(output_split, "output_current_state") 56 | 57 | } 58 | 59 | return(input_tec_data) 60 | } 61 | -------------------------------------------------------------------------------- /R/select_output_variables.R: -------------------------------------------------------------------------------- 1 | #' Selects RHESSys output variables 2 | #' 3 | #' for now simply paralleling the approach used with awks but with R input 4 | #' 5 | #' @param output_variables A data frame containing containing variable of interest, location/name of awk file (relative to 6 | #' output_file location), and the location/name of rhessys output file with variable 7 | #' of interest. 8 | #' @param output_folder Folder where rhessys output is located (e.g. 'out') 9 | #' @param run Simulation number. Used to reset files in allsim at beginning of simulation 10 | #' @param output_initiation For multiple scenarios 11 | #' @export 12 | select_output_variables <- function(output_variables, output_folder,run,output_initiation){ 13 | 14 | if (run == 1 && output_initiation == 1){ 15 | for (dd in seq_len(nrow(output_variables))){ 16 | system(sprintf("rm %s/allsim/%s", output_folder, output_variables$variable[dd])) 17 | system(sprintf("echo > %s/allsim/%s", output_folder, output_variables$variable[dd])) 18 | } 19 | } 20 | 21 | for (cc in seq_len(nrow(output_variables))){ 22 | system(sprintf("rm %s/allsim/t%s", output_folder, output_variables$variable[cc])) 23 | fin_name = sprintf("%s/%s", output_folder, output_variables$out_file[cc]) 24 | results = read.table(fin_name, header=T) 25 | if (!length(output_variables$id_extract[cc] > 0) == 0) { 26 | results = subset(results, stratumID == output_variables$id_extract[cc]) 27 | } 28 | fout_name = sprintf("%s/allsim/t%s", output_folder, output_variables$variable[cc]) 29 | write(signif(results[,output_variables$variable[cc]],5), ncolumns=1, file=fout_name) 30 | system(sprintf("paste %s/allsim/%s %s/allsim/t%s > %s/allsim/new%s", output_folder, output_variables$variable[cc], output_folder, output_variables$variable[cc], output_folder, output_variables$variable[cc])) 31 | system(sprintf("mv %s/allsim/new%s %s/allsim/%s", output_folder, output_variables$variable[cc], output_folder, output_variables$variable[cc])) 32 | } 33 | } 34 | 35 | 36 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # RHESSysIOinR 5 | 6 | ## Overview 7 | 8 | RHESSysIOinR contains functions for running 9 | [RHESSys](https://github.com/RHESSys/RHESSys) in R and processing 10 | output. The objective of this package is to clearly and efficiently 11 | produce R code that can be used to setup RHESSys, conduct calibrations 12 | and simulations, and process output. This package supports a 13 | long(er)-term goal of having experiments involving RHESSys be 14 | reproducible. \#OpenScience 15 | 16 | ## Installation 17 | 18 | You can install RHESSysIOinR directly from R 19 | 20 | ``` r 21 | # install.packages("devtools") 22 | devtools::install_github("RHESSys/RHESSysIOinR") 23 | ``` 24 | 25 | ## Contents 26 | 27 | ### run\_rhessys() 28 | 29 | The `run_rhessys()` function is the core method used to setup and run 30 | RHESSys. Documentation on how to set up and use the function is 31 | contained in the package. 32 | 33 | ### Utilities and helper funcitons 34 | 35 | 36 | 37 | 38 | 39 | - `build_redefine()`: generates redefine worldfiles 40 | - `cal.wyd()`: calculates wateryear day 41 | - `change_def_file()`: create new def file based on existing file and 42 | input pars 43 | - `clim_auto()`: helper to simplify climate input for `run_rhessys()` 44 | - `evaluation()`: used to evaluate model output 45 | - `input_tec()`: helper to simplify input of tec events 46 | - `mkdate()`: generates wy, yd, and wyd based on day, month, year 47 | - `read_clim()`: reads rhessys formatted climate data into R 48 | - `readin_rhessys_output()`: reads rhessys output into R, includes 49 | some subsetting and simply aggregation 50 | - `readin_rhessys_output_old()`: legacy method to read in rhessys 51 | output 52 | - `tec_repeat()`: generates repeating tec events for input into 53 | `run_rhessys()`, can also copy+rename a redefine file as needed 54 | - `write_sample_clim()`: generate new climate based on existing 55 | climate 56 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r setup, include=FALSE} 8 | knitr::opts_chunk$set(echo = TRUE) 9 | ``` 10 | 11 | # RHESSysIOinR 12 | 13 | ## Overview 14 | 15 | RHESSysIOinR contains functions for running [RHESSys](https://github.com/RHESSys/RHESSys) in R and processing output. The objective of this package is to clearly and efficiently produce R code that can be used to setup RHESSys, conduct calibrations and simulations, and process output. This package supports a long(er)-term goal of having experiments involving RHESSys be reproducible. #OpenScience 16 | 17 | ## Installation 18 | You can install RHESSysIOinR directly from R 19 | ```{r, eval = FALSE} 20 | # install.packages("devtools") 21 | devtools::install_github("RHESSys/RHESSysIOinR") 22 | ``` 23 | 24 | ## Contents 25 | 26 | ### run_rhessys() 27 | 28 | The `run_rhessys()` function is the core method used to setup and run RHESSys. Documentation on how to set up and use the function is contained in the package. 29 | 30 | ### Utilities and helper funcitons 31 | 32 | 33 | 34 | 35 | * `build_redefine()`: generates redefine worldfiles 36 | * `cal.wyd()`: calculates wateryear day 37 | * `change_def_file()`: create new def file based on existing file and input pars 38 | * `clim_auto()`: helper to simplify climate input for `run_rhessys()` 39 | * `evaluation()`: used to evaluate model output 40 | * `input_tec()`: helper to simplify input of tec events 41 | * `mkdate()`: generates wy, yd, and wyd based on day, month, year 42 | * `read_clim()`: reads rhessys formatted climate data into R 43 | * `readin_rhessys_output()`: reads rhessys output into R, includes some subsetting and simply aggregation 44 | * `readin_rhessys_output_old()`: legacy method to read in rhessys output 45 | * `tec_repeat()`: generates repeating tec events for input into `run_rhessys()`, can also copy+rename a redefine file as needed 46 | * `write_sample_clim()`: generate new climate based on existing climate 47 | 48 | 49 | -------------------------------------------------------------------------------- /R/IOin_hdr.R: -------------------------------------------------------------------------------- 1 | #' IOin_hdr 2 | #' 3 | #' Creates a header file based on specified parameter definition files and climate basestations. 4 | #' @param basin Path to basin parameter definition file. 5 | #' @param hillslope Path to hillslope parameter definition file.(s) 6 | #' @param zone Path to zone parameter definition file(s). 7 | #' @param soil Path to soil parameter definition file(s). 8 | #' @param landuse Path to landuse parameter definition file(s). 9 | #' @param stratum Path to stratum parameter definition file(s). 10 | #' @param fire Path to fire parameter definition file. 11 | #' @param fire_grid_prefix Path and basename/prefix name of the fire grid files used for the RHESSys WMFire model. 12 | #' @param spinup Path to spinup parameter definition file(s). 13 | #' @param basestations Path to basin climate basestation file(s). 14 | #' 15 | #' @author Will Burke 16 | #' 17 | #' @export 18 | 19 | # LIST NAMING - MIRRORS INPUT ARS 20 | # shorter, and still clear since the whole object is the header info, don't need to specify def 21 | # ORDERING - keep in current order, same as args, should use names to reference though 22 | 23 | 24 | IOin_hdr = function(basin, 25 | hillslope, 26 | zone, 27 | soil, 28 | landuse, 29 | stratum, 30 | fire = NULL, 31 | fire_grid_prefix = NULL, 32 | spinup = NULL, 33 | basestations) { 34 | 35 | input_hdr_list <- list() 36 | 37 | # TODO check for each file, warn if missing - should work for everything expect clim which might be generated 38 | # remember each input can be a character vector of length 1+ 39 | 40 | input_hdr_list$basin_def <- basin 41 | input_hdr_list$hillslope_def <- hillslope 42 | input_hdr_list$zone_def <- zone 43 | input_hdr_list$soil_def <- soil 44 | input_hdr_list$landuse_def <- landuse 45 | input_hdr_list$stratum_def <- stratum 46 | input_hdr_list$fire_def <- fire 47 | input_hdr_list$fire_grid_prefix <- fire_grid_prefix 48 | input_hdr_list$spinup_def <- spinup 49 | input_hdr_list$base_stations <- basestations 50 | 51 | return(input_hdr_list) 52 | 53 | } 54 | -------------------------------------------------------------------------------- /R/read_output_filter.R: -------------------------------------------------------------------------------- 1 | #' read_output_filter 2 | #' 3 | #' Reads a yaml format RHESSys output filter and creates a R list. Handles tabs in input file, 4 | #' @param filter_in Path to the yaml filter file 5 | #' @author Will Burke 6 | #' @export 7 | 8 | read_output_filter = function(filter_in) { 9 | 10 | # ----- handle tabs instead of spaces ----- 11 | read_try = try(yaml::yaml.load_file(filter_in, readLines.warn = F), silent = T) 12 | if (class(read_try) == "try-error" && grepl("cannot open the connection", attr(read_try, 'condition'))) { 13 | stop("Could not load '", filter_in, "', no such file at the specified path.") 14 | } 15 | if (class(read_try) == "try-error" && grepl("Scanner error", attr(read_try, 'condition'))) { 16 | filter_tabs = readLines(filter_in, warn = F) 17 | filter_clean = gsub(pattern = "\\t", replacement = " ", x = filter_tabs) 18 | 19 | # ----- handle multiple filters mapped as 'filter' ----- 20 | read_try2 = try(yaml::yaml.load(filter_clean), silent = T) 21 | if (class(read_try2) == "try-error" && grepl("Duplicate map key: 'filter'", attr(read_try2, 'condition'))) { 22 | filter_loc = grep("filter", filter_clean) 23 | replacement = paste0('filter',seq_along(filter_loc)) 24 | filter_clean[filter_loc] = mapply(gsub, pattern = 'filter', replacement, filter_clean[filter_loc]) 25 | # if it fails here, there's something else wrong, not just the filter missing unique IDs 26 | read_try2 = yaml::yaml.load(filter_clean) 27 | } 28 | read_try = read_try2 29 | } 30 | 31 | # ----- handle multiple filters mapped as 'filter' ----- 32 | if (class(read_try) == "try-error" && grepl("Duplicate map key: 'filter'", attr(read_try, 'condition'))) { 33 | filter_clean = readLines(filter_in, warn = F) 34 | filter_loc = grep("filter", filter_clean) 35 | replacement = paste0('filter', seq_along(filter_loc)) 36 | filter_clean[filter_loc] = mapply(gsub, pattern = 'filter', replacement, filter_clean[filter_loc]) 37 | # if it fails here, there's something else wrong, not just the filter missing unique IDs 38 | read_try = yaml::yaml.load(filter_clean) 39 | } 40 | 41 | filter = read_try 42 | names(filter) = rep("filter", length(filter)) 43 | 44 | return(filter) 45 | } 46 | -------------------------------------------------------------------------------- /man/watbal_patch_mult.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/watbal_patch_mult.R 3 | \name{watbal_patch_mult} 4 | \alias{watbal_patch_mult} 5 | \title{watbal_patch_mult.R} 6 | \usage{ 7 | watbal_patch_mult(pd, cd) 8 | } 9 | \arguments{ 10 | \item{pd}{Patch daily rhessys output, read into R with a funciton like `readin_rhessys_output()`} 11 | 12 | \item{cd}{Canopy daily rhessys output, read into R with a funciton like `readin_rhessys_output()`} 13 | } 14 | \description{ 15 | Water balance for multiple patches daily RHESSys output. 16 | } 17 | \details{ 18 | Before you run the water balance script below, you must have added a "rain" column to your patch daily output 19 | data that contains the patch-specific precipitation. Be careful to add the right precip values if your worldfile 20 | uses multiple base stations, isohyets, or a precip lapse rate. 21 | 22 | This function will add a number of fields to your patch output file, the last of which will be called "watbal". 23 | This is your water balance error. You should see a minor numerical error here even if your water balances (on the order of 10^-6). 24 | If your watbal values are negative then water inputs are less than water outputs, and vice versa. 25 | 26 | If you have multiple patches with only a single stratum per patch, you need to run a different script to loop 27 | through patches individually, call the water balance function, then write the output. For example, if your 28 | patch output is called "pd", your canopy output is called "cd", and you want the water balance output written 29 | to atable called "out", then you would type: "out=pwatbalmult(pd,cd)". This creates a new output table, called 30 | "out" in this example, that contains date fields and a single column for each patch with the water balance error 31 | for that patch (called "P345","P578","P900", etc. where the field label number matches the patch ID). You might 32 | see a minor numerical error here even if your water balances (on the order of 10^-6). If your watbal values are 33 | negative then water inputs are less than wateroutputs and vice versa. Note that this may take a long time to run 34 | if you have many patches; better to run on a single patch or a single hillslope than a full basin. 35 | } 36 | -------------------------------------------------------------------------------- /R/modify_output_filter.R: -------------------------------------------------------------------------------- 1 | #' modify_output_filter 2 | #' 3 | #' Modify a single existing output filter, either from file or based on an existing R object. Will error if given multiple filters. 4 | #' This could be done via normal list modification in R as well. 5 | #' @inheritParams read_output_filter 6 | #' @inheritParams build_output_filter 7 | #' @author Will Burke 8 | #' 9 | #' @export 10 | 11 | modify_output_filter = function(filter_in, 12 | timestep = NULL, 13 | output_format = NULL, 14 | output_path = NULL, 15 | output_filename = NULL, 16 | spatial_level = NULL, 17 | spatial_ID = NULL, 18 | variables = NULL) { 19 | 20 | if (!is.list(filter_in)) { 21 | filter = read_output_filter(filter_in = filter_in) 22 | } 23 | 24 | if (length(filter) > 1) { 25 | stop("Can only modify 1 filter at a time.") 26 | } 27 | 28 | if (!is.null(timestep)) { filter[[1]]$timestep = timestep } 29 | 30 | if (!is.null(output_format)) { filter[[1]]$output$format = output_format } 31 | 32 | if (!is.null(output_path)) { filter[[1]]$output$path = output_path } 33 | 34 | if (!is.null(output_filename)) { filter[[1]]$output$filename = output_filename } 35 | 36 | if (!is.null(spatial_level)) { 37 | if (is.null(variables)) { 38 | warning("If spatial level is being changed, variables will almost certainly need to be changed.") 39 | } 40 | 41 | filter[[1]][names(filter[[1]]) %in% c('basin', 'hillslope', 'zone', 'patch', 'stratum')] = NULL 42 | 43 | filter[[1]]$tmp = list("ids" = spatial_ID, "variables" = paste(variables, collapse = ", ")) 44 | 45 | names(filter[[1]])[names(filter[[1]]) == "tmp"] = spatial_level 46 | 47 | } 48 | 49 | if (!is.null(spatial_ID)) { 50 | filter[[1]][[which(names(filter[[1]]) %in% c('basin', 'hillslope', 'zone', 'patch', 'stratum'))]]$ids = spatial_ID 51 | } 52 | 53 | if (!is.null(variables)) { 54 | filter[[1]][[which(names(filter[[1]]) %in% c('basin', 'hillslope', 'zone', 'patch', 'stratum'))]]$variables = paste(variables, collapse = ", ") 55 | 56 | } 57 | 58 | return(filter) 59 | 60 | } 61 | -------------------------------------------------------------------------------- /man/watbal_patch.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/watbal_patch.R 3 | \name{watbal_patch} 4 | \alias{watbal_patch} 5 | \title{watbal_patch.R} 6 | \usage{ 7 | watbal_patch(pd, cd) 8 | } 9 | \arguments{ 10 | \item{pd}{Patch daily rhessys output, read into R with a funciton like `readin_rhessys_output()`} 11 | 12 | \item{cd}{Canopy daily rhessys output, read into R with a funciton like `readin_rhessys_output()`} 13 | } 14 | \description{ 15 | Water balance for a single patch daily RHESSys output. 16 | } 17 | \details{ 18 | Before you run the water balance script below, you must have added a "rain" column to your patch daily output 19 | data that contains the patch-specific precipitation. Be careful to add the right precip values if your worldfile 20 | uses multiple base stations, isohyets, or a precip lapse rate. 21 | 22 | This function will add a number of fields to your patch output file, the last of which will be called "watbal". 23 | This is your water balance error. You should see a minor numerical error here even if your water balances (on the order of 10^-6). 24 | If your watbal values are negative then water inputs are less than water outputs, and vice versa. 25 | 26 | If you have multiple patches with only a single stratum per patch, you need to run a different script to loop 27 | through patches individually, call the water balance function, then write the output. For example, if your 28 | patch output is called "rp", your canopy output is called "rc", and you want the water balance output written 29 | to atable called "out", then you would type: "out=pwatbalmult(rp,rc)". This creates a new output table, called 30 | "out" in this example, that contains date fields and a single column for each patch with the water balance error 31 | for that patch (called "P345","P578","P900", etc. where the field label number matches the patch ID). You might 32 | see a minor numerical error here even if your water balances (on the order of 10^-6). If your watbal values are 33 | negative then water inputs are less than wateroutputs and vice versa. Note that this may take a long time to run 34 | if you have many patches; better to run on a single patch or a single hillslope than a full basin. 35 | 36 | See `watbal_patch_mult` for multiple patches. 37 | } 38 | -------------------------------------------------------------------------------- /deprecated_functions/make_hdr_file.R: -------------------------------------------------------------------------------- 1 | #' Produces components of a hdr file 2 | #' 3 | #' This function generates the lines in a hdr file associated with a single def 4 | #' file. 5 | #' 6 | #' @param master_table Data frame of a single row with references to def file 7 | #' number. A value of zero for the def file number indicates that the original 8 | #' def file is to be used. Higher numbers are added as a extension to the file 9 | #' name. 10 | #' @param path_initial Path to the non-differiated def file 11 | #' @param num_files ??? 12 | #' @param default_file ??? 13 | #' 14 | #' @export 15 | make_hdr_file <- function(master_table, 16 | path_initial, 17 | num_files, 18 | default_file){ 19 | 20 | # --------------------------------------------------------------------- 21 | # Function for assembling paths for each hdr input 22 | def_file_df <- function(def, default_file = "default_file"){ 23 | #output <- lapply(def, function(x) c(x, default_file)) magrittr::%>% do.call(rbind, .) 24 | output0 <- lapply(def, function(x) c(x, default_file)) 25 | output = do.call(rbind, output0) 26 | colnames(output) <- c("c1", "c2") 27 | return(output) 28 | } 29 | 30 | # --------------------------------------------------------------------- 31 | 32 | hdr_out <- data.frame(c1 = length(path_initial), c2 = num_files, stringsAsFactors=FALSE) 33 | 34 | path_full <- rep(NA,length(path_initial)) 35 | for (zz in seq_along(path_initial)){ 36 | 37 | # Def file paths and names 38 | path_short <- dirname(path_initial)[zz] 39 | name_no_ext <- tools::file_path_sans_ext(basename(path_initial))[zz] 40 | ext <- tools::file_ext(path_initial)[zz] 41 | path_new <- file.path(path_short, name_no_ext) 42 | 43 | file_name_ext <- ifelse(ext =="def", master_table[path_initial][zz], master_table["dated_id"]) 44 | 45 | # Determine the type of def file used 46 | if (file_name_ext == 0){ 47 | # Reference original def file 48 | path_full[zz] <- path_initial[zz] 49 | } else { 50 | # Reference new def file 51 | path_full[zz] <- file.path(path_new, paste(name_no_ext,"_",file_name_ext,".",ext,sep="")) 52 | } 53 | } 54 | 55 | hdr_out <- rbind(hdr_out, def_file_df(path_full, default_file)) 56 | 57 | return(hdr_out) 58 | } 59 | -------------------------------------------------------------------------------- /R/watbal_basin_of.R: -------------------------------------------------------------------------------- 1 | #' watbal_basin_of.R 2 | #' 3 | #' Water balance for basin daily RHESSys output, as generated by outputfilters. To run, if your basin output is called "bd" type "bd=watbal(bd)". 4 | #' This will add a number of fields to your basin output file, the last of which will be called "watbal". 5 | #' This is your water balance error. You should see a minor numerical error here even if your water balances 6 | #' (on the order of 10^-6). If your watbal values are negative then water inputs are less than water outputs, and vice versa. 7 | #' @param bd The basin daily outputs from rhessys, most easily retrieved via `readin_rhessys_output()` 8 | #' @export 9 | 10 | watbal_basin_of = function(bd) { 11 | 12 | # some error checks here 13 | req_cols = c("total_water_in", "evaporation", "evaporation_surf", "exfiltration_sat_zone", 14 | "exfiltration_unsat_zone", "transpiration_sat_zone", "transpiration_unsat_zone", "streamflow", "gw.Qout", "sat_deficit", "rz_storage", "unsat_storage", 15 | "detention_store", "litter.rain_stored", "gw.storage","canopy_rain_stored", "canopy_snow_stored","snowpack.water_equivalent_depth") 16 | 17 | bd$evap = with(bd, evaporation+evaporation_surf+exfiltration_sat_zone+exfiltration_unsat_zone) 18 | bd$trans = with(bd, transpiration_unsat_zone+transpiration_sat_zone ) 19 | bd$streamflow = with(bd, streamflow+gw.Qout) 20 | bd$canopy_store = with(bd, canopy_snow_stored+canopy_rain_stored ) 21 | if (!is.data.frame(bd) || any(!req_cols %in% colnames(bd))) { 22 | cat("Input is either not a data frame or is missing the correct columns") 23 | return(NA) 24 | } 25 | 26 | # main fluxes 27 | bd$watbal_flux = with(bd, total_water_in - streamflow - trans - evap) 28 | 29 | # changes in stores 30 | bd$sd = with(bd, sat_deficit - rz_storage - unsat_storage) 31 | bd$sddiff = c(0, diff(bd$sd)) 32 | bd$snodiff = c(0, diff(bd$snowpack.water_equivalent_depth)) 33 | bd$detdiff = c(0, diff(bd$detention_store)) 34 | bd$litdiff = c(0, diff(bd$litter.rain_stored)) 35 | bd$candiff = c(0, diff(bd$canopy_store)) 36 | bd$gwdiff = c(0, diff(bd$gw.storage)) 37 | 38 | # fluxes minus stores 39 | bd$watbal = with(bd, watbal_flux + sddiff - snodiff - detdiff - litdiff - candiff - gwdiff) 40 | bd$watbal[1] = 0.0 41 | # max(bd$watbal) 42 | # summary(bd$watbal) 43 | # hist(bd$watbal) 44 | 45 | return(bd) 46 | 47 | } 48 | -------------------------------------------------------------------------------- /man/IOin_cmd_pars.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/IOin_cmd_pars.R 3 | \name{IOin_cmd_pars} 4 | \alias{IOin_cmd_pars} 5 | \title{IOin_cmd_pars} 6 | \usage{ 7 | IOin_cmd_pars( 8 | m = 1, 9 | k = 1, 10 | soil_dep = 1, 11 | m_v = 1, 12 | k_v = 1, 13 | pa = 1, 14 | po = 1, 15 | gw1 = 1, 16 | gw2 = 1, 17 | vgseng1 = 1, 18 | vgseng2 = 1, 19 | vgseng3 = 1, 20 | n = 1, 21 | pct_range = 0.25 22 | ) 23 | } 24 | \arguments{ 25 | \item{m}{Decay of hydraulic conductivity with depth.} 26 | 27 | \item{k}{Hydraulic conductivity at the surface.} 28 | 29 | \item{soil_dep}{Soil depth.} 30 | 31 | \item{m_v}{Multiplier to scale the vertical decay of hydraulic conductivity with depth.} 32 | 33 | \item{k_v}{Multiplier to scale the vertical hydraulic conductivity at the surface.} 34 | 35 | \item{pa}{Multiplier to scale the pore size index, set in soil def file.} 36 | 37 | \item{po}{Multiplier to scale the psi air entry, set in soil def file.} 38 | 39 | \item{gw1}{Multiplier on the sat_to_gw_coeff parameter set in the soil definition file 40 | (representing the amount of water moving from the saturated store to the groundwater store).} 41 | 42 | \item{gw2}{Multiplier on the gw_loss_coeff parameter in the hillslope default file 43 | (representing the amount of water moving from the groundwater store to the stream).} 44 | 45 | \item{vgseng1}{Multiples specific leaf areas.} 46 | 47 | \item{vgseng2}{Multiplies the ratio of shaded to sunlit leaf area.} 48 | 49 | \item{vgseng3}{Multiplier used only with the Dickenson algorithm of carbon allocation 50 | (set with the epc.allocation_flag variable in the vegetation definition file). It changes 51 | the allocation of net photosynthate sensitivity based on the current LAI. If not using the 52 | Dickenson strategy of carbon allocation (i.e. using Waring or default Constant strategies), 53 | set third value to 1.0. (i.e. -vgsen 1.0 2.0 1.0)} 54 | 55 | \item{n}{The number of parameter sets to generate.} 56 | 57 | \item{pct_range}{The percent range of variation from input values over which sampling (if any), will happen.} 58 | } 59 | \description{ 60 | Input standard command line soil parameters for RHESSys, see https://github.com/RHESSys/RHESSys/wiki/RHESSys-command-line-options 61 | These parameters are MULTIPLIERS on the existing paramters in the definition files. 62 | } 63 | \author{ 64 | Will Burke 65 | } 66 | -------------------------------------------------------------------------------- /R/cleanup_rhessys.R: -------------------------------------------------------------------------------- 1 | #' cleanup_rhessys 2 | #' 3 | #' Function to remove rhessys output, options to move it to a specific folder or one w unique ID, 4 | #' only delete/move output based on a pattern 5 | #' @param dir Directory to look for output files within. To be safe function will not look recursively in subfolders. 6 | #' @param output_name The base name of the rhessys output, used to select only one set of rhessy outputs 7 | #' (still getting all of the varyious spatial + temporal levels for that output) 8 | #' @param copy TRUE/FALSE should the output be copied or just deleted 9 | #' @param destination Specify a destination for output to be copied to, if left NULL a folder will be 10 | #' generated with a unique name with format rh_out_datetime 11 | #' @author William Burke 12 | #' @export 13 | 14 | cleanup_rhessys = function(dir = NULL, output_name = NULL, copy = TRUE, destination = NULL) { 15 | 16 | # find all eligable rhessys outputs + RHESSysIO outputs 17 | if (is.null(dir)) { 18 | dir = getwd() 19 | } 20 | 21 | rh_pattern = "\\.(hourly|daily|monthly|yearly|params)$" 22 | # subset just those that match pattern 23 | if (!is.null(output_name)) { 24 | rh_pattern = paste0(output_name, ".*",rh_pattern) 25 | } 26 | # if there's issues with the suffixes, copy the explicit ones from select_output_variables_R.R 27 | rh_files = list.files(path = dir, pattern = rh_pattern,full.names = F) 28 | 29 | if (copy) { 30 | # copy the files 31 | if (!is.null(destination)) { 32 | # check destination folder is valid/make it if it's not 33 | # add note to console if you made a folder 34 | if (!dir.exists(destination)) { 35 | dir.create(path = file.path(dir, destination)) 36 | file.rename(from = file.path(dir, rh_files), to = file.path(dir,destination,rh_files)) 37 | } 38 | } else { 39 | # make a folder with a unique name - rh_out_date+time 40 | # cat to console 41 | dirname = paste0("rh_out_", gsub( ":", ".", sub( " ", "_", Sys.time()))) 42 | dir.create(path = file.path(dir, dirname)) 43 | cat("Created directory '",file.path(dir, dirname),"'\n", sep = "") 44 | shh = file.rename(from = file.path(dir, rh_files), to = file.path(dir,dirname,rh_files)) 45 | cat("Moved RHESSys output files to new directory\n") 46 | } 47 | } else { 48 | # delete the files 49 | shh = file.remove(file.path(dir, rh_files)) 50 | cat("Deleted RHESSys output files from", dir,"\n") 51 | } 52 | 53 | } 54 | -------------------------------------------------------------------------------- /R/watbal_patch_mult.R: -------------------------------------------------------------------------------- 1 | #' watbal_patch_mult.R 2 | #' 3 | #' Water balance for multiple patches daily RHESSys output. 4 | #' 5 | #' Before you run the water balance script below, you must have added a "rain" column to your patch daily output 6 | #' data that contains the patch-specific precipitation. Be careful to add the right precip values if your worldfile 7 | #' uses multiple base stations, isohyets, or a precip lapse rate. 8 | #' 9 | #' This function will add a number of fields to your patch output file, the last of which will be called "watbal". 10 | #' This is your water balance error. You should see a minor numerical error here even if your water balances (on the order of 10^-6). 11 | #' If your watbal values are negative then water inputs are less than water outputs, and vice versa. 12 | #' 13 | #' If you have multiple patches with only a single stratum per patch, you need to run a different script to loop 14 | #' through patches individually, call the water balance function, then write the output. For example, if your 15 | #' patch output is called "pd", your canopy output is called "cd", and you want the water balance output written 16 | #' to atable called "out", then you would type: "out=pwatbalmult(pd,cd)". This creates a new output table, called 17 | #' "out" in this example, that contains date fields and a single column for each patch with the water balance error 18 | #' for that patch (called "P345","P578","P900", etc. where the field label number matches the patch ID). You might 19 | #' see a minor numerical error here even if your water balances (on the order of 10^-6). If your watbal values are 20 | #' negative then water inputs are less than wateroutputs and vice versa. Note that this may take a long time to run 21 | #' if you have many patches; better to run on a single patch or a single hillslope than a full basin. 22 | #' 23 | #' @param pd Patch daily rhessys output, read into R with a funciton like `readin_rhessys_output()` 24 | #' @param cd Canopy daily rhessys output, read into R with a funciton like `readin_rhessys_output()` 25 | #' 26 | #' @export 27 | 28 | watbal_patch_mult = function(pd, cd) { 29 | pids = unique(pd$patchID) 30 | tmp = subset(pd, pd$patchID == pids[1]) 31 | wbp = tmp[c("day", "month", "year")] 32 | wbp = add_dates(wbp) 33 | n = ncol(wbp) + 1 34 | for (i in pids) { 35 | tmpp = subset(pd, pd$patchID == i) 36 | tmpc = subset(cd, cd$patchID == i) 37 | tmpp = watbal_patch(tmpp, tmpc) 38 | wbp[, n] = tmpp$watbal 39 | names(wbp)[c(n)] = paste("P", i, sep = "") 40 | n = n + 1 41 | } 42 | return(wbp) 43 | } 44 | -------------------------------------------------------------------------------- /R/IOin_def_pars_sobol.R: -------------------------------------------------------------------------------- 1 | #' IOin_def_pars_sobol 2 | #' 3 | #' Geneartes multiple def file changes based on sobol sensativity. 4 | #' @param ... Any number of lists, each containing 3 elements in format: list("", "", ) 5 | #' @param nboot The number of bootstraps to run for sobol2007 6 | #' @param rm_dup TRUE/FALSE should duplicate def file + variable entries be automatically removed? A warning will occur regardless. 7 | 8 | #' @author Will Burke 9 | #' 10 | #' @export 11 | 12 | 13 | IOin_def_pars_sobol = function(..., nboot = 100, rm_dup, sobolfunction=sensitivity::sobol2007, return_sobol=FALSE) { 14 | 15 | pars = list(...) 16 | 17 | # if ... is already a list of lists, ie you're inputting the output of this function, unlist to keep format correct 18 | if (length(pars) == 1 && all(lapply(pars[[1]], length) == 3)) { 19 | pars = pars[[1]] 20 | } 21 | # some checks here, should get done regardless but mostly important for multiple param sets 22 | if (any(lapply(pars, length) != 3)) { 23 | stop("Each input list must have 4 elements - Def_file, Variable, Prior_dist") 24 | } 25 | # name some things to be helpful 26 | name_pars = function(x) { 27 | names(x) = c("Def_file", "Variable","Prior_dist") 28 | return(x) 29 | } 30 | pars = lapply(pars, name_pars) 31 | 32 | # check for duplicate def_file + variable entries, if rm_dup is T, keep only the first 33 | file_var = paste0(sapply(pars, "[[",1), "--", sapply(pars, "[[",2)) 34 | if (length(pars[duplicated(file_var)]) > 0) { 35 | warning("There are duplicate def file + variable entries, these should be corrected before running RHESSys.") 36 | if (rm_dup) { 37 | pars[duplicated(file_var)] = NULL 38 | cat("Duplicate def file + variable entries have been removed.\n") 39 | } 40 | } 41 | 42 | par_dists = sapply(pars, "[[", 3) 43 | 44 | # sobol requires two different evenly numbered samples so we will split in two 45 | 46 | npars = nrow(par_dists) 47 | colnames(par_dists) = sapply(pars, "[[", 2) 48 | if ((npars %% 2) == 1) 49 | par_dists = par_dists[1:(npars-1),] 50 | npars = nrow(par_dists) 51 | x1 = par_dists[1:(npars/2),] 52 | x2 = par_dists[((npars/2)+1):npars,] 53 | 54 | 55 | sobol_out = sobolfunction(model = NULL, X1 = x1, X2 = x2, nboot = nboot) 56 | 57 | pars_out = mapply(function(x, y) {x[[3]] = y; return(x)}, x = pars, y = as.data.frame(sobol_out$X), SIMPLIFY = F) 58 | 59 | if (return_sobol) 60 | return(list(pars_out=pars_out, sobol_out=sobol_out)) 61 | else 62 | return(pars_out) 63 | 64 | } 65 | -------------------------------------------------------------------------------- /R/output_control.R: -------------------------------------------------------------------------------- 1 | #' output_control 2 | #' 3 | #' Passes output variables to appropriate output selection method. 4 | #' @param output_method Output method (function) to use. "awk" will use awk, "r" will use new R based method, 5 | #' any other non NULL input will use the older R based output selection. 6 | #' @param output_variables Datafrane with two named columns: "variables" containing variables of interest 7 | #' found in the header of standard rhessys output files, "out_file" points to the files containing the associated variables, 8 | #' this can be either the path to that file, can use the abbreviation for the different output types 9 | #' (patch daily = pd, patch daily grow = pdg etc.) and the files in output_folder will be parsed appropriately, 10 | #' or can use the fully written out space.time suffix, e.g. "patch.daily" or "grow_patch.daily" 11 | #' @param output_folder Folder where rhessys output is located 12 | #' @param output_filename Base file name of standard rhessys output 13 | #' @param runID Integer ID of the current run, used internally 14 | #' @inheritParams select_output_variables_R 15 | 16 | # if output function has a new arg, add function to inheritsParams 17 | 18 | output_control = function(output_method, 19 | output_variables, 20 | return_data, 21 | output_folder, 22 | output_filename, 23 | runID = 1) { 24 | 25 | if (!is.null(output_variables[1]) & !is.null(output_method)) { 26 | 27 | # make allsim folder in output location - won't overwrite, warning for if exists is supressed 28 | dir.create(file.path(input_rhessys$output_folder, "allsim"), 29 | showWarnings = FALSE) 30 | 31 | if (output_method == "awk") { 32 | select_output_variables_w_awk( 33 | output_variables = output_variables, 34 | output_folder = output_folder, 35 | run = runID, 36 | output_initiation = 1 37 | ) 38 | 39 | } else if (output_method == "r") { 40 | data_out = select_output_variables_R( 41 | output_variables = output_variables, 42 | output_folder = output_folder, 43 | output_filename = output_filename, 44 | run = runID, 45 | return_data = return_data 46 | ) 47 | return(data_out) 48 | 49 | } else { 50 | select_output_variables( 51 | output_variables = output_variables, 52 | output_folder = output_folder, 53 | run = runID, 54 | output_initiation = 1 55 | ) 56 | 57 | } 58 | 59 | return() 60 | 61 | } 62 | 63 | } 64 | -------------------------------------------------------------------------------- /deprecated_functions/make_clim_base_file.R: -------------------------------------------------------------------------------- 1 | #' Adds a dated sequence to the bottom of a clim base file 2 | #' 3 | #' This function does ... 4 | #' 5 | #' @param ??? ??? 6 | #' @param ??? ??? 7 | #' @param ??? ??? 8 | #' @export 9 | 10 | make_clim_base_file <- function(input_clim_base, 11 | clim_base_path, 12 | input_dated_seq, 13 | clim_dated_ext) { 14 | 15 | # Create core part of climate base file 16 | clim_base_core <- do.call(dplyr::bind_rows, input_clim_base) 17 | 18 | # Add (optional) dated sequence 19 | if (is.null(input_dated_seq)==FALSE){ 20 | 21 | # Generate paths and names 22 | path <- dirname(clim_base_path) 23 | name_no_ext <- tools::file_path_sans_ext(basename(clim_base_path)) 24 | ext <- tools::file_ext(clim_base_path) 25 | dated_name_ext <- unique(paste(input_dated_seq$name, "_", clim_dated_ext, sep="")) 26 | path_new <- file.path(path, name_no_ext) 27 | dated_path_name_ext <- file.path(path_new,dated_name_ext) 28 | dated_file_name <- paste(dated_name_ext, ".", input_dated_seq$type, sep="") 29 | dated_file_count <- length(unique(input_dated_seq$name)) 30 | dated_file_type <- unique(input_dated_seq$type) 31 | 32 | # Create new directory 33 | if(dir.exists(path_new) == FALSE){dir.create(path_new)} 34 | 35 | # Tack on dated sequence to climate base file 36 | c1 <- c(dated_path_name_ext, dated_file_count, dated_file_type) 37 | clim_base_dated <- data.frame(c1 = c1, c2 = rep("", length(c1)), stringsAsFactors=FALSE) 38 | clim_base_file <- dplyr::bind_rows(clim_base_core,clim_base_dated) 39 | 40 | # Output clim base file 41 | file_name_out <- file.path(path_new, paste(name_no_ext,"_",clim_dated_ext,".",ext,sep="")) 42 | write.table(clim_base_file, file = file_name_out, row.names = FALSE, col.names = FALSE, quote=FALSE, sep=" ") 43 | 44 | # Make and output dated sequence file 45 | dated_seq_file <- file.path(path_new, dated_file_name) 46 | for (aa in seq_along(dated_file_type)){ 47 | #tmp = input_dated_seq magrittr::%>% dplyr::filter(type==dated_file_type[aa]) magrittr::%>% dplyr::select(-name,-type) 48 | tmp0 = dplyr::filter(input_dated_seq, type==dated_file_type[aa]) 49 | tmp = dplyr::select(tmp0, -name,-type) 50 | make_dated_seq(input_dated_seq = tmp, dated_seq_file = dated_seq_file[aa]) 51 | } 52 | } else { 53 | 54 | # Output standard clim file 55 | write.table(clim_base_core, file = clim_base_path, row.names = FALSE, col.names = FALSE, quote=FALSE, sep=" ") 56 | } 57 | } 58 | 59 | -------------------------------------------------------------------------------- /R/IOin_def_pars_latin_hypercube.R: -------------------------------------------------------------------------------- 1 | #' IOin_def_pars_latin_hypercube 2 | #' 3 | #' Generates multiple def file changes based on a sample of parameter values across the full range of each parameter. 4 | #' @param ... Any number of lists, each containing 3 elements in format: list("", "", ). The last element in the list is a vector containing the total number of parameter sets, minimum value of parameter sampling range, and maximum value of parameter sampling range. n must be equal across all lists. 5 | #' @param rm_dup TRUE/FALSE should duplicate def file + variable entries be automatically removed? A warning will occur regardless. 6 | #' 7 | #' @author Ryan Bart 8 | #' 9 | #' @export 10 | 11 | 12 | IOin_def_pars_latin_hypercube = function(..., rm_dup=TRUE) { 13 | 14 | pars = list(...) 15 | 16 | # if ... is already a list of lists, ie you're inputting the output of this function, unlist to keep format correct 17 | if (length(pars) == 1 && all(lapply(pars[[1]], length) == 3)) { 18 | pars = pars[[1]] 19 | } 20 | # some checks here, should get done regardless but mostly important for multiple param sets 21 | if (any(lapply(pars, length) != 3)) { 22 | stop("Each input list must have 4 elements - Def_file, Variable, Prior_dist") 23 | } 24 | # name some things to be helpful 25 | name_pars = function(x) { 26 | names(x) = c("Def_file", "Variable","Value") 27 | return(x) 28 | } 29 | pars = lapply(pars, name_pars) 30 | 31 | # check for duplicate def_file + variable entries, if rm_dup is T, keep only the first 32 | file_var = paste0(sapply(pars, "[[",1), "--", sapply(pars, "[[",2)) 33 | if (length(pars[duplicated(file_var)]) > 0) { 34 | warning("There are duplicate def file + variable entries, these should be corrected before running RHESSys.") 35 | if (rm_dup) { 36 | pars[duplicated(file_var)] = NULL 37 | cat("Duplicate def file + variable entries have been removed.\n") 38 | } 39 | } 40 | 41 | # Inputs for Latin Hypercube 42 | k <- length(pars) 43 | min_par <- lapply(seq_along(pars), function(x,y) y[[x]][[3]][2], y=pars) 44 | max_par <- lapply(seq_along(pars), function(x,y) y[[x]][[3]][3], y=pars) 45 | n <- pars[[1]][[3]][1] 46 | 47 | # Create parameter values via latin hypercube 48 | grid <- lhs::randomLHS(n, k) # Generate generic hypercube 49 | lhc_out <- mapply(function(w, x, y, z) qunif(w[,x], min=y, max=z), x=seq_len(k), y=min_par, z=max_par, MoreArgs = list(w=grid), SIMPLIFY = FALSE) 50 | 51 | pars_out = mapply(function(x, y) {x[[3]] = y; return(x)}, x = pars, y = lhc_out, SIMPLIFY = F) 52 | 53 | return(pars_out) 54 | 55 | } 56 | 57 | -------------------------------------------------------------------------------- /R/build_output_filter.R: -------------------------------------------------------------------------------- 1 | #' build_output_filter 2 | #' 3 | #' Creates a single output filter in R list format. This can be combined with other filters 4 | #' and/or written to file to be read by RHESSys when running. 5 | #' @param timestep The timestep of the filter: 'daily', 'monthly', 'annual', 'hourly' 6 | #' @param output_format The format for the RHESSys output files to be written: 'csv' or 'netcdf' 7 | #' @param output_path The path where RHESSys output will be written. 8 | #' @param output_filename The filename for RHESSys output 9 | #' @param spatial_level The spatial level for output to be collected at/aggregated to: 'basin', 'hillslope', 'zone', 'patch', 'stratum' 10 | #' @param spatial_ID IDs to subset the spatial units by. 11 | #' @param variables The RHESSys internal variable names to output. If aggregating from a finer spatial level use syntax: '.' 12 | #' 13 | #' @author Will Burke 14 | #' @export 15 | 16 | 17 | # ---------- build_output_filter ---------- 18 | 19 | # Make a single output filter in R 20 | # Filter is a data object with following format 21 | # list object containing 1 list named 'filter' 22 | # list 'filter' contains 3 items: 23 | # 'timestep' - 'daily', 'monthly', 'annual', 'hourly' 24 | # 'output' 25 | # 'format' - 'csv' or 'netcdf' 26 | # 'path' 27 | # 'filename' 28 | # '' - 'basin', 'hillslope', 'zone', 'patch', 'stratum' 29 | # 'ids' - the basin or patch id or ids 30 | # 'variables' - the rhessys internal variable names, 31 | # if aggregating up to a larger spatial level, use . format. 32 | 33 | build_output_filter = function(timestep = c('daily', 'monthly', 'annual', 'hourly'), 34 | output_format = c('csv', 'netcdf'), 35 | output_path, 36 | output_filename, 37 | spatial_level = c('basin', 'hillslope', 'zone', 'patch', 'stratum'), 38 | spatial_ID, 39 | variables) { 40 | 41 | if (is.null(spatial_ID)) { 42 | spatial_ID = "" 43 | } 44 | 45 | filter_obj = list("filter" = list( 46 | "timestep" = timestep, 47 | "output" = list( 48 | "format" = output_format, 49 | "path" = output_path, 50 | "filename" = output_filename 51 | ), 52 | list("ids" = spatial_ID, 53 | "variables" = paste(variables, collapse = ", ")) 54 | )) 55 | names(filter_obj$filter)[3] = spatial_level 56 | 57 | # if you're allowed to have multiple spatial levels per filter, take the basin part out and append that 58 | return(filter_obj) 59 | 60 | } 61 | -------------------------------------------------------------------------------- /R/IOin_clim.R: -------------------------------------------------------------------------------- 1 | #' IOin_clim 2 | #' 3 | #' Generate input for run_rhessys climate basestation input 4 | #' @param base_station_id Base station ID. 5 | #' @param x_coordinate X coordinate. 6 | #' @param y_coordinate Y coordinate. 7 | #' @param z_coordinate Z coordinate. 8 | #' @param effective_lai Effective LAI. 9 | #' @param screen_height Screen height. 10 | #' @param annual_prefix Prefix for annual climate inputs. 11 | #' @param num_non_critical_annual_sequences Number of non critical annual climate inputs. Defaults to 0. 12 | #' @param monthly_prefix Prefix for monthly climate inputs. 13 | #' @param num_non_critical_monthly_sequences Number of non critical annual climate inputs. Defaults to 0. 14 | #' @param daily_prefix Prefix for daily climate inputs. 15 | #' @param num_non_critical_daily_sequences Number of non critical annual climate inputs. Defaults to 0. 16 | #' @param hourly_prefix Prefix for hourly climate inputs. 17 | #' @param num_non_critical_hourly_sequences Number of non critical annual climate inputs. Defaults to 0. 18 | #' 19 | #' @author Will Burke 20 | #' 21 | #' @export 22 | 23 | IOin_clim = function(base_station_id, 24 | x_coordinate, 25 | y_coordinate, 26 | z_coordinate, 27 | effective_lai, 28 | screen_height, 29 | annual_prefix = "annual", 30 | num_non_critical_annual_sequences = 0, 31 | monthly_prefix = "monthly", 32 | num_non_critical_monthly_sequences = 0, 33 | daily_prefix = "daily", 34 | num_non_critical_daily_sequences = 0, 35 | hourly_prefix = "hourly", 36 | num_non_critical_hourly_sequences = 0) { 37 | 38 | 39 | 40 | output_clim_base = data.frame( 41 | "values" = c( 42 | base_station_id, 43 | x_coordinate, 44 | y_coordinate, 45 | z_coordinate, 46 | effective_lai, 47 | screen_height, 48 | annual_prefix, 49 | num_non_critical_annual_sequences, 50 | monthly_prefix, 51 | num_non_critical_monthly_sequences, 52 | daily_prefix, 53 | num_non_critical_daily_sequences, 54 | hourly_prefix, 55 | num_non_critical_hourly_sequences 56 | ), 57 | "vars" = c( 58 | "base_station_id", 59 | "x_coordinate", 60 | "y_coordinate", 61 | "z_coordinate", 62 | "effective_lai", 63 | "screen_height", 64 | "annual_climate_prefix", 65 | "number_non_critical_annual_sequences", 66 | "monthly_climate_prefix", 67 | "number_non_critical_monthly_sequences", 68 | "daily_climate_prefix", 69 | "number_non_critical_daily_sequences", 70 | "hourly_climate_prefix", 71 | "number_non_critical_hourly_sequences" 72 | ) 73 | ) 74 | 75 | return(output_clim_base) 76 | } 77 | -------------------------------------------------------------------------------- /man/run_rhessys_multi.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/run_rhessys_multi.R 3 | \name{run_rhessys_multi} 4 | \alias{run_rhessys_multi} 5 | \title{Run multiple RHESSys simulations} 6 | \usage{ 7 | run_rhessys_multi( 8 | input_rhessys, 9 | hdr_files, 10 | tec_data, 11 | def_pars = NULL, 12 | clim_base = NULL, 13 | output_filter = NULL, 14 | return_cmd = FALSE, 15 | par_option = TRUE, 16 | parallel = TRUE, 17 | n_cores = NULL, 18 | write_log = FALSE, 19 | log_loc = "~/rhessys_run_log.csv" 20 | ) 21 | } 22 | \arguments{ 23 | \item{input_rhessys}{List containing the following named elements: "rhessys_version" (path to rhessys binary), 24 | "tec_file"(name for tec file to be built), "world_file"(path to existing worldfile), "world_hdr_prefix"(prefix for headers to create), 25 | "flow_file"(path to existing flowtable), "start_date"(format c('yyyy mm dd hr')), "end_date"(format c('yyyy mm dd hr')), 26 | "output_folder"(path to output folder), "output_filename"(prefix for output files to create), "command_options"(additional commandline options)} 27 | 28 | \item{hdr_files}{List of named elements, named for each def file type (basin_def, hillslope_def, zone_def, soil_def, landuse_def, patch_def, 29 | stratum_def) as well as an element named "base_stations". Each element should contain the path to the corresponding def file.} 30 | 31 | \item{tec_data}{Input tec events, see input_tec function} 32 | 33 | \item{def_pars}{To overwrite def file parameters. Format is a list of lists, with each sub-list having the format: 34 | list(, , ). Defaults to NULL} 35 | 36 | \item{clim_base}{Data for input climate basestation to be written. Defaults to NULL, which assumes you havean existing basestation pointed 37 | to in input_rhessys.} 38 | 39 | \item{output_filter}{An output filter, either an R list with 1 to n number of filters read in/modified/generated via IOin_output_filter.R 40 | (or associated functions - build_output_filter.R, read_output_filter.R, modify_output_filter.R), or a file path pointing to an 41 | existing output filter.} 42 | 43 | \item{return_cmd}{TRUE/FALSE if run_rhessys_single should return the command line call INSTEAD of running.} 44 | 45 | \item{par_option}{TRUE/FALSE if the -par command line options should be used if running multiple runs and outputting current worldfile state. 46 | Can also just set as a number to set specific par ID.} 47 | 48 | \item{parallel}{Defaults to TRUE. Should the parallel package be used to parallelize the rhessys runs.} 49 | 50 | \item{n_cores}{The number of cores to use in a parallelized cluster. If left NULL, will autodetect number of cores and use total - 1.} 51 | 52 | \item{write_log}{TRUE/FALSE Writes or appends a log to a specified file, by row} 53 | } 54 | \description{ 55 | Runs RHESSys simulations. 56 | } 57 | \author{ 58 | Will Burke 59 | } 60 | -------------------------------------------------------------------------------- /R/make_hdr_file.R: -------------------------------------------------------------------------------- 1 | #' Write Header File 2 | #' 3 | #' New version of header file creation function. 4 | #' @inheritParams run_rhessys_single 5 | #' @param def_files Data frame of def file parameter changes 6 | #' 7 | #' @author Will Burke 8 | 9 | make_hdr_file = function(input_rhessys, 10 | hdr_files, 11 | def_files, 12 | runID) { 13 | 14 | # Create hdr output folder 15 | if (!is.null(input_rhessys$world_hdr_path)) { 16 | world_hdr_path <- file.path(dirname(input_rhessys$world_file), input_rhessys$world_hdr_path) 17 | } else { 18 | world_hdr_path <- file.path(dirname(input_rhessys$world_file), input_rhessys$world_hdr_prefix) 19 | } 20 | if (!dir.exists(world_hdr_path)) {dir.create(world_hdr_path)} 21 | 22 | # check the hdr items being used 23 | hdr_def_opts = c("basin_def", "hillslope_def", "zone_def", "soil_def", "landuse_def", 24 | "stratum_def", "fire_def", "fire_grid_prefix", "spinup_def", "base_stations") 25 | if (any(!names(hdr_files[!is.null(hdr_files)]) %in% hdr_def_opts)) { 26 | warning("header definition for ", 27 | names(hdr_files[!is.null(hdr_files)])[!names(hdr_files[!is.null(hdr_files)]) %in% hdr_def_opts], 28 | "is invalid and won't be added to header") 29 | } 30 | # ignore any that aren't valid, specifically to ignore patch header files which it seems should be soil defs 31 | hdr_files = hdr_files[names(hdr_files[!is.null(hdr_files)]) %in% hdr_def_opts] 32 | 33 | # get needed info for hdr file format 34 | hdr_values = lapply(hdr_files, function(x) c(length(x), x)) 35 | hdr_vars = mapply(function(x, y) { 36 | x[1] = paste0("num_", y) 37 | x[2:length(x)] = y 38 | return(x) 39 | }, hdr_values, names(hdr_values), SIMPLIFY = F) 40 | 41 | # make combined df 42 | hdr_df = data.frame(unlist(hdr_values), unlist(hdr_vars), row.names = NULL) 43 | # fix the names up 44 | hdr_df[,2] = gsub("def", "default_file", hdr_df[,2]) 45 | hdr_df[,2] = gsub("base_stations", "base_stations_file", hdr_df[,2]) 46 | hdr_df[,2][startsWith(hdr_df[,2], "num")] = paste0(hdr_df[,2][startsWith(hdr_df[,2], "num")],"s") 47 | 48 | # replace with modified defs where needed 49 | if (!is.null(def_files)) { 50 | rep_ind = lapply(def_files$old, function(x, y) {which(y == x)}, hdr_df[,1]) 51 | hdr_df[unlist(rep_ind),1] = def_files$new 52 | } 53 | 54 | if (!is.null(runID)) { 55 | runID = paste0("_",runID) 56 | } 57 | world_hdr_name_out <- file.path(world_hdr_path, paste0(input_rhessys$world_hdr_prefix, runID, ".hdr")) 58 | utils::write.table(hdr_df, file = world_hdr_name_out, col.names = FALSE, row.names = FALSE, quote = FALSE, sep = "\t\t") 59 | cat("===== Wrote hdr file '",world_hdr_name_out,"' =====\n", sep = "") 60 | 61 | # NOTE ON WRITE SPEEDS 62 | # write times w data.table::fwrite is only ~100 microsec faster for the header 63 | # for example so leaving all the writing as write.table for now 64 | 65 | return(world_hdr_name_out) 66 | 67 | } 68 | 69 | -------------------------------------------------------------------------------- /R/insert_in_worldfile.R: -------------------------------------------------------------------------------- 1 | #' Insert in Worldfile 2 | #' 3 | #' Inserts new state variables and values into a worldfile at specified location(s). 4 | #' @param world_in Path to input worldfile. Cannot create from scratch (use RHESSysPreprocessing) 5 | #' @param world_out Path to output worldfile. If set to FALSE, no file will be written. 6 | #' @param insert Character vector of length = 2, containing state variable and value to be inserted into a worldfile. 7 | #' @param insert_loc Location, in the form of an existing state variable name, for a new state variable(s) to be inserted following. 8 | #' @param return_data TRUE/FALSE should an R data object be returned. 9 | #' @param overwrite TRUE/FALSE should output worldfile overwrite existing file. 10 | #' 11 | #' @author Will Burke 12 | #' @export 13 | 14 | insert_in_worldfile = function(world_in, 15 | world_out, 16 | insert, 17 | insert_loc, 18 | return_data = FALSE, 19 | overwrite = FALSE) { 20 | 21 | # ---------- Check Arguments ---------- 22 | if (!file.exists(world_in)) { stop(noquote(paste0("No file found at: ", world_in))) } 23 | if (file.exists(world_out) & overwrite) { 24 | cat("File:", world_out, "will be overwritten.\n") 25 | } else if (file.exists(world_out) & !overwrite) { 26 | stop(noquote(paste0("Existing file found at: ", world_in, " & overwrite == FALSE"))) 27 | } 28 | if (!is.vector(insert) | length(insert) != 2) { 29 | stop("Insert is not a length == 2 character vector") 30 | } 31 | 32 | # ---------- Read World ---------- 33 | # this is the slow version - if needed switch to faster not in function method 34 | read_world = readLines(world_in, warn = FALSE, encoding = "UTF-8") 35 | read_world = read_world[nchar(trimws(read_world)) > 0] 36 | world = strsplit(trimws(read_world), "\\s+") 37 | world = data.frame(matrix(unlist(world), nrow = length(world), byrow = T), stringsAsFactors = FALSE) 38 | names(world) = c("values","vars") 39 | 40 | # Check insert_loc is valid 41 | insert_loc_i = which(world$vars == insert_loc) 42 | if (length(insert_loc_i) == 0) { 43 | stop(noquote(paste0("Could not find state variable: ", insert_loc, " in worldfile: ", world_in))) 44 | } 45 | 46 | # text string to insert - follows existing formatting 47 | insert_txt = gsub(insert_loc,insert[1], read_world[insert_loc_i[1]]) 48 | insert_txt = gsub(world$values[world$vars == insert_loc][1], insert[2], insert_txt) 49 | write_world = read_world 50 | 51 | # short loop through replacement indexes 52 | for (i in seq_along(insert_loc_i)) { 53 | write_world = c(write_world[1:(insert_loc_i[i] + i - 1)], insert_txt, write_world[(insert_loc_i[i] + i):length(write_world)]) 54 | } 55 | 56 | # Report changes 57 | cat("Inserted line: ", trimws(insert_txt), "\nat ", length(insert_loc_i), " instances following state variable: ", insert_loc,"\n") 58 | 59 | # Write new worldfile 60 | writeLines(text = write_world, world_out) 61 | cat("Wrote new worldfile to: ", world_out) 62 | 63 | } 64 | -------------------------------------------------------------------------------- /deprecated_functions/process_input_preexisting_table.R: -------------------------------------------------------------------------------- 1 | #' Processes parameters imported using a data frame. 2 | #' 3 | #' This function is as alternative to developing parameter sets using 4 | #' monte-carlo, via latin hypercube, etc. Generally, this function will import 5 | #' selected parameter sets that were exported from previous RHESSys simulations 6 | #' 7 | #' @param input_preexisting_table path and file of table to be inputted. Columns 8 | #' in table represent parameters, rows indicate different parameter sets. 9 | #' Standard parameters include ... Parameters to be changed in def files must 10 | #' include as a name the path and file of def file, a ":", and the name of the 11 | #' parameter. 12 | #' 13 | #' 14 | #' @export 15 | process_input_preexisting_table <- function(input_preexisting_table){ 16 | 17 | 18 | # --------------------------------------------------------------------- 19 | # Read in parameter file 20 | par_table <- read_csv(file.path(input_preexisting_table), col_names = TRUE) 21 | 22 | # --------------------------------------------------------------------- 23 | # Process standard RHESSys parameters 24 | 25 | stan_par <- c("m", "k", "m_v", "k_v", "pa", "po", "gw1", "gw2") 26 | option_sets_standard_par <- dplyr::select(par_table, stan_par) 27 | 28 | # Attach group ID to option_sets_standard_par 29 | tmp <- seq_along(option_sets_standard_par[[1]]) 30 | option_sets_standard_par <- bind_cols(option_sets_standard_par, stan_id = tmp) 31 | 32 | # --------------------------------------------------------------------- 33 | # Process def files 34 | 35 | # Isolate def parmaters 36 | #def_file_par <- par_table magrittr::%>% dplyr::select(-one_of(stan_par)) magrittr::%>% dplyr::select(-all_id) 37 | def_file_par0 <- dplyr::select(par_table, -one_of(stan_par)) 38 | def_file_par = dplyr::select(def_file_par0, -all_id) 39 | 40 | # Split def file names and rename def_file_par 41 | def_file_par_name_split <- strsplit(names(def_file_par), ":") 42 | def_par_name <- sapply(seq_along(def_file_par_name_split), function(x,y) y[[x]][2], y=def_file_par_name_split) 43 | names(def_file_par) <- def_par_name 44 | 45 | # Find unique def files 46 | def_files_name <- sapply(seq_along(def_file_par_name_split), function(x,y) y[[x]][1], y=def_file_par_name_split) 47 | def_files <- unique(def_files_name) 48 | 49 | option_sets_def_par <- list() 50 | for (aa in seq_along(def_files)){ 51 | option_sets_def_par[[aa]] <- def_file_par[def_files_name==def_files[aa]] 52 | 53 | # Potential to collapse data frame (and the number of def files produced) if 54 | # it has redundant parameter sets 55 | 56 | # Attach group ID to option_sets_def_par 57 | tmp <- seq_along(option_sets_def_par[[aa]][[1]]) 58 | option_sets_def_par[[aa]] <- bind_cols(option_sets_def_par[[aa]], group_id = tmp) 59 | } 60 | 61 | names(option_sets_def_par) <- def_files 62 | 63 | # --------------------------------------------------------------------- 64 | 65 | return(list(option_sets_def_par=option_sets_def_par, 66 | option_sets_standard_par=option_sets_standard_par)) 67 | } 68 | 69 | -------------------------------------------------------------------------------- /man/run_rhessys_single.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/run_rhessys_single.R 3 | \name{run_rhessys_single} 4 | \alias{run_rhessys_single} 5 | \title{Run RHESSys simulation} 6 | \usage{ 7 | run_rhessys_single( 8 | input_rhessys, 9 | hdr_files, 10 | tec_data = NULL, 11 | def_pars = NULL, 12 | clim_base = NULL, 13 | output_filter = NULL, 14 | cmd_pars = NULL, 15 | par_option = TRUE, 16 | return_cmd = FALSE, 17 | write_run_metadata = FALSE, 18 | write_log = FALSE, 19 | log_loc = "~/rhessys_run_log.csv", 20 | runID = NULL 21 | ) 22 | } 23 | \arguments{ 24 | \item{input_rhessys}{List containing the following named elements: "rhessys_version" (path to rhessys binary), 25 | "tec_file"(name for tec file to be built), "world_file"(path to existing worldfile), "world_hdr_prefix"(prefix for headers to create), 26 | "flow_file"(path to existing flowtable), "start_date"(format c('yyyy mm dd hr')), "end_date"(format c('yyyy mm dd hr')), 27 | "output_folder"(path to output folder), "output_filename"(prefix for output files to create), "command_options"(additional commandline options)} 28 | 29 | \item{hdr_files}{List of named elements, named for each def file type (basin_def, hillslope_def, zone_def, soil_def, landuse_def, patch_def, 30 | stratum_def) as well as an element named "base_stations". Each element should contain the path to the corresponding def file.} 31 | 32 | \item{tec_data}{Input tec events, see input_tec function} 33 | 34 | \item{def_pars}{To overwrite def file parameters. Format is a list of lists, with each sub-list having the format: 35 | list(, , ). Defaults to NULL} 36 | 37 | \item{clim_base}{Data for input climate basestation to be written. Defaults to NULL, which assumes you havean existing basestation pointed 38 | to in input_rhessys.} 39 | 40 | \item{output_filter}{An output filter, either an R list with 1 to n number of filters read in/modified/generated via IOin_output_filter.R 41 | (or associated functions - build_output_filter.R, read_output_filter.R, modify_output_filter.R), or a file path pointing to an 42 | existing output filter.} 43 | 44 | \item{cmd_pars}{List of standard (command line) parameters.} 45 | 46 | \item{par_option}{TRUE/FALSE if the -par command line options should be used if running multiple runs and outputting current worldfile state. 47 | Can also just set as a number to set specific par ID.} 48 | 49 | \item{return_cmd}{TRUE/FALSE if run_rhessys_single should return the command line call INSTEAD of running.} 50 | 51 | \item{write_run_metadata}{TRUE/FALSE if a text file containing run metadata should be written to the same location as your output.} 52 | 53 | \item{write_log}{TRUE/FALSE Writes or appends a log to a specified file, by row} 54 | 55 | \item{runID}{The unique ID used to track input and output files if running multiple scenarios, and thus multiple instances of run_rhessys_core.} 56 | 57 | \item{log_log}{Location of the log to be written/appended} 58 | } 59 | \description{ 60 | Writes files and assembles inputs to run a single instance of RHESSys. 61 | } 62 | -------------------------------------------------------------------------------- /R/change_def_file.R: -------------------------------------------------------------------------------- 1 | #' Replaces parameters in a def file 2 | #' 3 | #' This function reads a def file, replaces the values of selected parameters, and writes a new def file. 4 | #' @param def_file Path and name of def file 5 | #' @param par_sets Data frame with parameter names as colnames and a single row of parameter values 6 | #' @param file_name_ext Optional extension to add to file name 7 | #' 8 | #' @export 9 | 10 | change_def_file <- function(def_file, par_sets, file_name_ext = NULL){ 11 | 12 | # ------------------------------ Read in def file ------------------------------ 13 | # def_table = data.table::fread(def_file, header = FALSE, stringsAsFactors = FALSE) 14 | # def_table = read.table(def_file, header = FALSE, stringsAsFactors = FALSE) 15 | # both above have issues - read table cant handle comments, fread cant do different spacing 16 | 17 | # doing it manually 18 | def_read = readLines(def_file, warn = FALSE) 19 | def_read = def_read[nchar(def_read) > 0] 20 | def_table_list = strsplit(trimws(def_read), "\\s+") 21 | list_lens <- max(lengths(def_table_list)) 22 | def_table <- as.data.frame(do.call(rbind, lapply(def_table_list, `length<-`, list_lens)), stringsAsFactors = FALSE) 23 | names(def_table)[1:2] = c("pars", "names") 24 | 25 | # CUTTING OUT NOTES, FOR STABILITY AND TO REDUCE OUTPUT TABLE/FILE SIZE - add notes obj back in if needed 26 | if (ncol(def_table) >= 3) { 27 | notes = def_table[,3:ncol(def_table)] 28 | def_table = def_table[,1:2] 29 | } else { 30 | notes = NA 31 | } 32 | 33 | # ------------------------------ Replace parameters ------------------------------ 34 | par_sets_df = data.frame(pars = as.vector(t(par_sets[1,])), names = colnames(par_sets), stringsAsFactors = FALSE) 35 | 36 | if (any(duplicated(par_sets_df$names))) { 37 | cat("Duplicate def file changes found for", par_sets_df$names[duplicated(par_sets_df$names)], "in", def_file) 38 | } 39 | 40 | # in case of comments 41 | if (ncol(def_table) == 3) { 42 | par_sets_df$V3 = NA 43 | } 44 | 45 | # replace existing in def file 46 | in_def = par_sets_df$names %in% def_table$names 47 | if (any(in_def)) { 48 | def_table[match(par_sets_df$names, def_table$names, nomatch = 0),1] = par_sets_df$pars[in_def] 49 | } 50 | # add to def file 51 | if (any(!in_def)) { 52 | def_table = rbind(def_table, par_sets_df[!in_def,]) 53 | } 54 | 55 | def_table <- format(def_table, scientific = FALSE); 56 | 57 | # ------------------------------ Output def file ------------------------------ 58 | path <- dirname(def_file) 59 | name_no_ext <- tools::file_path_sans_ext(basename(def_file)) 60 | ext <- tools::file_ext(def_file) 61 | 62 | # Create new directory 63 | path_new <- file.path(path, name_no_ext) 64 | if (dir.exists(path_new) == FALSE) {dir.create(path_new)} 65 | 66 | if (!is.null(file_name_ext)) { 67 | file_name_ext = paste0("_",file_name_ext) 68 | } 69 | # Write new file 70 | file_name_out <- file.path(path_new, paste(name_no_ext,file_name_ext,".def",sep = "")) 71 | # if there are comments, this should remove extra NAs 72 | def_table[def_table == "NA"] = " " 73 | utils::write.table(def_table, file = file_name_out, row.names = FALSE, col.names = FALSE, quote = FALSE, sep = " ") 74 | 75 | return(file_name_out) 76 | 77 | } 78 | 79 | -------------------------------------------------------------------------------- /R/tec_repeat.R: -------------------------------------------------------------------------------- 1 | #' tec_repeat 2 | #' 3 | #' Repeats tec events at chosen intervals. Outputs a dataframe of the events for use in the tec input for RHESSysIOinR, 4 | #' optionally will copy an input redefine file with generated filenames. 5 | #' @param start Vector containing start date. Format is "c(year,month,day,hour)". 6 | #' @param end Vector containing end date. Format is "c(year,month,day,hour)". 7 | #' @param interval Interval to repeat chosen tec event. If left NULL will be executed 1 time. 8 | #' @param unit Unit of time for the repeat interval 9 | #' @param event_name The name/type of tec event to repeat. 10 | #' @param world Worldfile basename to modify and repeat 11 | #' @param redefine Redefine file to copy and rename. If NULL no files copied. 12 | #' @param overwrite Should existing files be overwritten 13 | #' @author Will Burke 14 | #' 15 | #' @export 16 | 17 | tec_repeat <- function(start, end, interval = NULL, unit, event_name, world = NULL, redefine = NULL, overwrite = FALSE) { 18 | 19 | # ----- Do dates right 20 | if (is.character(start) & length(start) == 1 & is.character(end) & length(end) == 1) { 21 | start = unlist(unname(strsplit(start, "\\s+"))) 22 | end = unlist(unname(strsplit(end, "\\s+"))) 23 | } 24 | if (length(start) == 4 & length(end) == 4) { 25 | start_date = as.POSIXlt(paste0(start[1],"/",start[2],"/",start[3])) 26 | end_date = as.POSIXlt(paste0(end[1],"/",end[2],"/",end[3])) 27 | } 28 | 29 | # ----- Build df of tec events ----- 30 | if (!is.null(interval) & !is.na(interval)) { 31 | #events = seq(start_date,end_date,by=paste(interval,unit)) 32 | events = as.POSIXlt(seq.POSIXt(start_date,end_date,by=paste(interval,unit))) 33 | } else { 34 | events = start_date 35 | } 36 | 37 | df_out = data.frame(year = events$year + 1900, month = events$mon + 1, day = events$mday, hour = 1, name = event_name, stringsAsFactors = FALSE) 38 | 39 | # if (random=="single"){ # repeat on the same random date annually 40 | # start_date2 = start_date 41 | # start_date2$year = start_date2$year+1 42 | # rand_date = sample(seq(start_date,start_date2 , by="day"),1) 43 | # if(lubridate::month(rand_date)==2&lubridate::day(rand_date)==29){rand_date=rand_date-lubridate::days(1)} # for leap years 44 | # events = seq(rand_date,end_date,by=paste(repeat_interval,"year")) 45 | # df_out = data.frame(year = lubridate::year(events),month = lubridate::month(events),day = lubridate::day(events),hour=1,name=tec_type,stringsAsFactors = FALSE) 46 | # } 47 | 48 | # if first thinning event is on start date, put it at hour 10 so it doesn't interfere with other events 49 | if(all(df_out[1,1:4] == as.numeric(start))) { 50 | df_out[1,4] = 10 51 | } 52 | 53 | # read in template 54 | # tx = readLines(paste(world,"template",sep="")) # read in template world 55 | # 56 | # # replace dummy value in template with multiplier 57 | # tx2 = gsub(pattern = "-1111",replacement = mult,x = tx) 58 | # for(fname in filenames){ 59 | # writeLines(tx2, con=fname) 60 | # } 61 | 62 | if (!is.null(redefine) && file.exists(redefine) & !is.null(world)) { 63 | # build vector of filenames 64 | filenames = paste(world,".Y",df_out[,1],"M",df_out[,2],"D",df_out[,3],"H",df_out[,4],sep = "") 65 | # copy redefine and rename w world name 66 | file.copy(redefine, filenames, overwrite = overwrite) 67 | } 68 | 69 | return(df_out) 70 | } 71 | -------------------------------------------------------------------------------- /R/readin_rhessys_output_cal.R: -------------------------------------------------------------------------------- 1 | #' Extracts output from a multiple RHESSys runs into R 2 | #' 3 | #' Imports multiple-run RHESSys output that has been consolidated by variable. This 4 | #' function imports and manipulates data so that it is 'tidy' and easily imported 5 | #' into ggplot. 6 | #' 7 | #' This function processes the output from multiple run calibration or simulations which consolidate a selection of the output into the allsim folder. 8 | #' 9 | #' @param var_names Vector of the variables names that are to be imported into R. Variables should all have the same number of layers. 10 | #' @param path Path to the directory containing data 11 | #' @param initial_date Initial date for the data e.g. lubridate::ymd("1941-10-01") 12 | #' @param timestep Timestep used for modeling (e.g. yearly, monthly, or daily). Default is daily. 13 | #' @param parameter_file Optional file containing parameters to be included in analysis (e.g. RHESSysIOinR output x_parameter_sets.csv) 14 | #' @param num_layers Number of layers in data. For most output (e.g. patch, basin), this will generally have a value of one. The exception being when using two canopies. 15 | #' 16 | #' @export 17 | readin_rhessys_output_cal <- function(var_names, path, initial_date, timestep = "daily", parameter_file = NULL, num_layers = 1){ 18 | 19 | # Read in 'allsim' output into list 20 | a <- var_names %>% 21 | sapply(., function(., path) file.path(path, .), path = path) %>% 22 | lapply(., readr::read_tsv, col_names = FALSE, skip = 2, col_types = readr::cols(X1 = readr::col_skip())) 23 | 24 | # Inputs for processing 25 | if (timestep == "yearly"){ 26 | dates <- rep(seq(initial_date, initial_date + lubridate::years(length(a[[1]][[1]])/num_layers) - 1, by = "year"), times = num_layers) 27 | } else if (timestep == "monthly") { 28 | dates <- rep(seq(initial_date, initial_date + months(length(a[[1]][[1]])/num_layers) - 1, by = "month"), times = num_layers) 29 | } else { 30 | dates <- rep(seq(initial_date, initial_date + lubridate::days(length(a[[1]][[1]])/num_layers) - 1, by = "day"), times = num_layers) 31 | } 32 | 33 | # Process data to tidy data frame (part 1) 34 | b <- a %>% 35 | lapply(., separate_canopy_output, num_canopies = num_layers) %>% # Add variable to signify if output has multiple layers 36 | lapply(., function(., dates) cbind(dates, .), dates = dates) %>% # Add dates column to data frames 37 | lapply(., function(.) tidyr::gather(., run, value, c(-dates,-canopy_layer))) # Rearrange data frame 38 | 39 | # Process data to tidy data frame (part 2) 40 | var_names_list <- lapply(as.list(var_names), function(x) data.frame(var_type = rep(x,length(b[[1]]$value)))) 41 | c <- b %>% 42 | Map(function(., y) cbind(y, .), ., var_names_list) %>% # Add column signifying output variable 43 | Reduce(rbind, .) # rbind the data frames together 44 | 45 | # Add all variables related to run (e.g. parameters, dated_seq) 46 | if (is.null(parameter_file) == FALSE) { 47 | parameter_output <- parameter_file %>% 48 | utils::read.csv(., header = TRUE) %>% 49 | cbind(run = sapply(seq_len(length(.[,1])),function(x) paste("X",as.character(x + 1),sep = "")),.) 50 | parameter_output$run <- as.character(parameter_output$run) 51 | done <- dplyr::left_join(c, parameter_output, by = "run") 52 | } else { 53 | done <- c 54 | } 55 | 56 | return(done) 57 | } 58 | 59 | 60 | -------------------------------------------------------------------------------- /R/watbal_patch.R: -------------------------------------------------------------------------------- 1 | #' watbal_patch.R 2 | #' 3 | #' Water balance for a single patch daily RHESSys output. 4 | #' 5 | #' Before you run the water balance script below, you must have added a "rain" column to your patch daily output 6 | #' data that contains the patch-specific precipitation. Be careful to add the right precip values if your worldfile 7 | #' uses multiple base stations, isohyets, or a precip lapse rate. 8 | #' 9 | #' This function will add a number of fields to your patch output file, the last of which will be called "watbal". 10 | #' This is your water balance error. You should see a minor numerical error here even if your water balances (on the order of 10^-6). 11 | #' If your watbal values are negative then water inputs are less than water outputs, and vice versa. 12 | #' 13 | #' If you have multiple patches with only a single stratum per patch, you need to run a different script to loop 14 | #' through patches individually, call the water balance function, then write the output. For example, if your 15 | #' patch output is called "rp", your canopy output is called "rc", and you want the water balance output written 16 | #' to atable called "out", then you would type: "out=pwatbalmult(rp,rc)". This creates a new output table, called 17 | #' "out" in this example, that contains date fields and a single column for each patch with the water balance error 18 | #' for that patch (called "P345","P578","P900", etc. where the field label number matches the patch ID). You might 19 | #' see a minor numerical error here even if your water balances (on the order of 10^-6). If your watbal values are 20 | #' negative then water inputs are less than wateroutputs and vice versa. Note that this may take a long time to run 21 | #' if you have many patches; better to run on a single patch or a single hillslope than a full basin. 22 | #' 23 | #' See `watbal_patch_mult` for multiple patches. 24 | #' 25 | #' @param pd Patch daily rhessys output, read into R with a funciton like `readin_rhessys_output()` 26 | #' @param cd Canopy daily rhessys output, read into R with a funciton like `readin_rhessys_output()` 27 | #' 28 | #' @importFrom magrittr %>% 29 | #' 30 | #' @export 31 | 32 | watbal_patch = function(pd, cd) { 33 | 34 | qouta = ifelse(pd$streamflow > 0, pd$streamflow, pd$Qout) 35 | pd$watbal.tmp = with(pd, pcp + Qin - qouta - trans_sat - trans_unsat - evap - evap_surface - soil_evap) 36 | pd$sd = with(pd, sat_def - rz_storage - unsat_stor) 37 | 38 | cd$weighted_snow_stored = cd$snow_stored * cd$covfrac 39 | cd$weighted_rain_stored = cd$rain_stored * cd$covfrac 40 | tmp = cd %>% dplyr::group_by(zoneID, hillID, basinID, patchID, day, month, year) %>% 41 | dplyr::summarize(can_snow_stored = sum(weighted_snow_stored), can_rain_stored = sum(weighted_rain_stored) ) 42 | 43 | pd = dplyr::left_join(pd, tmp[,c("basinID","hillID","zoneID","patchID","day","month","year","can_snow_stored","can_rain_stored")]) 44 | 45 | pd$can_water_stored = pd$can_rain_stored + pd$can_snow_stored 46 | 47 | tmp = diff(pd$sd) 48 | tmp = c(0, tmp) 49 | pd$sddiff = tmp 50 | tmp = diff(pd$snow) 51 | tmp = c(0, tmp) 52 | pd$snodiff = tmp 53 | tmp = diff(pd$detention_store) 54 | tmp = c(0, tmp) 55 | pd$detdiff = tmp 56 | tmp = diff(pd$litter.rain_stor) 57 | tmp = c(0, tmp) 58 | pd$litdiff = tmp 59 | tmp = diff(pd$can_water_stored) 60 | tmp = c(0, tmp) 61 | pd$candiff = tmp 62 | pd$watbal = with(pd, watbal.tmp + sddiff - snodiff - detdiff - litdiff - candiff) 63 | pd$watbal[1] = 0.0 64 | 65 | return(pd) 66 | } 67 | -------------------------------------------------------------------------------- /R/IOin_cmd_pars.R: -------------------------------------------------------------------------------- 1 | #' IOin_cmd_pars 2 | #' 3 | #' Input standard command line soil parameters for RHESSys, see https://github.com/RHESSys/RHESSys/wiki/RHESSys-command-line-options 4 | #' These parameters are MULTIPLIERS on the existing paramters in the definition files. 5 | #' @param m Decay of hydraulic conductivity with depth. 6 | #' @param k Hydraulic conductivity at the surface. 7 | #' @param soil_dep Soil depth. 8 | #' @param m_v Multiplier to scale the vertical decay of hydraulic conductivity with depth. 9 | #' @param k_v Multiplier to scale the vertical hydraulic conductivity at the surface. 10 | #' @param pa Multiplier to scale the pore size index, set in soil def file. 11 | #' @param po Multiplier to scale the psi air entry, set in soil def file. 12 | #' @param gw1 Multiplier on the sat_to_gw_coeff parameter set in the soil definition file 13 | #' (representing the amount of water moving from the saturated store to the groundwater store). 14 | #' @param gw2 Multiplier on the gw_loss_coeff parameter in the hillslope default file 15 | #' (representing the amount of water moving from the groundwater store to the stream). 16 | #' @param vgseng1 Multiples specific leaf areas. 17 | #' @param vgseng2 Multiplies the ratio of shaded to sunlit leaf area. 18 | #' @param vgseng3 Multiplier used only with the Dickenson algorithm of carbon allocation 19 | #' (set with the epc.allocation_flag variable in the vegetation definition file). It changes 20 | #' the allocation of net photosynthate sensitivity based on the current LAI. If not using the 21 | #' Dickenson strategy of carbon allocation (i.e. using Waring or default Constant strategies), 22 | #' set third value to 1.0. (i.e. -vgsen 1.0 2.0 1.0) 23 | #' @param n The number of parameter sets to generate. 24 | #' @param pct_range The percent range of variation from input values over which sampling (if any), will happen. 25 | #' 26 | #' @author Will Burke 27 | #' 28 | #' @export 29 | #' 30 | 31 | # FORMAT - this is pretty constrained, so a named vector works well here 32 | 33 | # STANDARD PARS USAGE 34 | # With the exception of gw and gw2, all of the command line parameters can be instead set via def file parameters. 35 | # Because of this, the assumption moving forward will be that this function will not be used by default, and so the 36 | # default values will all be set to 1, and if left as 1 (but still passed the run_rhessys_single/multi), will be ignored, since 37 | # they would have no effect. Only non 1 parameters will be passed to the command line. 38 | 39 | IOin_cmd_pars = function(m = 1, 40 | k = 1, 41 | soil_dep = 1, 42 | m_v = 1, 43 | k_v = 1, 44 | pa = 1, 45 | po = 1, 46 | gw1 = 1, 47 | gw2 = 1, 48 | vgseng1 = 1, 49 | vgseng2 = 1, 50 | vgseng3 = 1, 51 | n = 1, 52 | pct_range = 0.25) { 53 | 54 | 55 | # TODO check here for real world ranges of the parameters, warn if out of bounds 56 | # 57 | std_pars = list( 58 | m = m, 59 | k = k, 60 | soil_dep = soil_dep, 61 | m_v = m_v, 62 | k_v = k_v, 63 | pa = pa, 64 | po = po, 65 | gw1 = gw1, 66 | gw2 = gw2, 67 | vgseng1 = vgseng1, 68 | vgseng2 = vgseng2, 69 | vgseng3 = vgseng3 70 | ) 71 | 72 | if (n > 1) { 73 | std_pars = lapply(std_pars, function(x) stats::runif(n = n, min = x - (pct_range * x), max = x + (pct_range * x))) 74 | } 75 | 76 | return(std_pars) 77 | 78 | } 79 | -------------------------------------------------------------------------------- /R/write_output_filter.R: -------------------------------------------------------------------------------- 1 | #' write_output_filter 2 | #' 3 | #' Writes an output filter file based on an input R list containing the needed elements. 4 | #' @inheritParams run_rhessys_single 5 | #' 6 | #' @author Will Burke 7 | #' @export 8 | 9 | write_output_filter = function(output_filter, runID = NULL) { 10 | 11 | # if it's just a path to an existing filter for a single run 12 | if (is.character(output_filter) && is.null(runID)) { 13 | return(output_filter) 14 | } else if (is.character(output_filter) && !is.null(runID)) { 15 | # if it's a path but there's multi runs - need to read in so output name can be iterated 16 | file_name = output_filter 17 | output_filter = read_output_filter(output_filter) 18 | } 19 | # if it's an r list object 20 | # if there's a file name, remove it 21 | file_name = NULL 22 | aa = function(x) { return(x$output$filename)} 23 | if ("file_name" %in% names(output_filter)) { 24 | # file_name = lapply(output_filter,aa) 25 | # output_filter = output_filter[-which(names(output_filter) == "file_name")] 26 | 27 | file_name = output_filter[[which(names(output_filter) == "file_name")]] 28 | output_filter = output_filter[-which(names(output_filter) == "file_name")] 29 | } 30 | # test the filters are valid 31 | # testvalid = lapply(X = output_filter, FUN = valid_filter) 32 | # check for and remove duplicates 33 | if (any(duplicated(output_filter))) { 34 | output_filter = output_filter[!duplicated(output_filter)] 35 | } 36 | # check if a file name was given, otherwise autogen - can add unique id if we want 37 | if (is.null(file_name)) { 38 | file_name = "output_filter" 39 | } 40 | 41 | 42 | # add run ID to OUTPUT and FILTER filenames 43 | if (!is.null(runID)) { 44 | output_filter = lapply(output_filter, FUN = function(X, runID) {X$output$filename = paste0(X$output$filename, "_", runID); return(X)}, runID = runID) 45 | file_name = paste0(file_name, "_", runID) 46 | } 47 | 48 | # creating the output string manually now 49 | indent = " " 50 | format_filter = function(fb, indent) { 51 | f =fb$filter 52 | if (is.null(f)) 53 | { f = fb } 54 | level = names(f)[!names(f) %in% c("timestep", "output")] 55 | # to automate a check for existing quotes 56 | # (!grepl("\"|\'", f$output$path)) 57 | fpath = (f$output$path) 58 | fname = (f$output$filename) 59 | fout = paste0("filter:\n", indent, "timestep: ", f$timestep, "\n", indent, "output:\n", indent, indent, "format: ", f$output$format, "\n", 60 | indent, indent, "path: ", dQuote(fpath, F), "\n", indent, indent, "filename: ", dQuote(fname, F), "\n", 61 | indent, level, ":\n", indent, indent, "ids: ", f[[level]]$ids, "\n", indent, indent, "variables: ", f[[level]]$variables) 62 | return(fout) 63 | 64 | } 65 | 66 | filter_strings = lapply(output_filter, format_filter, indent) 67 | filter_string = paste0(filter_strings, collapse = "\n") 68 | 69 | # write the output filter 70 | #yaml::write_yaml(x = output_filter, file = file_name) 71 | 72 | # workaround beacuse brians code assumes integers 73 | # yaml_out = yaml::as.yaml(x = output_filter, line.sep = "\n" ) 74 | # yaml_out = gsub("\\.0", "", yaml_out) 75 | # yaml_out = gsub("\'\"|\"\'", "\'", yaml_out) 76 | 77 | # TODO remove all of this when formally fixed 78 | # hacky solution but works 79 | # yaml_out = gsub(",\\n\\s+",", ", yaml_out) 80 | 81 | file = file(file_name, "w", encoding = "UTF-8") 82 | cat(filter_string, file = file, sep = "") 83 | close(file) 84 | 85 | cat("===== Wrote output filter file '", file_name, "' =====\n", sep = "") 86 | 87 | return(file_name) 88 | 89 | } 90 | -------------------------------------------------------------------------------- /R/write_run_info.R: -------------------------------------------------------------------------------- 1 | #' write_run_info 2 | #' 3 | #' Write a text file containing metadata for each RHESSys run, including date and time, RHESSys binary used, 4 | #' input files used, and if output files were created and where they are located. Defaulting to write the file where your output is. 5 | 6 | write_run_info = function (rhessys_version, 7 | world_file, 8 | world_hdr_file, 9 | tec_file, 10 | flow_file, 11 | start_date, 12 | end_date, 13 | output_path = NULL, 14 | input_parameters, 15 | output_filter = NULL, 16 | run_metadata_basename = "run_metadata", 17 | command_options, 18 | prefix_command = NULL, 19 | return_cmd = FALSE) { 20 | 21 | warning("Going to get rid of this unless people are using it, kind of replacing with a simpler log function, in case anyone is using this.") 22 | 23 | if (!is.null(output_filter)) { 24 | filter_data = read_output_filter(output_filter) 25 | output_loc = unique(lapply(filter_data, function(X) X$output$path))[1] 26 | # make a new file with a unique date-time in the filename, keep that to add to after run completes/fails 27 | filename = paste0(run_metadata_basename, "_", gsub( ":", "-", sub( " ", "--", Sys.time())), ".txt") 28 | filepath = file.path(output_loc, filename) 29 | output_files = sapply(filter_data, FUN = function(X) paste0(file.path(X$output$path, X$output$filename),".",X$output$format )) 30 | 31 | output_str = paste0(" Output Filter:\t", output_filter, "\n", 32 | " Output File(s):\t", paste0(output_files, collapse = ", "), "\n") 33 | } else if (!is.null(output_path)) { 34 | # for old version, untested 35 | filename = paste0(run_metadata_basename, "_", gsub( ":", "-", sub( " ", "--", Sys.time())), ".txt") 36 | filepath = file.path(output_path, filename) 37 | output_str = paste0("Old RHESSys Output Path:\t", output_path, "\n") 38 | } else { 39 | stop("No output filter or old RHESSys output designated") 40 | } 41 | 42 | output_text = paste0("==================== RHESSYS RUN METADATA ====================\n", 43 | " Date:\t", Sys.Date(), "\n", 44 | " Time:\t", format(Sys.time(), "%H:%M:%S %Z"), "\n", 45 | " Working Directory:\t", getwd(), "\n", 46 | " RHESSys Binary:\t", rhessys_version, "\n", 47 | " Worldfile:\t", world_file, "\n", 48 | " Flowtable:\t", flow_file, "\n", 49 | " Header File:\t", world_hdr_file, "\n", 50 | " Tec File:\t", tec_file, "\n", 51 | " Start Date:\t", start_date, "\n", 52 | " End Date:\t", end_date, "\n", 53 | "Command Line Parameters:\t", ifelse(is.null(input_parameters), NA, input_parameters) , "\n", 54 | " Command Line Options:\t", ifelse(is.null(command_options), NA, command_options), "\n", 55 | " Run in R?:\t", !return_cmd, "\n", 56 | output_str 57 | ) 58 | 59 | file = file(filepath, "w", encoding = "UTF-8") 60 | cat(output_text, file = file, sep = "") 61 | close(file) 62 | 63 | return(list("info_filepath" = filepath, "output_files" = output_files)) 64 | 65 | } 66 | -------------------------------------------------------------------------------- /R/compile_rhessys.R: -------------------------------------------------------------------------------- 1 | #' compile_rhessys 2 | #' 3 | #' Compiles rhessys, with options to delete objects and move resulting RHESSys executable 4 | #' @param location The file patch to where the rhessys makefile or folder is 5 | #' @param delete_objs TRUE/FALSE to delete objects (before and after) 6 | #' @param destination Optional input of where to move resulting RHESSys executable 7 | #' @param make_args Arguments passed to the end of the make commandline call (examples: "wmfire='T'", "clean", or "clobber", ) 8 | #' @param ignore.stdout Passed through to system() 9 | #' @author Will Burke 10 | #' 11 | #' @export 12 | 13 | compile_rhessys = function(location, 14 | delete_objs = TRUE, 15 | destination = NULL, 16 | make_args = NULL, 17 | ignore.stdout = FALSE) { 18 | 19 | # find the makefile - i think foolproof but who knows 20 | if (endsWith(location, "makefile") && file.exists(location)) { 21 | makefile = location 22 | } else if (endsWith(file.path(location), "rhessys") && file.exists(file.path(location, "makefile")) ) { 23 | makefile = file.path(location, "makefile") 24 | } else { 25 | makeopts = list.files(location, pattern = "makefile$", recursive = TRUE) 26 | makeopts = grep(file.path("rhessys","makefile"), makeopts, value = TRUE) 27 | makeopts = file.path(location, makeopts) 28 | if (length(makeopts) == 0) { 29 | stop(noquote(paste0("Could not find any valid makefiles at path: ",location))) 30 | } else if (length(makeopts) > 1) { 31 | stop(noquote(paste0("Found more then 1 valid makefiles: ", paste(makeopts, collapse = ", ")))) 32 | } else if (length(makeopts) == 1) { 33 | makefile = makeopts 34 | } 35 | } 36 | 37 | # delete objects if they exist 38 | if (delete_objs) { 39 | objs = file.path(dirname(makefile), "objects") 40 | if (!file.exists(objs)) { 41 | cat("Couldn't find the objects folder - may not exist yet\n") 42 | } else { 43 | out = file.remove(file.path(objs, list.files(objs))) 44 | if (length(out) > 0 && out) { 45 | cat("RHESSys objects removed before compilation\n") 46 | } 47 | } 48 | } 49 | 50 | if (!is.null(make_args)) { 51 | make_args = paste0(" ", trimws(make_args)) 52 | } 53 | 54 | if (.Platform$OS.type == "windows") { 55 | dr = substr(path.expand(makefile), 0, 1) 56 | makefile = paste0("/mnt/", sub(dr, tolower(dr), sub(":", "", path.expand(makefile)))) 57 | } 58 | 59 | make_cmd = paste0("make -C ", dirname(makefile), " -f ", basename(makefile), make_args) 60 | 61 | if (.Platform$OS.type == "windows") { 62 | make_cmd2 = noquote(paste("bash -c \"", make_cmd, "\"", sep = "")) 63 | } else { 64 | make_cmd2 = make_cmd 65 | } 66 | 67 | cat("Running makefile... \n\n") 68 | sysout = system(command = make_cmd2, ignore.stdout = ignore.stdout) 69 | cat("\nCommand line echo:", make_cmd2,"\n") 70 | 71 | if (sysout == 2) { 72 | warning("Make probably failed, returned: ", sysout) 73 | } 74 | 75 | # move rhessys 76 | if (!is.null(destination)) { 77 | rhessys_write = file.path(dirname(makefile), paste0("rhessys", substr(make_info[1], 11, nchar(make_info[1])))) 78 | file.rename(rhessys_write, to = file.path(destination, basename(rhessys_write))) 79 | cat("Moved '",basename(rhessys_write), "' from '", dirname(makefile), "' to '", destination,"'\n", sep = "") 80 | } 81 | 82 | # delete new objects 83 | if (delete_objs) { 84 | out = file.remove(file.path(objs, list.files(objs))) 85 | if (length(out) > 0 && out) { cat("RHESSys objects removed after compilation\n") } 86 | } 87 | 88 | cat("\n -------------------- End compile_rhessys.R -------------------- \n") 89 | 90 | } 91 | -------------------------------------------------------------------------------- /R/rhessys_command.R: -------------------------------------------------------------------------------- 1 | #' Executes single RHESSys run on command line 2 | #' 3 | #' \code{rhessys_command} Assembles command line RHESSys call, and runs it. See the RHESSys wiki: 4 | #' https://github.com/RHESSys/RHESSys/wiki/RHESSys-command-line-options 5 | #' @param rhessys_version Path and file name of compiled version of RHESSys. 6 | #' @param world_file Oath and file name of RHESSys world_file. 7 | #' @param world_hdr_file Path and file name of RHESSys header file 8 | #' @param tec_file Path and file name of RHESSys temporal event control (tec) file 9 | #' @param flow_file Path and file name of RHESSys flow table file 10 | #' @param start_date Start date character vector in format , delimited by spaces. Ex. '1990 12 30 01' 11 | #' @param end_date End date character vector, same format as start_date 12 | #' @param output_file Path and base file name of RHESSys output 13 | #' @param input_parameters Soil parameters passed to RHESSys command line. 14 | #' @param output_filter Path to a yaml formatted output filter. 15 | #' @param command_options RHESSys command line options, ex. '-g' or '-p'. 16 | #' @param prefix_command A shell command to be run previous to the RHESSys command line call. 17 | #' @param return_cmd true/false passed from run_rhessys_single 18 | # @param supress_console TRUE/FALSE if console output from system() should be supressed 19 | #' This can be used to source a shell script, which itself can run multiple commands if needed. 20 | #' 21 | #' @export 22 | 23 | rhessys_command <- function(rhessys_version, 24 | world_file, 25 | world_hdr_file, 26 | tec_file, 27 | flow_file, 28 | start_date, 29 | end_date, 30 | output_file = NULL, 31 | input_parameters, 32 | output_filter = NULL, 33 | par_option_ID = NULL, 34 | command_options, 35 | prefix_command = NULL, 36 | return_cmd = FALSE) { 37 | 38 | tmp = paste0( 39 | rhessys_version, 40 | " -w ", world_file, 41 | " -whdr ", world_hdr_file, 42 | " -t ", tec_file, 43 | " -r ", flow_file, 44 | " -st ", start_date, 45 | " -ed ", end_date 46 | ) 47 | 48 | if (!is.null(output_file)) { 49 | tmp = paste0(tmp, " -pre ", output_file) 50 | } 51 | if (!is.null(output_filter)) { 52 | tmp = paste0(tmp, " -of ", output_filter) 53 | } 54 | if (!is.null(par_option_ID)) { 55 | tmp = paste0(tmp, " -par ", par_option_ID) 56 | } 57 | 58 | if (!is.null(input_parameters)) { 59 | tmp = paste0(tmp, " ", input_parameters) 60 | } 61 | 62 | if (length(command_options) > 0) { 63 | tmp = paste0(tmp, " ", command_options) 64 | } 65 | 66 | # add prefix command optionally 67 | if (!is.null(prefix_command)) { 68 | tmp = paste0(prefix_command, "; ", tmp) 69 | } 70 | 71 | # check OS and run via system correctly - windows requires the linux subsystem 72 | if (.Platform$OS.type == "windows") { 73 | wsl_loc = Sys.which("wsl") # just to check if wsl is available 74 | if (wsl_loc == "") { 75 | stop("WSL not found on system - cannot run RHESSys command on Windows without WSL.") 76 | } 77 | # system2("wsl", c("bash", "-lc", shQuote(cmd))) 78 | cmd = paste0("wsl bash -lc \"", tmp, "\"") 79 | } else { 80 | cmd = tmp 81 | } 82 | 83 | cat("Command line echo:", cmd, "\n") 84 | 85 | if (return_cmd) { 86 | return(cmd) 87 | } else { 88 | cat("\n----------------------------------------\n") 89 | cat("===== Beginning RHESSys Simulation =====\n") 90 | cat("----------------------------------------\n\n") 91 | 92 | system(cmd) 93 | 94 | return(NULL) 95 | } 96 | 97 | } 98 | 99 | -------------------------------------------------------------------------------- /man/IOin_tec_all_options.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/IOin_tec_all_options.R 3 | \name{IOin_tec_all_options} 4 | \alias{IOin_tec_all_options} 5 | \title{IOin_tec_all_options} 6 | \usage{ 7 | IOin_tec_all_options( 8 | print_hourly_on = NULL, 9 | print_hourly_growth_on = NULL, 10 | print_hourly_off = NULL, 11 | print_hourly_growth_off = NULL, 12 | print_daily_on = NULL, 13 | print_daily_growth_on = NULL, 14 | print_daily_off = NULL, 15 | print_daily_growth_off = NULL, 16 | print_monthly_on = NULL, 17 | print_monthly_off = NULL, 18 | print_yearly_on = NULL, 19 | print_yearly_growth_on = NULL, 20 | print_yearly_off = NULL, 21 | print_yearly_growth_off = NULL, 22 | redefine_strata = NULL, 23 | redefine_world = NULL, 24 | redefine_world_multiplier = NULL, 25 | redefine_world_thin_remain = NULL, 26 | redefine_world_thin_harvest = NULL, 27 | redefine_world_thin_snags = NULL, 28 | roads_on = NULL, 29 | roads_off = NULL, 30 | output_current_state = NULL 31 | ) 32 | } 33 | \arguments{ 34 | \item{print_hourly_on}{Start printing hourly output data} 35 | 36 | \item{print_hourly_growth_on}{Start printing hourly carbon-related output data} 37 | 38 | \item{print_hourly_off}{Stop printing hourly output data} 39 | 40 | \item{print_hourly_growth_off}{Stop printing hourly carbon-related output data} 41 | 42 | \item{print_daily_on}{Start printing daily output data} 43 | 44 | \item{print_daily_growth_on}{Start printing daily carbon-related output data} 45 | 46 | \item{print_daily_off}{Stop printing daily output data} 47 | 48 | \item{print_daily_growth_off}{Stop printing daily carbon-related output data} 49 | 50 | \item{print_monthly_on}{Start printing monthly output data} 51 | 52 | \item{print_monthly_off}{Stop printing monthly output data} 53 | 54 | \item{print_yearly_on}{Start printing yearly output data} 55 | 56 | \item{print_yearly_growth_on}{Start printing yearly carbon-related output data} 57 | 58 | \item{print_yearly_off}{Stop printing yearly output data} 59 | 60 | \item{print_yearly_growth_off}{Stop printing yearly carbon-related output data} 61 | 62 | \item{redefine_strata}{Redefine strata based on a file} 63 | 64 | \item{redefine_world}{Redefine world based on a file} 65 | 66 | \item{redefine_world_multiplier}{Redefine world based on a multiplier of 67 | existing worldfile values} 68 | 69 | \item{redefine_world_thin_remain}{Redefine world based on a thinning event 70 | where removed vegetation is transferred to CWD and litter stores} 71 | 72 | \item{redefine_world_thin_harvest}{Redefine world based on a thinning event 73 | where removed vegetation exits watershed} 74 | 75 | \item{redefine_world_thin_snags}{Redefine world based on a thinning event 76 | where stems are left in place.} 77 | 78 | \item{roads_on}{Start processing roads} 79 | 80 | \item{roads_off}{Stop processing roads} 81 | 82 | \item{output_current_state}{Output worldfile} 83 | } 84 | \description{ 85 | Generic input function to construct a dataframe for all possible RHESSys 86 | temporal event control (TEC) commands except csv commands. The function is 87 | flexible, allowing the user to construct complex tec files. However, due to 88 | the number of potential combinations of tec events, there are few checks on 89 | appropriateness of tec event sequences (for example, turning off a tec event 90 | before it is turned on). Full list of tec commands in RHESSys is available at 91 | init/construct_tec.c 92 | } 93 | \section{Note}{ 94 | All arguments accept a date or vector of dates in the format of 95 | "year month day hour" e.g. c("2000 10 1 1", "2001 9 30 1"). 96 | 97 | For more information on redefine worlds, see wiki page \href{https://github.com/RHESSys/RHESSys/wiki/Redefining-the-worldfile}{Redefining-the-worldfile} 98 | } 99 | 100 | \author{ 101 | Ryan R Bart 102 | } 103 | -------------------------------------------------------------------------------- /deprecated_functions/make_option_set_combinations.R: -------------------------------------------------------------------------------- 1 | #' Generates a dataframe of parameter set combinations 2 | #' 3 | #' Converts a list of parameter inputs (ranges, values, etc.) to a data frame 4 | #' containing the specified number of unique parameter set combinations. 5 | #' 6 | #' @param input_list List of parameters values to be processed. Name of 7 | #' parameter should be provided as name of each list component. 8 | #' @param parameter_method Parameter designating the method to use. 9 | #' 10 | #' Details of all_combinations method... 11 | #' 12 | #' Details of monte-carlo method... 13 | #' 14 | #' Details of latin hypercube method... 15 | #' 16 | #' Details of specific values method... This option is analogous to importing 17 | #' a dataframe of parameter sets, but specifies values by parameter in a list. 18 | #' 19 | #' @export 20 | make_option_set_combinations <- function(input_list, 21 | parameter_method){ 22 | 23 | # --------------------------------------------------------------------- 24 | if (parameter_method == "all_combinations"){ 25 | 26 | # Create parameter data frame 27 | out <- expand.grid(input_list) 28 | } 29 | 30 | # --------------------------------------------------------------------- 31 | if (parameter_method == "monte_carlo"){ 32 | 33 | # Data checks 34 | k <- length(input_list) 35 | stopifnot(sapply(seq_len(k), function(x,y) length(y[[x]])==3, y=input_list)) # Check that there are 3 values for each parameter (presumably a min, max and n) 36 | stopifnot(sapply(seq_len(k), function(x,y) y[[x]][3]==y[[1]][3], y=input_list)) # Check that total n is equal for all parameters. 37 | 38 | # Inputs 39 | min_par <- sapply(seq_len(k), function(x,y) y[[x]][1], y=input_list) 40 | max_par <- sapply(seq_len(k), function(x,y) y[[x]][2], y=input_list) 41 | n <- input_list[[1]][3] 42 | 43 | # Create parameter data frame 44 | out <- mapply(function(x, y, z) runif(min=x, max=y, n=z), x=min_par, y=max_par, MoreArgs = list(z=n)) 45 | out <- matrix(out,nrow=n) 46 | out <- as.data.frame(out) 47 | colnames(out) <- names(input_list) 48 | } 49 | 50 | # --------------------------------------------------------------------- 51 | if (parameter_method == "lhc"){ # latin hypercube 52 | 53 | # Data checks 54 | k <- length(input_list) 55 | stopifnot(sapply(seq_len(k), function(x,y) length(y[[x]])==3, y=input_list)) # Check that there are 3 values for each parameter (presumably a min, max and n) 56 | stopifnot(sapply(seq_len(k), function(x,y) y[[x]][3]==y[[1]][3], y=input_list)) # Check that total n is equal for all parameters. 57 | 58 | # Inputs for Latin Hypercube 59 | min_par <- sapply(seq_len(k), function(x,y) y[[x]][1], y=input_list) 60 | max_par <- sapply(seq_len(k), function(x,y) y[[x]][2], y=input_list) 61 | n <- input_list[[1]][3] 62 | 63 | # Transform a Latin hypercube 64 | grid <- lhs::randomLHS(n, k) # Generate generic hypercube 65 | out <- mapply(function(w, x, y, z) qunif(w[,x], min=y, max=z), x=seq_len(k), y=min_par, z=max_par, MoreArgs = list(w=grid)) 66 | out <- matrix(out,nrow=n) 67 | out <- as.data.frame(out) 68 | colnames(out) <- names(input_list) 69 | 70 | # See KScorrect package, qlunif, for potentially implementing uniform 71 | # log-normal distribution. Would need new input_def_file parameter 72 | # specifying normal or log normal, then have ifelse statement on line 64 73 | } 74 | 75 | # --------------------------------------------------------------------- 76 | if (parameter_method == "exact_values"){ 77 | 78 | # Data checks 79 | k <- length(input_list) 80 | stopifnot(sapply(seq_len(k), function(x,y) length(y[[x]])==length(y[[1]]), y=input_list)) # Check that total n is equal for all parameters. 81 | 82 | # Create parameter data frame 83 | out <- as.data.frame(do.call(cbind, input_list)) 84 | } 85 | 86 | # --------------------------------------------------------------------- 87 | 88 | return(out) 89 | } 90 | 91 | -------------------------------------------------------------------------------- /R/IOin_rhessys_input.R: -------------------------------------------------------------------------------- 1 | #' IOin_rhessys_input 2 | #' 3 | #' Basic inputs to run RHESSys 4 | #' 5 | #' @param version Path to compiled RHESSys binary. 6 | #' @param tec_file Path and name of input tec file. If also supplying a dataframe of tec events as created via IOin_tec_std() to run_rhessys_single(), a new directory will be created 7 | #' at the supplied path and name, with a new tec file within it. If not supplying a dataframe of tec events, this input refers to an existing tec file to be used. 8 | #' @param world_file Path and name of input world file. 9 | #' @param world_hdr_prefix Path and name for new folder where newly created hdr files will go. 10 | #' @param flowtable Path and name of input tec file. 11 | #' @param start Start date of simulation. 12 | #' @param end End date of simulation. 13 | #' @param output_folder Path to folder where simulation output will go. 14 | #' @param output_prefix Prefix for output files. 15 | #' @param commandline_options Commandline options to be passed to RHESSys, e.x. '-g' or '-p' 16 | #' @param world_hdr_path Path to where worldfile header file should be created/located. If left NULL, 17 | #' will use world_hdr_prefix as both path and file name. 18 | #' @param prefix_command A shell command to be run previous to the RHESSys command line call. 19 | #' This can be used to source a shell script, which itself can run multiple commands if needed. 20 | #' 21 | #' @author Will Burke 22 | #' 23 | #' @export 24 | 25 | IOin_rhessys_input = function(version, 26 | tec_file, 27 | world_file, 28 | world_hdr_prefix, 29 | flowtable, 30 | start, 31 | end, 32 | output_folder, 33 | output_prefix, 34 | commandline_options, 35 | world_hdr_path = NULL, 36 | prefix_command = NULL) { 37 | 38 | rh_list = list() 39 | 40 | # ----- rhessys binary version ----- 41 | # TODO this could be built on to automatically pull and compile rhessys 42 | if (!file.exists(version)) { 43 | warning("RHESSys binary version '",version,"' not found.") 44 | } 45 | rh_list$rhessys_version <- version 46 | 47 | # ----- tec file ----- 48 | # TODO since tec_file can be built via inputs, could check for it existing, but no error. 49 | # TODO Could potentially use this input tec file, if it exists, as a basis for a new tec file, so only modificaitons would need to be added 50 | # in the IOin_tec_ function. That actually should probably stay/occur in that file. 51 | # There is potential for conflict here though so a check should happen in the run_rhessys_core or scenario iteration functions 52 | rh_list$tec_file <- tec_file 53 | 54 | # ----- world file ----- 55 | if (!file.exists(world_file)) { 56 | warning("RHESSys world file '",world_file ,"' not found.") 57 | } 58 | rh_list$world_file <- world_file 59 | 60 | # ----- world file header prefix ----- 61 | # this is unclear what the purpose is - we could just delete this and do it all automatically using input name and scenario IDs we generate 62 | rh_list$world_hdr_prefix <- world_hdr_prefix 63 | 64 | # ----- flowtable ----- 65 | if (!file.exists(flowtable)) { 66 | warning("RHESSys flowtable '",flowtable ,"' not found.") 67 | } 68 | rh_list$flow_file <- flowtable 69 | 70 | # ----- dates ----- 71 | # TODO start and end dates, should have automatic coversion to rhessys format from R Date at least 72 | 73 | rh_list$start_date <- start 74 | rh_list$end_date <- end 75 | 76 | # TODO check if exists, create if not 77 | rh_list$output_folder <- output_folder 78 | 79 | rh_list$output_filename <- output_prefix 80 | 81 | # TODO compare against a vector of known commandline options, warn if not in that list 82 | rh_list$command_options <- commandline_options 83 | 84 | # prefix command 85 | rh_list$prefix_command = prefix_command 86 | 87 | rh_list$world_hdr_path <- world_hdr_path 88 | 89 | return(rh_list) 90 | 91 | 92 | } 93 | -------------------------------------------------------------------------------- /tests/testthat/test-single_run.R: -------------------------------------------------------------------------------- 1 | # this is to test input generation and running of a single rhessys simulation 2 | library(RHESSysIOinR) 3 | library(testthat) 4 | 5 | # TODO create reference objects to compare to? 6 | # TODO find most efficient way to download and install rhessys - I think using same command line from vignette: 7 | # TODO figure out a way to standardize which version of rhessys to test with 8 | 9 | # custom expects 10 | expect_file_exists = function(path) { 11 | # 1. Capture object and label 12 | act <- quasi_label(rlang::enquo(path), arg = "path") 13 | # 2. Call expect() 14 | expect( 15 | file.exists(act$val), 16 | sprintf("%s file does not exist.", act$lab) 17 | ) 18 | # 3. Invisibly return the value 19 | invisible(act$val) 20 | } 21 | 22 | expect_file_sizeKB_gt = function(path, size_KB) { 23 | # 1. Capture object and label 24 | act <- quasi_label(rlang::enquo(path), arg = "path") 25 | # 2. Call expect() 26 | expect( 27 | (file.size(act$val) / 1024) > size_KB, 28 | sprintf("%s file is not greater than %f KB.", act$lab, size_KB) 29 | ) 30 | # 3. Invisibly return the value 31 | invisible(act$val) 32 | } 33 | 34 | 35 | # PATHS - just setting wd to extdata at start and not doing any system.file() idk if its a problem 36 | #withr::local_dir(new = system.file("extdata", package = "RHESSysIOinR")) 37 | #setwd("~/Repos/RHESSysIOinR/inst/extdata/") 38 | setwd(system.file("extdata/", package = "RHESSysIOinR")) 39 | 40 | # no support for shallow clone depth so a little slow checking the commits 41 | gert::git_clone(url = "https://github.com/RHESSys/RHESSys", 42 | path = "./rh_dev", 43 | branch = "develop") 44 | 45 | # this has a bonus effect of testing the compile_rhessys function: 46 | compile_rhessys(location = "rh_dev/") 47 | 48 | # find the rhessys bin 49 | rh_ver = dir(path = "rh_dev/rhessys/", pattern = "^rhessys\\d+",recursive = F) 50 | 51 | test_that("compile_rhessys works + rhessys compiles via R system", { 52 | expect_gt(length(rh_ver), 0) 53 | }) 54 | 55 | rh_path = file.path("rh_dev/rhessys/", rh_ver) 56 | 57 | # with new testthat 3 use withr:: -- https://testthat.r-lib.org/articles/test-fixtures.html 58 | # for file cleanup use local_file() 59 | # for working dir change local_dir() 60 | 61 | input_rhessys = IOin_rhessys_input( 62 | version = rh_path, 63 | tec_file = "tecfiles/w8TC.tec", 64 | world_file = "worldfiles/w8TC.world", 65 | world_hdr_prefix = "w8TC", 66 | flowtable = "flowtables/w8TC.flow", 67 | start = "1998 10 1 1", 68 | end = "2000 10 1 1", 69 | output_folder = "out/", 70 | output_prefix = "w8TC", 71 | commandline_options = c("-g -b") 72 | ) 73 | 74 | input_tec_data = IOin_tec_std(start = "1998 10 1 1", 75 | end = "2000 10 1 1", 76 | output_state = TRUE) 77 | 78 | input_hdr = IOin_hdr( 79 | basin = "defs/basin.def", 80 | hillslope = "defs/hill.def", 81 | zone = "defs/zone.def", 82 | soil = "defs/soil_sandyloam.def", 83 | landuse = "defs/lu_undev.def", 84 | stratum = "defs/veg_douglasfir.def", 85 | basestations = "clim/w8_base" 86 | ) 87 | 88 | # test_that("Input core RHESSys info can be generated", { 89 | # 90 | # }) 91 | # 92 | # test_that("Input tec file can be generated", { 93 | # 94 | # }) 95 | # 96 | # test_that("Input header file can be generated", { 97 | # 98 | # }) 99 | 100 | run_rhessys_single(input_rhessys = input_rhessys, 101 | hdr_files = input_hdr, 102 | tec_data = input_tec_data) 103 | 104 | test_that("Simplest RHSSys run options run successfully (core rhessys info, tec data, hdr data)", { 105 | # check there is output file and they aren't empty 106 | expect_file_exists(path = "out/w8TC_basin.daily") 107 | expect_file_sizeKB_gt(path = "out/w8TC_basin.daily", size_KB = 5) 108 | expect_file_exists(path = "out/w8TC_grow_basin.daily") 109 | expect_file_sizeKB_gt(path = "out/w8TC_grow_basin.daily", size_KB = 5) 110 | }) 111 | 112 | # should add cleanup here if more tests are going to be run that depend on the file system state - otherwise doesn't really matter 113 | file.remove("rh_dev",file.path("out",list.files(path = "out/", pattern = "w8TC"))) 114 | -------------------------------------------------------------------------------- /inst/extdata/defs/veg_douglasfir.def: -------------------------------------------------------------------------------- 1 | 7.000000 stratum_default_ID 2 | TREE epc.veg.type 3 | 0.800000 K_absorptance 4 | 0.100000 K_reflectance 5 | 0.100000 K_transmittance 6 | 1.000000 PAR_absorptance 7 | 0.000000 PAR_reflectance 8 | 0.000000 PAR_transmittance 9 | 0.683700 epc.ext_coef 10 | 0.000215 specific_rain_capacity 11 | 0.000240 specific_snow_capacity 12 | 0.002000 wind_attenuation_coef 13 | -999.900000 ustar_overu 14 | 1.500000 mrc.q10 15 | 0.210000 mrc.per_N 16 | 0.200000 epc.gr_perc 17 | 1.000000 lai_stomatal_fraction 18 | 0.386300 epc.flnr 19 | 0.030000 epc.ppfd_coef 20 | 15.000000 epc.topt 21 | 40.000000 epc.tmax 22 | 0.200000 epc.tcoef 23 | -0.650000 epc.psi_open 24 | -4.599000 epc.psi_close 25 | 0.000000 epc.vpd_open 26 | 6419.200000 epc.vpd_close 27 | 0.004924 epc.gl_smax 28 | 0.000060 epc.gl_c 29 | 0.000000 gsurf_slope 30 | 1000000.000000 gsurf_intercept 31 | static epc.phenology_flag 32 | EVERGREEN epc.phenology.type 33 | 12.000000 epc.max_lai 34 | 8.708000 epc.proj_sla 35 | 2.600000 epc.lai_ratio 36 | 1.400000 epc.proj_swa 37 | 0.239700 epc.leaf_turnover 38 | 91.000000 epc.day_leafon 39 | 260.000000 epc.day_leafoff 40 | 30.000000 epc.ndays_expand 41 | 30.000000 epc.ndays_litfall 42 | 64.245000 epc.leaf_cn 43 | 70.000000 epc.leaflitr_cn 44 | 0.000000 min_heat_capacity 45 | 0.000000 max_heat_capacity 46 | combined epc.allocation_flag 47 | 0.368750 epc.storage_transfer_prop 48 | 0.270000 epc.froot_turnover 49 | 0.093426 epc.livewood_turnover 50 | 0.010000 epc.kfrag_base 51 | 0.005000 epc.max_daily_mortality 52 | 0.005000 epc.min_daily_mortality 53 | 0.000000 epc.daily_mortality_threshold 54 | 139.700000 epc.froot_cn 55 | 200.000000 epc.livewood_cn 56 | 0.310000 epc.leaflitr_flab 57 | 0.450000 epc.leaflitr_fcel 58 | 0.240000 epc.leaflitr_flig 59 | 0.230000 epc.frootlitr_flab 60 | 0.410000 epc.frootlitr_fcel 61 | 0.360000 epc.frootlitr_flig 62 | 0.520000 epc.deadwood_fcel 63 | 0.480000 epc.deadwood_flig 64 | 0.672900 epc.alloc_frootc_leafc 65 | 0.300000 epc.alloc_crootc_stemc 66 | 1.620000 epc.alloc_stemc_leafc 67 | 0.658720 epc.alloc_frootc_crootc 68 | 0.073000 epc.alloc_livewoodc_woodc 69 | 0.050000 epc.maxlgf 70 | 0.500000 epc.alloc_prop_day_growth 71 | 0.000000 epc.daily_fire_turnover 72 | 0.570000 epc.height_to_stem_exp 73 | 0.198800 epc.height_to_stem_coef 74 | 0.010165 epc.branch_turnover 75 | 0 epc.Tacclim 76 | 0.7 epc.root_growth_direction 77 | 24.015000 epc.root_distrib_parm 78 | 0.126700 epc.waring_pa 79 | 0.572500 epc.waring_pb 80 | 0.001622 epc.cpool_mort_fract 81 | 0.003219 epc.min_percent_leafg 82 | 0.245520 epc.max_storage_percent 83 | 0.013388 epc.min_leaf_carbon 84 | 0.008178 epc.resprout_leaf_carbon 85 | 0.295300 epc.netpabs_age_mult 86 | 0.425010 epc.netpabs 87 | 9999.000000 epc.netpabs_sunlit 88 | 9999.000000 epc.netpabs_shade 89 | 0.043800 epc.flnr_age_mult 90 | 9999.000000 epc.flnr_sunlit 91 | 9999.000000 epc.flnr_shade 92 | 9999.000000 epc.gl_smax_sunlit 93 | 9999.000000 epc.gl_smax_shade 94 | 0 epc.dyn_alloc_prop_day_growth 95 | 100 epc.max_years_resprout 96 | 0.000000 epc.litter_gsurf_slope 97 | 100000000.000000 epc.litter_gsurf_intercept 98 | 1.000000 epc.coef_CO2 99 | 2.000000 epc.max_root_depth #was8.721000 100 | 0.600000 epc.crown_ratio 101 | 1.500000 epc.max_stem_density 102 | 0.030000 epc.resprout_stem_density 103 | 1.000000 understory_mort 104 | 1.000000 consumption 105 | -10.000000 overstory_mort_k1 106 | 1.000000 overstory_mort_k2 107 | -2.000000 epc.gs_tmin 108 | 5.000000 epc.gs_tmax 109 | 900.000000 epc.gs_vpd_min 110 | 4100.000000 epc.gs_vpd_max 111 | 36000.000000 epc.gs_dayl_min 112 | 39600.000000 epc.gs_dayl_max 113 | -15.000000 epc.gs_psi_min 114 | -14.000000 epc.gs_psi_max 115 | 6.000000 epc.gs_ravg_days 116 | 0.500000 epc.gsi_thresh 117 | 1.000000 epc.gs_npp_on 118 | 187.000000 epc.gs_npp_slp 119 | 197.000000 epc.gs_npp_intercpt 120 | 0.250000 epc.dickenson_pa 121 | 3.220000 epc.Tacclim_intercpt 122 | 0.046000 epc.Tacclim_slp 123 | 30 epc.Tacclim_days 124 | 0.000583 epc.litter_moist_coef 125 | 50.000000 epc.litter_density 126 | 0 epc.nfix 127 | 1 epc.edible 128 | 0 epc.psi_curve 129 | -1.000000 epc.psi_threshold 130 | 0.200000 epc.psi_slp 131 | 1.000000 epc.psi_intercpt 132 | 0.000600 epc.gxylem_min_gs 133 | 0.004000 epc.gxylem_max 134 | -9999.000000 epc.LWP_gxylem_min 135 | 0.000400 epc.gxylem_recovery_rate 136 | 4.080000 epc.gxylem_csat 137 | -3.470000 epc.gxylem_bsat 138 | 0 epc.alternative_ra_surface 139 | 1 epc.zero_turnover_sprouts 140 | -------------------------------------------------------------------------------- /R/write_sample_clim.R: -------------------------------------------------------------------------------- 1 | #' Sample RHESSys Climate Data 2 | #' 3 | #' This function is used to generate new (artifical) RHESSys climate inputs from 4 | #' existing climate data the function returns a new climate data frame in R and 5 | #' writes .tmax, .tmin, .rain files for RHESSys met input 6 | #' 7 | #' @param prefix String giving the prefix to be used for output file names (e.g 8 | #' "../out/seqname") 9 | #' @param clim Original climate data to be sampled from, this must have the 10 | #' following columns; year, month, day, date, wy, rain, tmax, and tmin. Rain 11 | #' must be in mm, tmax and tmin in C. There must be a value for every day in 12 | #' each water year and it must be in sequential order. Columns can be in any 13 | #' order, a file created by read_RHESSys_met will work. 14 | #' @param samplewyrs is the vector of water years to be sampled from the 15 | #' original climate, in the order you want them to occur. A water year can be 16 | #' used more than once. samplewyrs must be included in the call to the 17 | #' function. 18 | #' @param reps Creates a sequence where your samplewyrs will be repeated. If 19 | #' samplewyrs=c(2004,2000) and rep=4, the sequence you will get is made from 20 | #' 2004,2000,2004,2000,2004,2000,2004,2000. Reps is optional and default to 1. 21 | #' @param startwyr is the water year to be used for the first day of the newly 22 | #' generated sequence thus, if startwyr=1998, the new sequence will start on 23 | #' 10/1/1998. startwyr is optional. If startwyr is not listed the program will 24 | #' use the first water year of the original climate sequence (clim) 25 | #' 26 | #' @export 27 | 28 | write_sample_clim = function(prefix, clim, samplewyrs, reps=1, startwyr=0) { 29 | 30 | totalyrs = length(samplewyrs) 31 | 32 | newclim = as.data.frame(matrix(nrow=totalyrs*reps*366, ncol=9)) 33 | 34 | firstdate = ifelse(startwyr==0, clim$wy[1], startwyr) 35 | firstdate = c(firstdate,10,1, firstdate-1) 36 | names(firstdate) = c("wy","month","day","year") 37 | firstdate = as.data.frame(t(firstdate)) 38 | firstdate$date = as.Date(paste(firstdate$year, firstdate$month, firstdate$day, sep = "-")) 39 | 40 | colnames(newclim) = c("date","rain","tmax","tmin","oldwy","wy","month","day","year") 41 | newclim[,] = 0 42 | startr=1 43 | nyr = clim$wy[1] 44 | 45 | for (j in 1:reps) { 46 | for (i in 1:totalyrs) { 47 | 48 | syr = samplewyrs[i] 49 | tmpo = subset(clim,clim$wy==syr) 50 | lno = nrow(tmpo) 51 | 52 | syr.leap=ifelse((round(syr/4) - (syr/4)) == 0, ifelse((round(syr/100)-(syr/100))==0, 53 | ifelse((round(syr/400)-(syr/400))==0,1,0),1),0) 54 | 55 | nyr.leap=ifelse((round(nyr/4) - (nyr/4)) == 0, ifelse((round(nyr/100)-(nyr/100))==0, 56 | ifelse((round(nyr/400)-(nyr/400))==0,1,0),1),0) 57 | 58 | if ((syr.leap == 1) && (nyr.leap==0)) 59 | tmpo = tmpo[1:365,] 60 | if ((syr.leap == 0) && (nyr.leap==1)) { 61 | tmpo = as.data.frame(rbind(tmpo, tmpo[365,])) 62 | tmpo$rain[366] = 0.0 63 | } 64 | 65 | lno = nrow(tmpo) 66 | endr=startr+lno-1 67 | newclim[startr:endr,c("rain","tmax","tmin","oldwy")] = tmpo[,c("rain","tmax","tmin","wy")] 68 | newclim[startr:endr,"wy"] = rep(nyr, times=lno) 69 | startr=endr+1 70 | nyr = nyr+1 71 | } 72 | } 73 | 74 | newclim = newclim[1:endr,] 75 | newclim$date = seq(from=firstdate$date, length=length(newclim$date), by=1) 76 | newclim$year = as.integer(as.character(chron::years(newclim$date))) 77 | newclim$month = as.numeric(substr(as.character(newclim$date), 6,7)) 78 | newclim$day = as.numeric(chron::days(newclim$date)) 79 | header = sprintf("%d %d %d %d", firstdate$year[1], firstdate$month[1], firstdate$day[1], 1) 80 | nme = sprintf("%s.rain",prefix) 81 | write(header, file=nme) 82 | write.table(newclim$rain/1000.0, file=nme, row.names=F, col.names=F, append=T, quote=F) 83 | nme = sprintf("%s.tmax",prefix) 84 | write(header, file=nme) 85 | write.table(newclim$tmax, file=nme, row.names=F, col.names=F, append=T, quote=F) 86 | nme = sprintf("%s.tmin",prefix) 87 | write(header, file=nme) 88 | write.table(newclim$tmin, file=nme, row.names=F, col.names=F, append=T, quote=F) 89 | 90 | print(paste("New climate sequence is ", length(unique(newclim$wy))," wateryears (WY ", min(newclim$wy), " to ", max(newclim$wy), ")",sep="")) 91 | return(newclim) 92 | } 93 | -------------------------------------------------------------------------------- /R/IOin_def_pars_simple.R: -------------------------------------------------------------------------------- 1 | #' IOin_def_pars_simple 2 | #' 3 | #' The definition file parameters to modify. This input function generates an input parameter object, either for a single simulation, 4 | #' or using simple random sampling over a set range (based on percent difference from input values). This later functionality can be put into 5 | #' a seperate funciton later if desired. 6 | #' @param ... Any number of lists, each containing 3 elements in format: list("", "", ) 7 | #' @param n The number of parameter sets to generate. 8 | #' @param pct_range The percent range of variation from input values over which sampling (if any), will happen. 9 | #' @param rm_dup TRUE/FALSE should duplicate def file + variable entries be automatically removed? A warning will occur regardless. 10 | #' 11 | #' @author Will Burke 12 | #' 13 | #' @export 14 | 15 | # pars = list(list("defs/veg_p301_conifer.def", "epc.allocation_flag","dickenson"), 16 | # list("defs/veg_p301_conifer.def", "epc.alloc_frootc_leafc", 1), 17 | # list("defs/veg_p301_conifer.def", "epc.alloc_stemc_leafc", 0.6), 18 | # list("defs/veg_p301_conifer.def", "epc.netpabs_shade", 0.2)) 19 | 20 | # --- IMPORTANT DATA ASSUMPTIONS --- 21 | # We can discuss revising this, but this code (and potentially other I(WB) write) will assume that parameters 22 | # for a single run will use the following data format (as the ultimate structure that gets passed to run_rhessys_core) 23 | # 24 | # 25 | # < repeat above format for each unique def file variable> 26 | # 27 | # For a set of def file parameters, regardless of how they are generated, I propose using the same format except instead of a single value 28 | # there would be a vector of values for each def file variable. Ex: 29 | # 30 | # 31 | # < repeat above format for each unique def file variable> 32 | # 33 | # Def file variables not being varied, or which don't make sense to be 34 | # (e.g. text fields like epc.allocation_flag) would need to be replicated so that each def variable list has a vector of target values 35 | # that are the same length. These can then be iterated through or lapply'd across, potentially in parallel. 36 | # 37 | # How these data structures are achieved can vary by IOin function/type of parameter variation, since different methods will require 38 | # different inputs (see the simplest option I could come up with below) 39 | 40 | IOin_def_pars_simple = function(..., n = 1, pct_range = 0.25, rm_dup = F) { 41 | 42 | options(stringsAsFactors = F) 43 | 44 | pars = list(...) 45 | 46 | # if ... is already a list of lists, ie you're inputting the output of this function, unlist to keep foramt correct 47 | if (length(pars) == 1 && all(lapply(pars[[1]], length) == 3)) { 48 | pars = pars[[1]] 49 | } 50 | 51 | # some checks here, should get done regardless but mostly important for multiple param sets 52 | if (any(lapply(pars, length) != 3)) { 53 | stop("Each input list must have 3 elements - 1) file path to def file 2) def file variable 3) value") 54 | } 55 | 56 | # name some things to be helpful 57 | name_pars = function(x) { 58 | names(x) = c("Def_file", "Variable", "Value") 59 | return(x) 60 | } 61 | pars = lapply(pars, name_pars) 62 | 63 | # check for duplicate def_file + variable entries, if rm_dup is T, keep only the first 64 | file_var = paste0(sapply(pars, "[[",1), "--", sapply(pars, "[[",2)) 65 | if (length(pars[duplicated(file_var)]) > 0) { 66 | if (rm_dup) { 67 | pars[duplicated(file_var)] = NULL 68 | cat("Duplicate def file + variable entries have been removed.\n") 69 | } else { 70 | warning("There are duplicate def file + variable entries, these should be corrected before running RHESSys.") 71 | } 72 | } 73 | 74 | if (n > 1) { 75 | # only vary the variables that are numbers 76 | values = unlist(lapply(pars, "[[", 3)) 77 | values = suppressWarnings(as.numeric(values)) 78 | 79 | #if (any(is.na(values))) { 80 | #cat() # idk guess doesn't matter 81 | #} 82 | if (any(values == 0)) { 83 | cat("Some pars are 0, variation by pct won't work, setting to 0 anyways.\nPars with value == 0:\n") 84 | cat(file_var[values == 0],sep="\n") 85 | } 86 | 87 | parset_from_pctrange = function(x) { 88 | if (x >= 0) { 89 | stats::runif(n = n, min = x - (pct_range * x), max = x + (pct_range * x)) 90 | } else if (x < 0){ 91 | stats::runif(n = n, max = x - (pct_range * x), min = x + (pct_range * x)) 92 | } 93 | } 94 | 95 | value_sets = lapply(values[!is.na(values)], parset_from_pctrange) 96 | 97 | pars[!is.na(values)] = mapply(function(x, y) {x[[3]] = y; return(x)}, x = pars[!is.na(values)], y = value_sets, SIMPLIFY = F) 98 | 99 | if (any(is.na(values))) { 100 | pars[is.na(values)] = lapply(pars[is.na(values)], function(x) {x[[3]] = rep.int(x[[3]], n); return(x)}) 101 | } 102 | 103 | } 104 | 105 | return(pars) 106 | 107 | } 108 | -------------------------------------------------------------------------------- /R/check_params.R: -------------------------------------------------------------------------------- 1 | #' check_params 2 | #' 3 | #' Function to check if parameters are valid and compare them to default parameters from a version of RHESSys 4 | #' @param rh_file Path to the appropriate construct file in the RHESSys source code, e.g. construct_stratum_defaults.c 5 | #' @param def_file Path to a appropriate parameter definition file to be compared to the RHESSys defaults 6 | #' @author Will Burke 7 | #' @export 8 | 9 | check_params = function(rh_file, def_file) { 10 | # ------------------------------ Read in def file ------------------------------ 11 | def_read = readLines(def_file, warn = FALSE) 12 | def_read = def_read[nchar(def_read) > 0] 13 | def_table_list = strsplit(trimws(def_read), "\\s+") 14 | list_lens <- max(lengths(def_table_list)) 15 | def_table <- as.data.frame(do.call(rbind, lapply(def_table_list, `length<-`, list_lens)), stringsAsFactors = FALSE) 16 | names(def_table)[1:2] = c("Value", "Name") 17 | def_table = def_table[,1:2] 18 | defaultparams = parse_rh_constr_func(rh_file) 19 | combparams = merge(defaultparams, def_table, by = "Name", all = T) 20 | return(combparams) 21 | } 22 | 23 | #' @export 24 | parse_rh_constr_func = function(rh_file) { 25 | rawlines = trimws(readLines(rh_file)) 26 | i=1 27 | while (i < length(rawlines)) { 28 | if (!grepl(";", rawlines[i]) & (!startsWith(rawlines[i], "/*")| !startsWith(rawlines[i], "//"))) { 29 | rawlines[i] = paste0(rawlines[i]," ", rawlines[i + 1]) 30 | rawlines = rawlines[-(i+1)] 31 | } else { 32 | i = i+1 33 | } 34 | } 35 | paramlines = rawlines[grepl("getStrParam|getIntParam|getFloatParam|getDoubleParam", rawlines)] 36 | paramtext = regmatches(paramlines, gregexpr("(getStrParam\\(|getIntParam\\(|getFloatParam\\(|getDoubleParam\\().*?\\)", paramlines)) 37 | if (any(!endsWith(unlist(paramtext), ")"))) { 38 | cat("Something went wrong in c file parsing.") 39 | } 40 | paramsep = strsplit(gsub("\"","", gsub("\\)", "", gsub(".*\\(","", unlist(paramtext)))), ",") 41 | paramsep = lapply(paramsep, trimws) 42 | paramdf = as.data.frame(do.call(rbind, paramsep))[,3:6] 43 | names(paramdf) = c("Name", "Type", "DefaultValue", "UseDefault") 44 | paramdf = paramdf[,c("Name", "DefaultValue", "UseDefault")] 45 | 46 | # some custom checks for some stratum vars 47 | if ("epc.gxylem_max" %in% paramdf$Name) { 48 | if (paramdf$DefaultValue[paramdf$Name == "epc.gxylem_max"] == "default_object_list[i].epc.gl_smax") { 49 | paramdf$DefaultValue[paramdf$Name == "epc.gxylem_max"] = paramdf$DefaultValue[paramdf$Name == "epc.gl_smax"] 50 | } 51 | } 52 | if ("epc.gxylem_min_gs" %in% paramdf$Name) { 53 | if (paramdf$DefaultValue[paramdf$Name == "epc.gxylem_min_gs"] == "default_object_list[i].epc.gl_c*10") { 54 | paramdf$DefaultValue[paramdf$Name == "epc.gxylem_min_gs"] = as.numeric(paramdf$DefaultValue[paramdf$Name == "epc.gl_c"])*10 55 | } 56 | } 57 | if ("epc.gxylem_recovery_rate" %in% paramdf$Name) { 58 | if (paramdf$DefaultValue[paramdf$Name == "epc.gxylem_recovery_rate"] == "default_object_list[i].epc.gxylem_max*0.1") { 59 | paramdf$DefaultValue[paramdf$Name == "epc.gxylem_recovery_rate"] = as.numeric(paramdf$DefaultValue[paramdf$Name == "epc.gxylem_max"])*0.1 60 | } 61 | } 62 | 63 | 64 | return(paramdf) 65 | } 66 | 67 | #' @export 68 | compare_params = function(a, b, rh_construct_default_file) { 69 | options(scipen = 999) 70 | 71 | a_pars = check_params(rh_file = rh_construct_default_file,def_file = a) 72 | b_pars = check_params(rh_file = rh_construct_default_file,def_file = b) 73 | 74 | combined_pars = merge(a_pars[,c("Name","Value", "DefaultValue")],b_pars[,c("Name","Value")], by = "Name" ) 75 | names(combined_pars)[names(combined_pars) == "Value.x"] = basename(a) 76 | names(combined_pars)[names(combined_pars) == "Value.y"] = basename(b) 77 | combined_pars = combined_pars[,c("Name",basename(a),basename(b),"DefaultValue" )] 78 | 79 | # if possible, set as numeric (and then back to chr) 80 | isnum = !is.na(suppressWarnings(as.numeric(combined_pars[,basename(a)]))) 81 | combined_pars[isnum,basename(a)] = as.numeric(combined_pars[isnum,basename(a)]) 82 | isnum = !is.na(suppressWarnings(as.numeric(combined_pars[,basename(b)]))) 83 | combined_pars[isnum,basename(b)] = as.numeric(combined_pars[isnum,basename(b)]) 84 | isnum = !is.na(suppressWarnings(as.numeric(combined_pars[,"DefaultValue"]))) 85 | combined_pars[isnum,"DefaultValue"] = as.numeric(combined_pars[isnum,"DefaultValue"]) 86 | 87 | # col for tracking if pars are diferent, accounting for defaults 88 | combined_pars$different_pars = TRUE 89 | both_default = is.na(combined_pars[,basename(a)]) & is.na(combined_pars[,basename(b)]) 90 | combined_pars[both_default,"different_pars"] = FALSE 91 | # a NA/default, b is not, is default same as b 92 | combined_pars[is.na(combined_pars[,basename(a)]) & !is.na(combined_pars[,basename(b)]) & 93 | combined_pars[,basename(b)] == combined_pars[,"DefaultValue"],"different_pars"] = FALSE 94 | # b NA/default, a is not, default compared to a 95 | combined_pars[is.na(combined_pars[,basename(b)]) & !is.na(combined_pars[,basename(a)]) & 96 | combined_pars[,basename(a)] == combined_pars[,"DefaultValue"],"different_pars"] = FALSE 97 | # neither is NA, and are they the same? 98 | combined_pars[!is.na(combined_pars[,basename(a)]) & !is.na(combined_pars[,basename(b)]) & 99 | combined_pars[,basename(a)] == combined_pars[,basename(b)], "different_pars"] = FALSE 100 | return(combined_pars) 101 | } 102 | -------------------------------------------------------------------------------- /R/read_clim.R: -------------------------------------------------------------------------------- 1 | #' read_clim 2 | #' 3 | #' Read in rhessys formatted climate to R - works for any daily input, can have mismatched dates, missing values will be filled by NA. 4 | #' Works for both standard and netcdf clim, if you specify a basestation. 5 | #' @param clim_in Climate file - prefix will return all matching data, including suffix returns just that time series 6 | #' (e.g. 'site.rain' only return the precipitation time series). 7 | #' @param dates_out Should start and end dates be output? 8 | #' @param return_base Should info from the basestation only be returned. If FALSE, data will be returned. 9 | #' @author Will Burke 10 | #' @importFrom ncdf4 nc_open 11 | #' @importFrom ncdf4 ncvar_get 12 | #' @importFrom stringr str_remove 13 | #' @export 14 | 15 | read_clim = function(clim_in, dates_out = FALSE, return_base = FALSE) { 16 | 17 | # ============================== functions and inputs ============================== 18 | options(scipen = 999) 19 | datefun = function(x, y) { 20 | seq.POSIXt(from = x, by = "DSTday", length.out = y - 1) 21 | } 22 | isncdf = F 23 | opts = c(".rain", ".tmin", ".tmax", ".tavg", ".dayl", ".daytime_rain_duration", 24 | ".LAI_scalar", ".Ldown", ".Kdown_direct", ".Kdown_diffuse", ".ndep_NO3", ".ndep_NH4", 25 | ".PAR_direct", ".PAR_diffuse", ".relative_humidity", ".tday", ".tnightmax", ".tsoil", 26 | ".vpd", ".wind", ".CO2", ".lapse_rate_tmin", ".lapse_rate_tmax",".tdewpoint") 27 | 28 | # remove trailing '.' 29 | if (endsWith(clim_in, ".")) { 30 | clim_in = gsub("\\.$","",clim_in) 31 | } 32 | 33 | # if its the base station, return it read in and in list form 34 | if (endsWith(clim_in, ".base") & return_base) { 35 | cat("\nReading in basestation file only:\n") 36 | base_in = readLines(clim_in) 37 | base = strsplit(base_in, "\\s+") 38 | return(base) 39 | } 40 | 41 | # ============================== find clim files ============================== 42 | # if clim_in ends w .base or can find file when appended w .base, use that, 43 | # otherwise assume it's pointing to a specific clim file 44 | if (endsWith(clim_in, ".base") | file.exists(paste0(clim_in,".base"))) { 45 | if (endsWith(clim_in, ".base")) { 46 | base_in = clim_in 47 | } else if (file.exists(paste0(clim_in,".base"))) { 48 | base_in = paste0(clim_in,".base") 49 | } 50 | cat("Using basestation: ",base_in) 51 | base = data.frame(matrix(unlist(strsplit(readLines(base_in), "\\s+")), ncol = 2, byrow = T)) 52 | names(base) = c("value","variable") 53 | 54 | if (base$variable[1] == "grid cells") { 55 | isncdf = T 56 | files_in = base$value[grepl("filename",base$variable)] 57 | } else { 58 | isncdf = F 59 | files_base = base$value[base$variable == "climate_prefix"] 60 | fileopts = paste0(files_base, opts) 61 | files_in = fileopts[file.exists(fileopts)] 62 | } 63 | } else { 64 | # could not find basestation, just try to use old version of matching files clim_in as base name 65 | # for a single specified file 66 | if (any(endsWith(clim_in, opts))) { 67 | if (file.exists(clim_in)) { 68 | files_in = clim_in 69 | } else { 70 | print(noquote("Specified single clim file does not exist")) 71 | return(NULL) 72 | } 73 | } else { 74 | # multiple files that match extensions 75 | fileopts = paste0(clim_in, opts) 76 | files_in = fileopts[file.exists(fileopts)] 77 | } 78 | } 79 | 80 | if (length(files_in) == 0) { 81 | warning("Could not find any clim files matching path and prefix/basestation: ", clim_in, ". Returning 'NULL'.") 82 | return(NULL) 83 | } 84 | 85 | if (isncdf) { 86 | # ============================== read netcdf clim ============================== 87 | nc_in = lapply(files_in, ncdf4::nc_open) 88 | # each list item is a 3 dim grid of the data 89 | nc_array = lapply(nc_in, function(X){ncdf4::ncvar_get(X, attributes(X$var)$names[1])}) 90 | # wide format 91 | nc_df_list = lapply(nc_array, function(X){as.data.frame(matrix(X, nrow = dim(X)[3], byrow = T))}) 92 | shortnames = sapply(nc_in, function(X){X$var[[1]]$longname}) 93 | nc_df_list2 = mapply(function(X,Y){names(X) = paste0(Y,"_",seq_along(names(X)));return(X) },nc_df_list,shortnames, SIMPLIFY = F) 94 | clim = do.call(cbind, nc_df_list2) 95 | # add dates while in wide 96 | days = ncdf4::ncvar_get(nc_in[[1]], "time") 97 | clim$date = as.Date("1900-01-01") + days 98 | 99 | } else { 100 | # ============================== read standard clim ============================== 101 | read_in = lapply(files_in, readLines) 102 | starts_in = sapply(read_in, "[[", 1) 103 | lengths_in = sapply(read_in, length) 104 | trimstart = sapply(strsplit(starts_in,"\\s+"), function(x) paste(x[1],x[2],x[3])) 105 | start_dates = as.POSIXct(trimstart,format = "%Y %m %d") 106 | date_seqs = mapply(datefun, start_dates, lengths_in, SIMPLIFY = FALSE) 107 | dataonly = mapply(function(x) as.numeric(x[2:length(x)]), read_in, SIMPLIFY = FALSE) 108 | premerge = mapply("data.frame", date = date_seqs, dataonly, stringsAsFactors = FALSE, SIMPLIFY = FALSE) 109 | clim = Reduce(function(x,y) { 110 | tmp = merge(x = x, y = y, by = "date", all = TRUE) 111 | tmp2 = subset(tmp, !is.na(date)) 112 | return(tmp2) 113 | }, premerge) 114 | nm = stringr::str_remove(files_in, clim_in) 115 | nm = stringr::str_remove(nm,".") 116 | names(clim)[2:ncol(clim)] = nm 117 | clim = subset(clim, !is.na(date)) 118 | } 119 | 120 | # ============================== dates out ============================== 121 | if (dates_out) { 122 | start_end = as.Date(c(min(clim$date,na.rm=T), max(clim$date,na.rm=T)), format = "%m/%d/%y") 123 | start_end = gsub("-", " ",start_end) 124 | start_end = paste(start_end, c("01", "24")) 125 | return(start_end) 126 | } 127 | 128 | clim$date = as.POSIXlt(clim$date) 129 | clim = clim |> subset(!is.na(date)) 130 | clim$year = clim$date$year + 1900 131 | clim$month = clim$date$mon + 1 132 | clim$day = clim$date$mday 133 | clim$wy = ifelse(clim$month >= 10, clim$year + 1, clim$year) 134 | clim$yd = lubridate::yday(clim$date) 135 | clim$wyd = get_waterYearDay(clim$date) 136 | 137 | return(clim) 138 | } 139 | 140 | -------------------------------------------------------------------------------- /R/build_redefine.R: -------------------------------------------------------------------------------- 1 | #' build_redefine 2 | #' 3 | #' Create a redefine worldfile 4 | #' 5 | #' @param worldfile Source worldfile 6 | #' @param out_file Destination file to write 7 | #' @param vars variables to edit 8 | #' @param values values to insert for variables 9 | #' @param std_thin Value to insert for standard thinning state vars (replacement value or multiplier depending on usage) 10 | #' @param patchID Patch ID(s) to apply redefine to, can be used alone or with other subsets 11 | #' @param strataID Strata ID(s) to apply redefine to, can be used alone or with other subsets 12 | #' @param veg_parm_ID veg parm ID to apply changes to, can be used alone or with other subsets 13 | #' @author Will Burke 14 | #' 15 | #' @export 16 | 17 | build_redefine = function(worldfile, out_file, vars = NULL, values = NULL, std_thin = NULL, patchID = NULL, strataID = NULL, veg_parm_ID = NULL) { 18 | 19 | 20 | # ---------- Check Arguments ---------- 21 | if (!file.exists(worldfile)) { stop(noquote(paste0("No file found at: ", worldfile))) } 22 | if (file.exists(out_file)) {cat("File:",out_file,"will be overwritten.\n")} 23 | 24 | # Either need vars + values or std_thin 25 | if ((is.null(vars) | is.null(values)) & is.null(std_thin)) { 26 | stop(cat("Input is required for both `vars` and `values`, or `std_thin`")) 27 | } 28 | # if using vars + values - values must either be length of vars or 1 29 | if ((!is.null(vars) & !is.null(values)) && length(vars) != length(values) && length(values) != 1) { 30 | stop(cat("Input length mismatch:", length(vars), "input `vars` and", length(values), 31 | "input `values`. `length(values) == length(vars)` or `length(values) == 1`.\n")) 32 | } 33 | 34 | # read and parse 35 | world = read_world(worldfile) 36 | 37 | # get patch ID col that includes stratum 38 | world$patch_ID = world$ID 39 | world$patch_ID[world$level == "canopy_strata"] = NA 40 | world$patch_ID = zoo::na.locf(world$patch_ID) 41 | world$patch_ID[world$level %in% c("world", "basin", "hillslope", "zone")] = NA 42 | 43 | # read to be used for final line by line replacement 44 | read_world = readLines(worldfile, warn = FALSE, encoding = "UTF-8") 45 | read_world = read_world[nchar(trimws(read_world)) > 0] 46 | 47 | # thinning vars 48 | thin_vars = c( 49 | "cs.cpool", 50 | "cs.leafc", 51 | "cs.dead_leafc", 52 | "cs.live_stemc", 53 | "cs.dead_stemc", 54 | "cs.live_crootc", 55 | "cs.dead_crootc", 56 | "cs.frootc" 57 | ) 58 | 59 | # could add, but wont be read anyways: 60 | # "ns.npool" 61 | # "ns.leafn" 62 | # "ns.dead_leafn" 63 | # "ns.live_stemn" 64 | # "ns.dead_stemn" 65 | # "ns.live_crootn" 66 | # "ns.dead_crootn" 67 | # "ns.frootn" 68 | 69 | other_thin_vars = c("cover_fraction", "gap_fraction", "cs.stem_density") 70 | 71 | # ---------- Thinning redefine ---------- 72 | redef_index = NULL 73 | if (!is.null(std_thin)) { 74 | 75 | redef_strata = rep.int(TRUE, length(world$vars)) 76 | redef_veg_strata = rep.int(TRUE, length(world$vars)) 77 | redef_patch = rep.int(TRUE, length(world$vars)) 78 | 79 | if (!is.null(patchID)) { 80 | # this only works if changing patch vars 81 | redef_patch = world$patch_ID %in% as.character(patchID) 82 | 83 | } 84 | if (!is.null(strataID)) { 85 | # functionality to support using just 1 or 2 86 | # if (all(nchar(strataID) == 1) & all(nchar(unique(world$ID[world$level == "canopy_strata"])) > 1)) { 87 | # redef_strata = strata_IDs[substr(strata_IDs, nchar(strata_IDs), nchar(strata_IDs)) == as.character(strataID)] 88 | # } 89 | redef_strata = world$level == "canopy_strata" & world$ID %in% as.character(strataID) 90 | } 91 | if (!is.null(veg_parm_ID)) { 92 | redef_veg_strata = world$unique %in% world$unique[world$vars == "veg_parm_ID" & world$values %in% as.character(veg_parm_ID)] 93 | } 94 | 95 | redef_index = which(redef_patch & redef_strata & redef_veg_strata & (world$vars %in% thin_vars)) 96 | if (length(redef_index) == 0) {redef_index = NULL} 97 | redef_values_old = world$values[redef_index] 98 | 99 | redef_values = as.character(rep.int(std_thin, length(redef_values_old))) 100 | 101 | if (!is.null(redef_index)) { 102 | read_world[redef_index] = unname(mapply(sub,paste0(redef_values_old,"[[:blank:]]"),paste0(redef_values,"\t"),read_world[redef_index])) 103 | } 104 | } 105 | 106 | # ---------- Find and Replace Vars ---------- 107 | replace_index = NULL 108 | if (!is.null(vars) & !is.null(values)) { 109 | if (length(vars) > 1 & length(values) == 1) { 110 | values = rep.int(values, length(vars)) 111 | } 112 | 113 | for (i in 1:length(vars)) { 114 | 115 | replace_index = which(world$vars == vars[i]) 116 | if (length(replace_index) == 0) {stop(noquote("var to replace can't be found in worldfile.\n")) } 117 | 118 | # if unique values for every instance of var to be replaces were given, do nothing, otherwise repeat to get enough replacement values 119 | current_value = world$values[replace_index] 120 | if (length(values[i]) != length(replace_index)) { 121 | new_value = rep(values[i], length(replace_index)/length(values[i])) 122 | } else { 123 | new_value = values[i] 124 | } 125 | 126 | if (!is.null(replace_index)) { 127 | read_world[replace_index] = unname(mapply(sub,paste0(current_value,"[[:blank:]]"),paste0(new_value,"\t"),read_world[replace_index])) 128 | } 129 | } 130 | } 131 | 132 | 133 | if ( (is.null(redef_index) || all(!redef_index)) & (is.null(replace_index) || all(!replace_index)) ) { 134 | cat("No vars matched criteria, all set to -9999.\n") 135 | } 136 | 137 | # ---------- Replace all other values w -9999 ---------- 138 | keep_vars = c( 139 | "world_ID", 140 | "basin_ID", 141 | "hillslope_ID", 142 | "zone_ID", 143 | "patch_ID", 144 | "canopy_strata_ID", 145 | "num_basins", 146 | "num_hillslopes", 147 | "num_zones", 148 | "num_patches", 149 | "num_canopy_strata", 150 | "num_stratum", 151 | "basin_n_basestations", 152 | "basin_basestation_ID", 153 | "hillslope_n_basestations", 154 | "hillslope_basestation_ID", 155 | "zone_n_basestations", 156 | "zone_basestation_ID", 157 | "patch_n_basestations", 158 | "patch_basestation_ID", 159 | "canopy_strata_n_basestations", 160 | "canopy_strata_basestation_ID" 161 | ) 162 | keep_index = c(unique(redef_index, replace_index), which(world$vars %in% keep_vars)) 163 | no_change_vars = c(1:length(read_world))[-keep_index] 164 | no_change_value = world$values[no_change_vars] 165 | 166 | read_world[no_change_vars] = unname(mapply(sub,paste0(no_change_value,"[[:blank:]]"),paste0("-9999","\t"),read_world[no_change_vars])) 167 | 168 | # ---------- Write file ---------- 169 | writeLines(text = read_world,out_file) 170 | 171 | cat("Successfully wrote redefine worldfile to",out_file,"\n") 172 | 173 | } 174 | --------------------------------------------------------------------------------