Fixed outstanding output filter issues

R/IOin_clim.R

@@ -72,30 +72,5 @@ IOin_clim = function(base_station_id,
     )
   )
 
-  # input_clim_base_list <- list(
-  #   list(
-  #     core = data.frame(
-  #       values = c(base_station_id, x_coordinate, y_coordinate, effective_lai, screen_height),
-  #       vars = c("base_station_id", "x_coordinate", "y_coordinate", "effective_lai", "screen_height")
-  #     ),
-  #     annual = data.frame(
-  #       values = c(annual_prefix, num_non_critical_annual_sequences),
-  #       vars = c("annual_climate_prefix","number_non_critical_annual_sequences")
-  #     ),
-  #     monthly = data.frame(
-  #       values = c(monthly_prefix, num_non_critical_monthly_sequences),
-  #       vars = c("monthly_climate_prefix","number_non_critical_monthly_sequences")
-  #     ),
-  #     daily = data.frame(
-  #       values = c(daily_prefix, num_non_critical_daily_sequences),
-  #       vars = c("daily_climate_prefix","number_non_critical_daily_sequences")
-  #     ),
-  #     hourly = data.frame(
-  #       values = c(hourly_prefix, num_non_critical_hourly_sequences),
-  #       vars = c("hourly_climate_prefix","number_non_critical_hourly_sequences")
-  #     )
-  #   )
-  # )
-
   return(output_clim_base)
 }

R/make_hdr_file2.R

@@ -52,7 +52,7 @@ make_hdr_file2 = function(input_rhessys,
   }
   world_hdr_name_out <- file.path(world_hdr_path, paste0(input_rhessys$world_hdr_prefix, runID, ".hdr"))
   write.table(hdr_df, file = world_hdr_name_out, col.names = FALSE, row.names = FALSE, quote = FALSE, sep = "\t\t")
-  cat("\n===== Wrote hdr file '",world_hdr_name_out,"' =====", sep = "")
+  cat("===== Wrote hdr file '",world_hdr_name_out,"' =====\n", sep = "")
 
   # NOTE ON WRITE SPEEDS
   # write times w data.table::fwrite is only ~100 microsec faster for the header

R/modify_output_filter.R

@@ -40,7 +40,7 @@ modify_output_filter = function(filter_in,
 
     filter[[1]][names(filter[[1]]) %in% c('basin', 'hillslope', 'zone', 'patch', 'stratum')] = NULL
 
-    filter[[1]]$tmp = list("ids" = spatial_ID, "variables" = variables)
+    filter[[1]]$tmp = list("ids" = spatial_ID, "variables" = paste(variables, collapse = ", "))
 
     names(filter[[1]])[names(filter[[1]]) == "tmp"] = spatial_level
 
@@ -51,7 +51,8 @@ modify_output_filter = function(filter_in,
   }
 
   if (!is.null(variables)) {
-    filter[[1]][[which(names(filter[[1]]) %in% c('basin', 'hillslope', 'zone', 'patch', 'stratum'))]]$variables = variables
+    filter[[1]][[which(names(filter[[1]]) %in% c('basin', 'hillslope', 'zone', 'patch', 'stratum'))]]$variables = paste(variables, collapse = ", ")
+
   }
 
   return(filter)

R/rhessys_command.R

@@ -67,7 +67,13 @@ rhessys_command <- function(rhessys_version,
     tmp = noquote(paste("bash -c \"", tmp, "\"", sep = ""))
   }
 
-  print(paste("Command line echo:", tmp), quote = FALSE)
+  cat("Command line echo:", tmp, "\n")
+  #print(paste("Command line echo:", tmp), quote = FALSE)
+
+  cat("\n----------------------------------------\n")
+  cat("===== Beginning RHESSys Simulation =====\n")
+  cat("----------------------------------------\n\n")
+
   system(tmp)
 
 }

R/run_rhessys_single.R

@@ -34,6 +34,9 @@ run_rhessys_single <- function(input_rhessys,
                                return_data = FALSE,
                                runID = NULL) {
 
+  cat("\n--------------------------------------------\n")
+  cat("===== Beginning RHESSysIO file writing =====\n")
+  cat("--------------------------------------------\n\n")
   # ------------------------------ Input checks ------------------------------
   req_rhessys_input = c( "rhessys_version", "tec_file", "world_file", "world_hdr_prefix", "flow_file",
                           "start_date", "end_date")
@@ -56,9 +59,12 @@ run_rhessys_single <- function(input_rhessys,
   }
 
   # ------------------------------ Def file parameters ------------------------------
-  # check the def files all exist - except for the fire grid prefix
-  if (any(!file.exists(unlist(hdr_files[names(hdr_files) != "fire_grid_prefix"] )))) {
-    stop("Def file(s) '", unlist(hdr_files[names(hdr_files) != "fire_grid_prefix"])[!file.exists(unlist(hdr_files[names(hdr_files) != "fire_grid_prefix"]))],"' is/are not exist at specified path." )
+  # check the def files all exist - except for the fire grid prefix, and clim if clim is also given as input
+  not_check = 'fire_grid_prefix'
+  if (!is.null(clim_base)) {not_check = c(not_check, 'base_stations')}
+
+  if (any(!file.exists(unlist(hdr_files[!names(hdr_files) %in% not_check])))) {
+    stop("Def file(s) '", unlist(hdr_files[!names(hdr_files) %in% not_check])[!file.exists(unlist(hdr_files[!names(hdr_files) %in% not_check]))],"' is/are not exist at specified path." )
   }
   # TODO if keeping the fire grid header method - add check for those files if header is included
 
@@ -83,7 +89,7 @@ run_rhessys_single <- function(input_rhessys,
       new_file = change_def_file(def_file = f, par_sets = def_par_subset, file_name_ext = runID)
       def_files[def_files[,1] == f, 2] = new_file
     }
-    cat("\n===== Wrote def files =====")
+    cat("===== Wrote def files =====\n")
   } else {
     def_files = NULL
   }
@@ -122,7 +128,7 @@ run_rhessys_single <- function(input_rhessys,
   # TODO add climate and dated seqeunce functionality in here
   if (!is.null(clim_base)) {
     # Output standard clim file
-    cat("\n===== Wrote clim base station file =====\n")
+    cat("===== Wrote clim base station file =====\n")
     write.table(clim_base, file = hdr_files$base_stations, row.names = FALSE, col.names = FALSE, quote = FALSE, sep = "       ")
 
   }
@@ -134,7 +140,7 @@ run_rhessys_single <- function(input_rhessys,
   # ------------------------------ Temporal event control (tec) file ------------------------------
   if (!is.null(tec_data)) {
     write.table(tec_data, file = input_rhessys$tec_file, col.names = FALSE, row.names = FALSE, quote = FALSE)
-    cat("\n===== Wrote tec file =====\n")
+    cat("===== Wrote tec file =====\n")
   }
 
   # ------------------------------ Output Filters ------------------------------
@@ -150,6 +156,12 @@ run_rhessys_single <- function(input_rhessys,
     filter_path = NULL
   }
 
+
+  cat("\n-------------------------------------------\n")
+  cat("===== Finished RHESSysIO file writing =====\n")
+  cat("-------------------------------------------\n\n")
+
+
   # ------------------------------ Call RHESSys ------------------------------
   rhessys_command(rhessys_version = input_rhessys$rhessys_version,
                   world_file = input_rhessys$world_file,

R/write_output_filter.R

@@ -41,7 +41,17 @@ write_output_filter = function(output_filter, runID = NULL) {
     file_name = paste0(file_name, "_", runID)
   }
   # write the output filter
-  yaml::write_yaml(x = output_filter, file = file_name)
+  #yaml::write_yaml(x = output_filter, file = file_name)
+
+  # workaround beacuse brians code assumes integers
+  yaml_out = yaml::as.yaml(x = output_filter)
+  yaml_out = gsub("\\.0", "", yaml_out)
+
+  file = file(file_name, "w")
+  cat(yaml_out, file = file, sep = "")
+  close(file)
+
+  cat("===== Wrote output filter file =====\n")
 
   return(file_name)
 

tests/testthat/test-single_run.R

@@ -110,4 +110,7 @@ test_that("Simplest RHSSys run options run successfully (core rhessys info, tec
   expect_file_sizeKB_gt(path = "out/w8TC_grow_basin.daily", size_KB = 5)
 })
 
+# should add cleanup here if more tests are going to be run that depend on the file system state - otherwise doesn't really matter
+
+
 

vignettes/IOin_examples.Rmd

@@ -150,7 +150,7 @@ run_rhessys_single(
 
 This is just to generate a basestation on the fly, but can be useful when running across multiple climate series, and to ensure the paths in the base station file are correct. Future additions will support more complex modification of climate sequences and more.
 
-```{r eval=FALSE}
+```{r, echo=FALSE, results='hide'}
 input_clim = IOin_clim(
   base_station_id = 101,
   x_coordinate = 100.0,
@@ -160,6 +160,16 @@ input_clim = IOin_clim(
   screen_height = 160,
   daily_prefix = "clim/w8_daily"
 )
+# if set to existing file name, existing base station will be overwritten.
+input_hdr$base_stations = "clim/w8_base_test"
+
+run_rhessys_single(
+  input_rhessys = input_rhessys,
+  hdr_files = input_hdr,
+  tec_data = input_tec_data,
+  clim_base = input_clim
+)
+
 ```
 
 ## Output
@@ -168,59 +178,54 @@ input_clim = IOin_clim(
 
 Output filters require a output filter file in yaml format, containing any number of filters. `run_rhessys_single()` can write a filter file based on an input R data object (list). The functions below allow for reading of existing output filters, modification, and creation of new output filters.
 
-```{r }
+```{r, echo=FALSE, results='hide'}
 # read an existing filter file
-filter = read_output_filter(filter_in = "tecfiles/testing_filter.yml")
-# equivilent
-filter = IOin_output_filters(filter_in = "tecfiles/testing_filter.yml")
+filter1 = read_output_filter(filter_in = "tecfiles/testing_filter.yml")
+# equivalent
+# filter = IOin_output_filters(filter_in = "tecfiles/testing_filter.yml")
 
 # create a new filter R object
-filter = build_output_filter(
+filter2 = build_output_filter(
   timestep = "daily",
   output_format = "csv",
-  output_path = "./out",
+  output_path = "../Testing/out",
   output_filename = "basin_daily",
   spatial_level = "basin",
-  spatial_ID = "1",
-  variables = c("patch.total_water_in", "patch.streamflow")
+  spatial_ID = as.integer("1"),
+  variables = c("patch.total_water_in", "patch.streamflow", "patch.evaporation")
 )
 
 # modify an existing filter, either from file or R object, and return R obj
 # all options left null (the default) will use the existing value.
-filter = modify_output_filter(
+filter3 = modify_output_filter(
   filter_in = "tecfiles/testing_filter.yml",
-  timestep = NULL,
-  output_format = NULL,
-  output_path = NULL,
-  output_filename = NULL,
-  spatial_level = NULL,
-  spatial_ID = NULL,
-  variables = c("patch.streamflow", "patch.evaporation")
+  variables = c("patch.total_water_in", "patch.streamflow", "patch.evaporation")
 )
 
 # combine output filters and create object ready to input to run_rhessys_single/multi
-multi_filter = IOin_output_filters(filter, filter_in = "tecfiles/testing_filter2.yml", file_name = "test_output_filters")
+filter4 = IOin_output_filters(filter, filter_in = "tecfiles/testing_filter2.yml", file_name = "test_output_filters")
 
 # for just a single filter with named filter file
-filter = IOin_output_filters(filter, file_name = "tecfiles/test_output_filter2.yml")
+input_filter = IOin_output_filters(filter2, file_name = "tecfiles/test_output_filter.yml")
 
-# adjust core rhessys inputs - can't have -b -p etc with output filters
+# adjust core rhessys inputs - can't have -b -p etc output along with output filters
 input_rhessys$command_options = NULL
 
+
 run_rhessys_single(
   input_rhessys = input_rhessys,
   hdr_files = input_hdr,
   tec_data = input_tec_data,
   def_pars = input_def_pars,
-  output_filter = "tecfiles/test_output_filter2.yml"
+  output_filter = input_filter
 )
 
 
 ```
 
 ### Output Subsetting
 
-This will be supplanted by the new output filters method.
+This is being deprecated and though it should still function, will not be supported as new features get added.
 
 ```{r eval=FALSE}
   # to use native R-based subsetting