merged with dev, news update for 2.3.0 release

.travis.yml

@@ -1,6 +1,9 @@
-language: r
-sudo: required
+# R for travis: see documentation at https://docs.travis-ci.com/user/languages/r
+
+language: R
+sudo: false
 cache: packages
+
 os:
   - linux
-  - osx
+  - osx

DESCRIPTION

@@ -1,14 +1,14 @@
 Package: SWMPr
 Type: Package
 Title: Retrieving, Organizing, and Analyzing Estuary Monitoring Data
-Version: 2.2.0.9000
-Date: 2016-11-07
+Version: 2.3.0
+Date: 2018-02-04
 Author: Marcus W. Beck [aut, cre]
-Maintainer: Marcus W. Beck <[email protected]>
+Maintainer: Marcus W. Beck <[email protected]>
 Description: Tools for retrieving, organizing, and analyzing environmental
     data from the System Wide Monitoring Program of the National Estuarine
-    Research Reserve System <http://cdmo.baruch.sc.edu/>. These tools 
-    address common challenges associated with continuous time series data 
+    Research Reserve System <http://cdmo.baruch.sc.edu/>. These tools
+    address common challenges associated with continuous time series data
     for environmental decision making.
 BugReports: http://github.com/fawda123/SWMPr/issues
 License: CC0
@@ -20,7 +20,7 @@ Imports:
     maptools,
     oce,
     dplyr,
-    lattice, 
+    lattice,
     openair,
     RColorBrewer,
     reshape2,
@@ -32,9 +32,9 @@ Depends:
     R (>= 3.2.0),
     ggplot2,
     zoo
-Suggests: 
+Suggests:
     colorspace
 Authors@R: person(given = "Marcus W.", family = "Beck",
     role = c("aut","cre"),
-    email = "[email protected]")
-RoxygenNote: 5.0.1
+    email = "[email protected]")
+RoxygenNote: 6.0.1

NAMESPACE

@@ -2,6 +2,7 @@
 
 S3method(aggremetab,swmpr)
 S3method(aggreswmp,swmpr)
+S3method(cens_id,swmpr)
 S3method(comb,default)
 S3method(comb,swmpr)
 S3method(decomp,default)
@@ -18,6 +19,7 @@ S3method(overplot,default)
 S3method(overplot,swmpr)
 S3method(plot,swmpr)
 S3method(plot_metab,swmpr)
+S3method(plot_quants,swmpr)
 S3method(plot_summary,swmpr)
 S3method(plot_wind,swmpr)
 S3method(qaqc,swmpr)
@@ -33,6 +35,7 @@ export(aggreswmp)
 export(all_params)
 export(all_params_dtrng)
 export(calckl)
+export(cens_id)
 export(comb)
 export(decomp)
 export(decomp_cj)
@@ -41,9 +44,11 @@ export(import_local)
 export(map_reserve)
 export(metab_day)
 export(overplot)
+export(oxySol)
 export(param_names)
 export(parser)
 export(plot_metab)
+export(plot_quants)
 export(plot_summary)
 export(plot_wind)
 export(qaqc)
@@ -84,6 +89,7 @@ importFrom(stats,median)
 importFrom(stats,na.omit)
 importFrom(stats,na.pass)
 importFrom(stats,qt)
+importFrom(stats,quantile)
 importFrom(stats,sd)
 importFrom(stats,start)
 importFrom(stats,ts)

NEWS.md

@@ -1,3 +1,17 @@
+#### SWMPr 2.3.0
+
+* Added informative error message if IP address not registered for using CDMO web services
+
+* Added `plot_quants` function to evaluate trends relative to long-term averages
+
+* All numeric columns are forced to numeric atomic vectors on input
+
+* Documentation updated to indicate a return value in the `calckl` function
+
+* Fixed bug with `comb` function if differ argument is incorrect
+
+* Added option in `qaqc` to included additional columns specifying censored values (via `cens_id` function)
+
 #### SWMPr 2.2.0
 
 * Added `plot_wind` function for wind roses from weather data

R/globalVariables.R

@@ -1 +1,4 @@
-globalVariables(c('val'))
+globalVariables(c('val', 'X0.', 'X100.', 'X25.', 'X75.', 'monthday', 'quantile'))
+
+#' @importFrom stats quantile
+NULL

R/swmpr_analyze.R

@@ -617,9 +617,9 @@ decomp.default <- function(dat_in, param, date_col, type = 'additive', frequency
 #' @param param chr string of variable to decompose
 #' @param date_col chr string indicating the name of the date column which should be a date or POSIX object.
 #' @param vals_out logical indicating of numeric output is returned, default is \code{FALSE} to return a plot.
-#' @param event logical indicating if an "events" component should be determined
-#' @param type chr string indicating the type of decomposition, either additive (\code{"add"}) or multiplicative (\code{"mult"})
-#' @param center chr string indicating the method of centering, either \code{"mean"} or \code{"median"}
+#' @param event logical indicating if an 'events' component should be determined
+#' @param type chr string indicating the type of decomposition, either additive (\code{'add'}) or multiplicative (\code{'mult'})
+#' @param center chr string indicating the method of centering, either \code{'mean'} or \code{'median'}
 #' @param ... additional arguments passed to or from other methods
 #' 
 #' @concept analyze
@@ -1886,7 +1886,7 @@ map_reserve <- function(nerr_site_id, zoom = 11, text_sz = 6, text_col = 'black'
 
   # plot
   p <- ggmap::ggmap(mapImageData,
-    extent = "panel"
+    extent = 'panel'
       ) + 
     geom_text(data = stats, aes_string(x = 'longitude', y = 'latitude', 
       label= 'station_code'), size = text_sz, colour = text_col
@@ -2000,4 +2000,142 @@ plot_wind.swmpr <- function(swmpr_in, years = NULL, angle = 45, width = 1.5, bre
     ...
     )
 
-}
+}
+
+#' Create a plot of data for a single year overlaid on historical data.
+#' 
+#' A line for a single year is plotted over ribbons ofquantiles for historical data.
+#' 
+#' @param swmpr_in input swmpr object.
+#' @param paramtoplot chr string of parameter to plot
+#' @param yr numeric of year to feature as a line on the plot
+#' @param yrstart numeric of year to begin range of comparison data
+#' @param yrend numeric of year to end range of comparison data
+#' @param yaxislab chr string for y-axis albel. Default is \code{paramtoplot}.
+#' @param maintitle chr string of plot title. Default pastes together site name, parameter name, year to feature, and range of years to use for comparison, e.g. 'GNDBHWQ 2017 Daily Average Temp overlaid on 2006-2016 daily averages'.
+#' @param yrcolor chr string of line color for year of interest
+#' @param bgcolor1 chr string of color for outer 50\% of data range
+#' @param bgcolor2 chr string of color for middle 50\% of data range.
+#' @param ... additional arguments passed to or from other methods
+#' 
+#' @details 
+#' The plot is based on aggregates of daily average values for the entire time series. Quantiles (min, 25\%, 75\%, max) for each individual calendar day (01/01, 01/02, ... 12/31) are used to generate a ribbon plot of historical data and the selected year in \code{yr} is plotted as a line over the ribbon for historical context.
+#' 
+#' required packages: dplyr, lubridate, ggplot2, tibble
+#' 
+#' @author Kim Cressman, Marcus Beck
+#' 
+#' @concept analyze
+#' 
+#' @export
+#'
+#' @return A a \code{\link[ggplot2]{ggplot2}} object.
+#'
+#' @import ggplot2
+#' 
+#' @examples 
+#' # qaqc
+#' dat <- qaqc(apacpwq)
+#' 
+#' # generate a plot of salinity for 2013 overlaid on 2012-2013 data
+#' plot_quants(dat, 'sal', yr = 2013, yrstart = 2012, yrend = 2013)
+#' 
+#' # change some of the defaults
+#' plot_quants(dat, 'sal', yr = 2013, yrstart = 2012, yrend = 2013, 
+#'  bgcolor1 = 'lightsteelblue2', bgcolor2 = 'lightsteelblue4', 
+#'  yaxislab = 'Salinity (psu)')
+plot_quants <- function(swmpr_in, ...) UseMethod('plot_quants')
+
+#' @rdname plot_quants
+#'
+#' @export
+#' 
+#' @method plot_quants swmpr
+plot_quants.swmpr <- function(swmpr_in, paramtoplot, yr, yrstart, yrend, yaxislab = NULL, yrcolor = 'red3',   bgcolor1 = 'lightgray', bgcolor2 = 'gray65', maintitle = NULL, ...){
+
+  # swmpr attributes
+  station  <- attr(swmpr_in, 'station')
+  timezone <- attr(swmpr_in, 'timezone')
+
+  # yaxislab is paramtoplot if not provided
+  if(is.null(yaxislab)) yaxislab <- paramtoplot
+
+  # plot title
+  if(is.null(maintitle))
+    maintitle <- paste0(station, ' ', yr, ' Daily Average ', 
+      paste0(toupper(substr(paramtoplot, 1, 1)), substr(paramtoplot, 2, nchar(paramtoplot))), '\noverlaid on ', 
+      yrstart, ' - ', yrend, ' daily averages')
+
+  # pull out daily averages; name it 'dat'
+  dat <- aggreswmp(swmpr_in, by = 'days', FUN = 'mean')
+
+  # make a column for just mm-dd, and another column for year
+  dat$month <- strftime(dat$datetimestamp, '%m')   
+  dat$day <- strftime(dat$datetimestamp, '%d')
+  dat$year <- strftime(dat$datetimestamp, '%Y')
+  dat$monthday <- as.character(paste0(dat$month, '-', dat$day))
+
+  # graphing ----
+
+  # split into feature year (for red) and backdrop years(to all be gray)
+  # this uses the filter() function of dplyr to subset on year
+  dat_feature <- dplyr::filter(dat, year == yr)
+  dat_backdrop <- dplyr::filter(dat, year >= yrstart & year <= yrend)
+
+  # work with quantiles ----
+
+  # do some subsetting and sorting on backdrop data (using dplyr)
+  # need to pull this out so a column can be named 'paramtoplot'
+  # which makes later coding easier
+  dat_quantiles <- dplyr::select_(dat_backdrop, paramtoplot = paramtoplot, 'monthday', 'year')
+
+  # by_doy <- group_by(dat_quantiles, monthday)
+
+  # subset featured data (using dplyr)
+  dat_feature <- dplyr::select_(dat_feature, paramtoplot = paramtoplot, 'monthday', 'year')
+
+  # generate a summary table (using dplyr and tibble) ----
+
+  # first gather quantiles for every monthday
+  # could probably make this quantile(x, n, na.rm = TRUE)
+  # where n is a vector that the user inputs at the beginning of the function to pull out whatever percentiles they want
+  doy_sum2 <- tapply(dat_quantiles$paramtoplot, dat_quantiles$monthday, 
+    function(x) quantile(x, c(0, 0.25, 0.75, 1), na.rm = TRUE))
+  # that spits out a list.
+  # pull the list together with do.call and rbind:
+  doy_sum3 <- do.call(rbind, doy_sum2)
+  # but that's a matrix, so make it a data frame:
+  doy_sum3 <- data.frame(doy_sum3)
+
+  # and turn the row names into the column 'monthday', using tibble::rownames_to_column(), and name it doy_sum
+  doy_sum <- data.frame(monthday = rownames(doy_sum3), doy_sum3, stringsAsFactors = FALSE)
+
+  # join the two data frames into one (using dplyr)
+  all_doy <- dplyr::full_join(dat_feature, doy_sum, by = 'monthday')
+
+  # get monthday back into date format by adding a year and then using lubridate's mdy function
+  # using 2008 as the arbitrary year so leap days go where they should
+  all_doy$monthday <- paste0(all_doy$monthday, '-2008')
+  all_doy$monthday <- as.Date(all_doy$monthday, format = '%m-%d-%Y')
+
+  # all_doy$monthday <- 
+  # make a year label for the legend
+  yrlabel <- as.character(yr)
+
+  # make a ribbon plot ----
+  p <- ggplot(all_doy) +
+    geom_ribbon(aes(x = monthday, ymin = X0., ymax = X100., fill = 'historical min-max')) +
+    geom_ribbon(aes(x = monthday, ymin = X25., ymax = X75., fill = 'historical 25-75 %iles')) +
+    geom_line(aes(x = monthday, y = paramtoplot, color = yrcolor), lwd = 1.3) +
+    theme_minimal() +
+    scale_x_date(date_labels = '%m/%d', date_breaks = '1 month', date_minor_breaks = '1 month') +
+    theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
+    labs(x = 'Day of Year', 
+         y = yaxislab, 
+         title = maintitle) +
+    scale_color_manual(name = '',  values = yrcolor, labels = yrlabel) +
+    scale_fill_manual(name = '', values = c('historical min-max' = bgcolor1, 'historical 25-75 %iles' = bgcolor2))
+
+  return(p)
+
+}

R/swmpr_misc.R

@@ -11,21 +11,25 @@
 #' @return Returns a swmpr object to be used with S3 methods
 #' 
 #' @details 
-#' This function is a simple wrapper to \code{\link[base]{structure}} that is used internally within other functions to create a swmpr object.  The function does not have to be used explicitly.  Attributes of a swmpr object include \code{names}, \code{row.names}, \code{class}, \code{station}, \code{parameters}, \code{qaqc_cols}, \code{date_rng}, \code{timezone}, \code{stamp_class}, \code{metabolism} (if present), and \code{metab_units} (if present). 
+#' This function is a simple wrapper to \code{\link[base]{structure}} that is used internally within other functions to create a swmpr object.  The function does not have to be used explicitly.  Attributes of a swmpr object include \code{names}, \code{row.names}, \code{class}, \code{station}, \code{parameters}, \code{qaqc_cols}, \code{cens_cols}, \code{date_rng}, \code{timezone}, \code{stamp_class}, \code{metabolism} (if present), and \code{metab_units} (if present). 
 #' 
 swmpr <- function(stat_in, meta_in){
-    
+
   if(!is.data.frame(stat_in)) 
     stop('stat_in must be data.frame')
 
   # qaqc attribute
   qaqc_cols <- FALSE
   if(any(grepl('^f_', names(stat_in)))) qaqc_cols <- TRUE
 
+  # cens attribute
+  cens_cols <- FALSE
+  if(any(grepl('^c_', names(stat_in)))) cens_cols <- TRUE
+
   # parameters attribute
-  parameters <- grep('datetimestamp|^f_', names(stat_in), invert = TRUE, value = TRUE)
+  parameters <- grep('datetimestamp|^f_|^c_', names(stat_in), invert = TRUE, value = TRUE)
 
-  # get stations, param_types attribtues
+  # get stations, param_types attributes
   param_types <- param_names()
   param_types <- unlist(lapply(param_types, function(x) any(x %in% parameters)))
   param_types <- names(param_names())[param_types]
@@ -54,6 +58,7 @@ swmpr <- function(stat_in, meta_in){
     station = station,
     parameters = parameters, 
     qaqc_cols = qaqc_cols,
+    cens_cols = cens_cols, 
     date_rng = range(stat_in$datetimestamp),
     timezone = timezone, 
     stamp_class = class(stat_in$datetimestamp),
@@ -97,6 +102,13 @@ parser <- function(resp_in, parent_in = 'data'){
   out <- do.call('rbind', out)
   out <- data.frame(out)
   names(out) <- tolower(names(out))
+
+  # error if ip address invalid
+  if(grepl('^Invalid ip', out[1,1])){
+    msg <- as.character(out[1,])
+    msg <- paste0(msg, ', is it registered? http://cdmo.baruch.sc.edu/web-services-request/')
+    stop(msg)
+  }
 
   # return output
   return(out)
@@ -441,6 +453,8 @@ metab_day.default <- function(dat_in, tz, lat, long, ...){
 #' 
 #' @export
 #' 
+#' @return Returns numeric value for oxygen mass transfer coefficient (m d-1).
+#' 
 #' @details
 #' This function is used within the \code{\link{ecometab}} function and should not be used explicitly.
 #' 
@@ -486,12 +500,14 @@ calckl <- function(temp, sal, atemp, wspd, bp, height = 10){
 #'
 #' Finds dissolved oxygen concentration in equilibrium with water-saturated air. Function and documentation herein are from archived wq package.
 #'
-#' @param t tem temperature, degrees C
-#' @param S salinity, on the Practical Salinity Scale
-#' @param P pressure, atm
+#' @param t numeric for temperature, degrees C
+#' @param S numeric for salinity, on the Practical Salinity Scale
+#' @param P numeric for pressure, atm
 #'
 #' @details Calculations are based on the approach of Benson and Krause (1984), using Green and Carritt's (1967) equation for dependence of water vapor partial pressure on \code{t} and \code{S}. Equations are valid for temperature in the range 0-40 C and salinity in the range 0-40.
 #'
+#' @export
+#' 
 #' @return Dissolved oxygen concentration in mg/L at 100\% saturation. If \code{P = NULL}, saturation values at 1 atm are calculated.
 #'
 #' @references