Test pull

.Rbuildignore

@@ -1,2 +1,3 @@
 ^.*\.Rproj$
-^\.Rproj\.user$
+^\.Rproj\.user$
+^\.github$

.github/.gitignore

@@ -0,0 +1 @@
+*.html

.github/CODEOWNERS

@@ -0,0 +1,4 @@
+## Giving pull request review access to these users 
+*	@rburghol
+*	@BrendanBrogan
+*	@COBrogan

.github/workflows/r.yml

@@ -19,10 +19,10 @@ permissions:
 
 jobs:
   build:
-    runs-on: macos-latest
+    runs-on: windows-latest
     strategy:
       matrix:
-        r-version: ['3.6.3', '4.1.1']
+        r-version: ['4.4.1']
 
     steps:
       - uses: actions/checkout@v3

DESCRIPTION

@@ -25,5 +25,6 @@ Imports:
     lubridate,
     plyr,
     RPostgres,
+    DBI,
     R6,
     sqldf

NAMESPACE

@@ -15,7 +15,10 @@ export(dHOMConstant)
 export(dHOMConsumptiveUseFractionsPWS)
 export(dHOMDataMatrix)
 export(dHOMEquation)
+export(dHOMHydroImpoundment)
+export(dHOMHydroImpoundmentSmall)
 export(dHOMObjectClass)
+export(dHOMWaterSystemTieredFlowBy)
 export(dHOMbroadCastObject)
 export(dHOMtextField)
 export(dHVarAnnotation)

R/RomDataSource.R

@@ -101,7 +101,7 @@ RomDataSource <- R6Class(
       if (self$connection_type == 'rest') {
         private$token <- om_vahydro_token(self$site, self$rest_uname, rest_pw)
       } else {
-        self$connection <- dbConnect(
+        self$connection <- DBI::dbConnect(
           bigint = "integer",
           RPostgres::Postgres(),
           dbname = self$dbname,
@@ -587,6 +587,9 @@ RomDataSource <- R6Class(
             }
           }
         }
+        # have an post process export method
+        export[[thisobject$propname]] <- plugin$exportOpenMIpost(thisobject,
+                                                                 export[[thisobject$propname]])
         return(export)
 
       } else {

R/RomProperty.R

@@ -428,12 +428,30 @@ RomProperty <- R6Class(
       }
       super$delete(delete_remote)
     },
-    #' @param row_cols update the matrix
-    #' @return NULL
+    #'@description 
+    #'Takes in a data frame where each column represents a row to store in the 
+    #'data matrix of this object. This method tranposes that data frame while
+    #'trying to maintain data strcutures and types
+    #' @param row_cols A data frame of rows that will be transposed to meet final
+    #' model or property structure e.g. \code{data.frame(c(1,'foo'), c(2,'bar'), c(3,'bingo'))}
+    #' will be coerced to \code{data.frame(c(1,2,3), c('foo','bar','bingo'))}
+    #' @return Nothing, but will set the data_matrix field on RomProperty
+    #'   instance
     set_matrix = function(row_cols) {
       # expects a set of rows like this:
       # data.frame(c(1,'foo'), c(2,'bar'), c(3,'bingo'))
-      row_cols <- data.frame(t(row_cols),row.names=NULL)
+      #Transpose each row and then combine into one data frame. Previously we
+      #had used t() on the entire data frame to do this all at once, but t()
+      #required conversion to matrix which can only hold one data type and was
+      #adding white space to vectors with both charaters and numerics as it
+      #tried to keep consistent numbers of character
+      row_cols <- mapply(
+        FUN = function(df,coli){t(df[,coli])},
+        coli = 1:ncol(row_cols),
+        MoreArgs = list(df = row_cols),
+        SIMPLIFY = FALSE)
+      #Convert to data frame, but remove column names:
+      row_cols <- as.data.frame(do.call(rbind,row_cols))
       names(row_cols) <- NULL
       self$data_matrix = row_cols
     },

R/TNC_IHA_Ports.R

@@ -132,6 +132,15 @@ water.year <- function (x) {
 #'@author jason.e.law@@gmail.com (imported to Hydrotools by Connor Brogan,connor.brogan@@deq.virginia.gov)
 #'@references
 #'\url{http://www.nature.org/initiatives/freshwater/conservationtools/art17004.html}
+#' @examples 
+#'# #Get data for NF Shenandoah Mount Jackson
+#'# flows <- dataRetrieval::readNWISdv("01633000",parameterCd = "00060")
+#'# flows <- dataRetrieval::renameNWISColumns(flows)
+#'# #Convert flows to zoo
+#'# flows_zoo <- zoo::as.zoo(x = flows$Flow)
+#'# zoo::index(flows_zoo) <- flows$Date
+#'# #Use group 1 to get the minimum monthly flows:
+#'# hydrotools::group1(flows_zoo,"water",FUN = min)
 #'@importFrom zoo index coredata is.zoo
 #'@importFrom lubridate year month
 #'@importFrom rapportools median
@@ -193,6 +202,15 @@ group1 <- function (
 #'@return a data frame with the group 2 statistics for each year
 #'@author jason.e.law@@gmail.com (imported to Hydrotools by Connor Brogan,connor.brogan@@deq.virginia.gov)
 #'@references \url{http://www.conservationgateway.org/Files/Pages/indicators-hydrologic-altaspx47.aspx}
+#'@examples 
+#'# #Get data for NF Shenandoah Mount Jackson
+#'# flows <- dataRetrieval::readNWISdv("01633000",parameterCd = "00060")
+#'# flows <- dataRetrieval::renameNWISColumns(flows)
+#'# #Convert flows to zoo
+#'# flows_zoo <- zoo::as.zoo(x = flows$Flow)
+#'# zoo::index(flows_zoo) <- flows$Date
+#'# #Use group 2 to get critical period flows and stats:
+#'# hydrotools::group2(flows_zoo,"water",mimic.tnc = TRUE)
 #'@importFrom plyr ddply '.'
 #'@importFrom zoo coredata index
 #'@importFrom lubridate year

R/dHVariablePluginDefault.R

@@ -24,7 +24,6 @@ dHVariablePluginDefault <- R6Class(
       #message("Created plugin")
     },
     #' @param entity the local object to work on 
-    #' @param load_remote automatically query REST data source for matches?
     #' @return an updated config if necessary or FALSE if it fails
     exportOpenMI = function(entity) {
       # creates an array that can later be serialized as json, xml, or whatever
@@ -73,6 +72,12 @@ dHVariablePluginDefault <- R6Class(
       )
       return(export)
     },
+    #' @param entity the local object to work on 
+    #' @param export list of properties and subproperties to export
+    exportOpenMIpost = function(entity, export){
+      #Allows modification of exported property lists prior to JSON conversion
+      return(export)
+    },
     #' @param om_list the open MI export array/list to work on
     #' @return a Rom importable config or FALSE if it fails
     fromOpenMIBase = function(om_list) {
@@ -490,6 +495,79 @@ dHOMWaterSystemTieredFlowBy <- R6Class(
   )
 )
 
+
+#' VA Hydro model impoundment plugin
+#' @title dHOMHydroImpoundment
+#' @description Simple class to deal with hydro impoundment class model objects
+#' @details Has standard methods for exporting impoundment properties and subproperties
+#' @importFrom R6 R6Class  
+#' @param entity list or object with entity info
+#' @return reference class of type openmi.om.base.
+#' @seealso NA
+#' @examples NA
+#' @export dHOMHydroImpoundment
+dHOMHydroImpoundment <- R6Class(
+  "dHOMHydroImpoundment",
+  inherit = dHOMDataMatrix,
+  public = list(
+    #' @field name what is it called
+    name = NA,
+    #' @field object_class model object type
+    object_class = 'hydroImpoundment',
+    #' @param entity the local object to work on 
+    #' @return an updated config if necessary or FALSE if it fails
+    exportOpenMIBase = function(entity) {
+      #print(paste("Entity matrix:", entity$propname))
+      export = super$exportOpenMIBase(entity)
+
+      return(export)
+    }
+  )
+)
+
+#' hydroimp
+#' @title dHOMHydroImpoundmentSmall
+#' @description Simple class to hold tabular flow by values
+#' @details Has standard methods for managing data and meta data
+#' @importFrom R6 R6Class  
+#' @param entity list or object with entity info
+#' @return reference class of type openmi.om.base.
+#' @seealso NA
+#' @examples NA
+#' @export dHOMHydroImpoundmentSmall
+dHOMHydroImpoundmentSmall <- R6Class(
+  "dHOMHydroImpoundmentSmall",
+  inherit = dHOMHydroImpoundment,
+  public = list(
+    #' @field name what is it called
+    name = NA,
+    #' @field object_class model object type
+    object_class = 'hydroImpSmall',
+    #' @param entity the local object to work on 
+    #' @return an updated config if necessary or FALSE if it fails
+    exportOpenMIBase = function(entity) {
+      #print(paste("Entity matrix:", entity$propname))
+      export = super$exportOpenMIBase(entity)
+
+      return(export)
+    },
+    #' @param entity the local object to work on 
+    #' @param export current export object
+    #' @return Returns a modified list of property and children
+    exportOpenMIpost = function(entity, export = list()) {
+      #Copy the storage_stage_area matrix and properties over to a new list
+      #matrix that is expected in the php import to OM
+      message("Copying impoundment storage_stage_area to matrix")
+      export[['matrix']] <- export[['storage_stage_area']][['matrix']]
+      #Remove the original list
+      export[['storage_stage_area']] <- NULL
+      return(export)
+    }
+  )
+)
+
+
+
 # 'This is here because there is no way to instantiate a dynamic class using 
 # 'a string for a class name, so we have to have logic to expose allowed classes
 #' Retrieve Plugin object for a variable entity
@@ -506,6 +584,10 @@ get_plugin_class <- function(plugin_name, entity) {
     plugin = dHVariablePluginDefault$new(entity)
   } else if (plugin_name == "dHOMConstant") {
     plugin = dHOMConstant$new(entity)
+  } else if (plugin_name == "dHOMHydroImpoundmentSmall") {
+    plugin = dHOMHydroImpoundmentSmall$new(entity)
+  } else if (plugin_name == "dHOMHydroImpoundment") {
+    plugin = dHOMHydroImpoundment$new(entity)
   } else if (plugin_name == "dHOMEquation") {
     plugin = dHOMEquation$new(entity)
   } else if (plugin_name == "dHOMAlphanumericConstant") {

R/om_get_rundata.R

@@ -1,19 +1,32 @@
-#' The base class for executable equation based meta-model components.
+#' Get OM Model Data
+#' @description Retrieve model results (run data) from the VA Hydro server for a
+#'   particular model and run ID (scenario ID).
+#' @details A wrapper of \code{hydrotools::fn_get_runfile()}. This function
+#'   returns the results in a zoo (see zoo::zoo()) that has the timestamp as the
+#'   index. See \code{hydrotools::fn_get_runfile()} for more details.
 #'
-#' @param elid integer OM model element id
-#' @param runid integer run id 
-#' @param site URL of om server
+#' @param elid integer OM element connection ID e.g. the original OM model ID
+#' @param runid integer run id representing the scenario. Ask the modeling team
+#'   for scenario IDs if you are unsure otherwise see the WSPA Shiny Dashboard
+#'   for more information
+#' @param site URL of OM server, typically established in WSPA config files
 #' @param cached boolean - if TRUE will use recently stored local copy
 #' @param hydrowarmup boolean - if TRUE will trim beginning of model time frame
-#' @return reference class of type openmi.om.equation
-#' @seealso NA
+#'   to account for potential model warm up as water routes downstream from the
+#'   headwaters and operational rules engage
+#' @param cleanup Logical. Should the function delete the log file create for
+#'   the cached argument? If this is TRUE, the .log files will be deleted after
+#'   download from OM server
+#' @return data.frame of model results
 #' @export om_get_rundata
-#' @examples NA
-om_get_rundata <- function(elid, runid, site='http://deq2.bse.vt.edu', cached=FALSE, hydrowarmup=TRUE) {
-
+#' @examples #om_get_rundata(72446, 600, site=omsite)
+om_get_rundata <- function(elid, runid, site='http://deq2.bse.vt.edu',
+                           cached=FALSE, hydrowarmup=TRUE,
+                           cleanup = FALSE) {
   # replace this with a single function that grabs
   # a hydro model for summarization and slims it down
-  dat <- fn_get_runfile(elid, runid, 37, site,  cached = FALSE)
+  dat <- fn_get_runfile(elid, runid, 37, site,  cached = FALSE, cleanup = cleanup,
+                        outaszoo = outaszoo)
   syear = as.integer(min(dat$year))
   eyear = as.integer(max(dat$year))
   if ((hydrowarmup == TRUE) & (syear < (eyear - 2))) {
@@ -33,9 +46,11 @@ om_get_rundata <- function(elid, runid, site='http://deq2.bse.vt.edu', cached=FA
   #ensure there are associated timezones
   sdate <- as.POSIXct(sdate,tz = "EST")
   edate <- as.POSIXct(edate,tz = "EST")
+
   #Get the window of interest from the timeseries
   dat <- window(dat, start = sdate, end = edate);
   #Change mode of zoo to numeric e.g. Convert all fields to numeric
   mode(dat) <- 'numeric'
+
   return(dat)
 }

R/utils.R

@@ -123,14 +123,19 @@ fn_get_runfile_info <- function(
 #' @param cached boolean - use local copy or force refresh
 #' @param outaszoo boolean return as a zoo timeseries if TRUE, or as data frame
 #' @param use_tz character pass in a custom timezone for zoo
+#' @param cleanup Logical - Should the log file be deleted (TRUE) or written to
+#'   working directory (FALSE)? Note that the cached argument requires these log
+#'   files so setting cleanup to FALSE will prevent caching regardless of cached
+#'   argument
 #' @return reference class of type openmi.om.equation
 #' @seealso NA
 #' @export fn_get_runfile
 #' @examples NA
 fn_get_runfile <- function(
   elementid = -1, runid = -1, scenid = 37,
   site = "http://deq2.bse.vt.edu", cached = TRUE, 
-  outaszoo=TRUE, use_tz=FALSE
+  outaszoo=TRUE, use_tz=FALSE,
+  cleanup = FALSE
   ) {
   if (elementid == -1 ) {
     return(FALSE);
@@ -222,6 +227,12 @@ fn_get_runfile <- function(
     f3 <- zoo::zoo(datv, order.by = datv$timestamp)
   }
   unlink('tempfile')
+  #If the user has provided a logical value for cleanup, check to see if user
+  #has requested the logfile be deleted. If cleanup is TRUE, delete the log file
+  if(is.logical(cleanup) && cleanup){
+    unlink(filename)
+  }
+  #Return either the data frame or the zoo
   if(outaszoo){
     return(f3)  
   }else{

auth.private.example

@@ -1,7 +1,10 @@
 #VAHydro-1.0 Authentication 
-username <- "TRICKY_USERNAME"
+username <- "old_USERNAME"
 hash <- "TRICKY_PASSWORD"
 
 #VAHydro-2.0 Admin REST Authentication 
-rest_uname <- 'TRICKY_USERNAME'
+rest_uname <- 'rest_USERNAME'
 rest_pw <- 'TRICKY_PASSWORD'
+
+odbc_uname <- 'odbc_USERNAME'
+odbc_pw <- 'TRICKY_PASSWORD'

config.local.private.example

@@ -1,2 +1,13 @@
-# WHERE ARE YOU LOCALLY STORING THE hydro-tools REPOSITORY
-repo_location <- "C:\\Users\\nrf46657\\Desktop\\VAHydro Development\\GitHub\\"
+# set up a caching function for NWIS
+Sys.setenv(USGS_cache_dir = "/media/model/usgs")
+export_path <- '/Workspace/tmp/'
+
+hydro_tools <- 'https://raw.githubusercontent.com/HARPgroup/hydro-tools/master'
+cbp6_location <- 'https://raw.githubusercontent.com/HARPgroup/cbp6/master'
+hydro_tools_location <- hydro_tools
+om_location <- "https://raw.githubusercontent.com/HARPgroup/om/master"
+elfgen_location <- "https://raw.githubusercontent.com/HARPgroup/elfgen/master"
+openmi_om_location <- "https://raw.githubusercontent.com/HARPgroup/openmi-om/master"
+vahydro_location <- "https://github.com/HARPgroup/vahydro/blob/master"
+github_location <- "C:/usr/local/home/git"
+HARParchive_location <- paste0(github_location, "/HARParchive")