Merge pull request #37 from jread-usgs/master

New function w/ generic rLA methods

DESCRIPTION

@@ -17,6 +17,7 @@ Depends:
 Imports:
     ncdf4,
     RCurl,
-    tools
+    tools,
+    rLakeAnalyzer
 LazyLoad: yes
 LazyData: yes

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2 (4.0.1): do not edit by hand
 
+export(compare_to_field)
 export(get_evaporation)
 export(get_hypsography)
 export(get_ice)
@@ -25,4 +26,5 @@ export(write_wnd)
 export(write_wtr)
 import(RCurl)
 import(ncdf4)
+import(rLakeAnalyzer)
 import(tools)

R/compare_to_field.R

@@ -0,0 +1,80 @@
+#'@title compare metric for GLM vs field observations
+#'@description
+#'compare metric for GLM vs field observations, but must have more than 3 matching time points. 
+#'This function is only designed to handle calls to physical metrics that return a single value.
+#'An example of this behavior is thermocline depth (but not water density for all depth-resolved measurements).
+#'@param nc_file a string with the path to the netcdf output from GLM
+#'@param field_file a string with the path to the field observation file
+#'@param nml_file a string with the path to the nml file (optional)
+#'@param metric a string representing a physical metric. Should be a rLakeAnalyzer function or other function.
+#'@param as_value a boolean for calculating RMSE (F) or returning all values (T)
+#'@param na.rm a boolean for remove NAs for RMSE calculation (only used if as_values == F)
+#'@return a RMSE (in native units) for the comparison, or all values (if as_values == T)
+#'@keywords methods
+#'@seealso \link{resample_time}, \link{resample_to_field}
+#'@author
+#'Jordan S. Read
+#'@examples 
+#'nc_file <- system.file('extdata', 'output.nc', package = 'glmtools')
+#'field_file <- system.file('extdata', 'field_data.tsv', package = 'glmtools')
+#'
+#'CB_rmse <- compare_to_field(nc_file, field_file, metric = 'center.buoyancy')
+#'CB_values <- compare_to_field(nc_file, field_file, metric = 'center.buoyancy', as_value = TRUE)
+#'
+#'thermo_values <- compare_to_field(nc_file, field_file, metric = 'thermo.depth', as_value = TRUE)
+#'
+#'\dontrun{
+#'# -- an nml file is necessary when functions require hypsographic information
+#'values <- compare_to_field(nc_file, field_file, metric = 'schmidt.stability', as_value = TRUE)
+#'# -- will fail
+#'nml_file <- system.file('extdata', 'glm.nml', package = 'glmtools')
+#'values <- compare_to_field(nc_file, field_file, nml_file, metric = 'schmidt.stability', as_value = TRUE)
+#'# -- will succeed
+#'
+#'# -- metrics can only be calculated by functions that are available to this environment
+#'values <- compare_to_field(nc_file, field_file, metric = 'calc.fols', as_value = TRUE)
+#'# -- will fail
+#'}
+#'@import ncdf4
+#'@import rLakeAnalyzer
+#'@export
+compare_to_field <- function(nc_file, field_file, nml_file, metric, as_value = FALSE, na.rm = TRUE){
+
+  if (missing(nml_file)){
+    bthA <- NA
+    bthD <- NA
+  } else {
+    hypso <- get_hypsography(file = nml_file)
+    bthA <- hypso$Areas
+    bthD <- hypso$Depths
+  }
+  compare_data <- resample_to_field(nc_file, field_file)
+
+  un_dates <- unique(compare_data$DateTime)
+  mod_metric <- vector('numeric', length = length(un_dates))
+  obs_metric <- vector('numeric', length = length(un_dates))
+
+  for (j in 1:length(un_dates)){
+    date <- un_dates[j]
+    u_i <- compare_data$DateTime == date
+    depths <- compare_data$Depth[u_i]
+    temp_obs <- compare_data[u_i, 3]
+    temp_mod <- compare_data[u_i, 4]
+
+    rmv_i <- is.na(temp_obs + temp_mod)
+    mod_list <- list(wtr=temp_mod[!rmv_i], depths = depths[!rmv_i], bthA = bthA, bthD = bthD)
+    obs_list <- list(wtr=temp_obs[!rmv_i], depths = depths[!rmv_i], bthA = bthA, bthD = bthD)
+    use_names <- names(mod_list) %in% names(formals(metric)) # test to only use list elements that are inluded in the function args
+    mod_metric[j] <- do.call(get(metric), mod_list[use_names]) 
+    obs_metric[j] <- do.call(get(metric), obs_list[use_names]) 
+  }
+
+  if (as_value){
+    compare.df <- data.frame('obs'=obs_metric, 'mod'=mod_metric)
+    return(compare.df)
+  } else {
+    RMSE <- sqrt(mean((mod_metric-obs_metric)^2 , na.rm = na.rm))
+    return(RMSE)
+  }
+
+}

R/plot_helpers.R

@@ -56,7 +56,7 @@ color_key <- function(levels, colors, subs, ps){
   old_mgp <- par()$mgp
   old_mai <- par()$mai
   par(mai=c(old_mai[1],0, old_mai[3], .2), mgp = c(0,0,0))
-  axis(side = 4, at = 0.5, tck = NA, labels='Temperature (°C)', lwd = 0.0)
+  axis(side = 4, at = 0.5, tck = NA, labels='Temperature (\u00B0C)', lwd = 0.0)#(\xB0 C)
   spc_pol_rat <- 0.2 # ratio between spaces and bars
 
   p_start <- 0.1

R/plot_temp.R

@@ -1,14 +1,15 @@
 #'@title plot water temperatures from a GLM simulation
 #'@param file a string with the path to the netcdf output from GLM
-#'@param refences a string for 'surface' or 'bottom'
+#'@param reference a string for 'surface' or 'bottom'
 #'@param num_cells number of vertical cells to use for heatmap
+#'@param fig_path F if plot to screen, string path if save plot as .png
 #'@keywords methods
 #'@seealso \link{get_temp}
 #'@author
 #'Jordan S. Read, Luke A. Winslow
 #'@examples 
 #'file <- system.file('extdata', 'output.nc', package = 'glmtools')
-#'plot_temp(file = file, fig_path = F)
+#'plot_temp(file = file, fig_path = FALSE)
 #'plot_temp(file = file, fig_path = '../test_figure.png')
 #'@export
 plot_temp <- function(file, reference = 'surface', num_cells = 100, fig_path = F){

R/resample_to_field.R

@@ -3,7 +3,7 @@
 #'@param field_file a string with the path to the field observation file
 #'@return validation a data.frame with DateTime and temperature at depth 
 #'@keywords methods
-#'@seealso \link{resample_time}, \link{get_temps}
+#'@seealso \link{resample_time}, \link{get_temp}
 #'@author
 #'Jordan S. Read
 #'@examples 

man/compare_to_field.Rd

@@ -0,0 +1,59 @@
+% Generated by roxygen2 (4.0.1): do not edit by hand
+\name{compare_to_field}
+\alias{compare_to_field}
+\title{compare metric for GLM vs field observations}
+\usage{
+compare_to_field(nc_file, field_file, nml_file, metric, as_value = FALSE,
+  na.rm = TRUE)
+}
+\arguments{
+\item{nc_file}{a string with the path to the netcdf output from GLM}
+
+\item{field_file}{a string with the path to the field observation file}
+
+\item{nml_file}{a string with the path to the nml file (optional)}
+
+\item{metric}{a string representing a physical metric. Should be a rLakeAnalyzer function or other function.}
+
+\item{as_value}{a boolean for calculating RMSE (F) or returning all values (T)}
+
+\item{na.rm}{a boolean for remove NAs for RMSE calculation (only used if as_values == F)}
+}
+\value{
+a RMSE (in native units) for the comparison, or all values (if as_values == T)
+}
+\description{
+compare metric for GLM vs field observations, but must have more than 3 matching time points.
+This function is only designed to handle calls to physical metrics that return a single value.
+An example of this behavior is thermocline depth (but not water density for all depth-resolved measurements).
+}
+\examples{
+nc_file <- system.file('extdata', 'output.nc', package = 'glmtools')
+field_file <- system.file('extdata', 'field_data.tsv', package = 'glmtools')
+
+CB_rmse <- compare_to_field(nc_file, field_file, metric = 'center.buoyancy')
+CB_values <- compare_to_field(nc_file, field_file, metric = 'center.buoyancy', as_value = TRUE)
+
+thermo_values <- compare_to_field(nc_file, field_file, metric = 'thermo.depth', as_value = TRUE)
+
+\dontrun{
+# -- an nml file is necessary when functions require hypsographic information
+values <- compare_to_field(nc_file, field_file, metric = 'schmidt.stability', as_value = TRUE)
+# -- will fail
+nml_file <- system.file('extdata', 'glm.nml', package = 'glmtools')
+values <- compare_to_field(nc_file, field_file, nml_file, metric = 'schmidt.stability', as_value = TRUE)
+# -- will succeed
+
+# -- metrics can only be calculated by functions that are available to this environment
+values <- compare_to_field(nc_file, field_file, metric = 'calc.fols', as_value = TRUE)
+# -- will fail
+}
+}
+\author{
+Jordan S. Read
+}
+\seealso{
+\link{resample_time}, \link{resample_to_field}
+}
+\keyword{methods}
+

man/plot_temp.Rd

@@ -8,16 +8,18 @@ plot_temp(file, reference = "surface", num_cells = 100, fig_path = F)
 \arguments{
 \item{file}{a string with the path to the netcdf output from GLM}
 
-\item{refences}{a string for 'surface' or 'bottom'}
+\item{reference}{a string for 'surface' or 'bottom'}
 
 \item{num_cells}{number of vertical cells to use for heatmap}
+
+\item{fig_path}{F if plot to screen, string path if save plot as .png}
 }
 \description{
 plot water temperatures from a GLM simulation
 }
 \examples{
 file <- system.file('extdata', 'output.nc', package = 'glmtools')
-plot_temp(file = file, fig_path = F)
+plot_temp(file = file, fig_path = FALSE)
 plot_temp(file = file, fig_path = '../test_figure.png')
 }
 \author{

man/resample_to_field.Rd

@@ -26,7 +26,7 @@ temps <- resample_to_field(nc_file, field_file)
 Jordan S. Read
 }
 \seealso{
-\link{resample_time}, \link{get_temps}
+\link{resample_time}, \link{get_temp}
 }
 \keyword{methods}