added buoy fxns back with ncdf as a Suggest fix #100

.travis.yml

@@ -2,6 +2,7 @@ language: r
 
 r_binary_packages:
   - rgdal
+  - ncdf
 
 r_github_packages:
   - jimhester/robustr

DESCRIPTION

@@ -7,9 +7,8 @@ Description: Client for many 'NOAA' data sources including the 'NCDC'
     have an interface for 'NOAA' sea ice data, the 'NOAA' severe weather inventory,
     'NOAA' Historical Observing Metadata Repository ('HOMR') data,
     'NOAA' storm data via 'IBTrACS', and tornado data via the 'NOAA' storm prediction
-    center. 'NOAA' buoy data is only on the buoy branch in the 'Github' repository
-    for this package (see url below).
-Version: 0.3.9.9700
+    center.
+Version: 0.3.9.9800
 License: MIT + file LICENSE
 Authors@R: c(
     person("Hart", "Edmund", role = "ctb", email = "Edmund.m.hart@gmail.com"),
@@ -38,4 +37,5 @@ Suggests:
     testthat,
     roxygen2,
     knitr,
-    taxize
+    taxize,
+    ncdf

Makefile

@@ -1,27 +1,23 @@
-all: move rmd2md cleanup
+all: move rmd2md
 
 move:
 		cp inst/vign/ncdc_vignette.md vignettes;\
 		cp inst/vign/ncdc_attributes.md vignettes;\
 		cp inst/vign/ncdc_workflow.md vignettes;\
-		cp inst/vign/erddap_vignette.md vignettes;\
 		cp inst/vign/swdi_vignette.md vignettes;\
 		cp inst/vign/seaice_vignette.md vignettes;\
 		cp inst/vign/homr_vignette.md vignettes;\
 		cp inst/vign/storms_vignette.md vignettes;\
+		cp inst/vign/buoy_vignette.md vignettes;\
 		cp -r inst/vign/figure/* vignettes/figure
 
 rmd2md:
 		cd vignettes;\
-		cp ncdc_vignette.md ncdc_vignette.Rmd;\
-		cp ncdc_attributes.md ncdc_attributes.Rmd;\
-		cp ncdc_workflow.md ncdc_workflow.Rmd;\
-		cp erddap_vignette.md erddap_vignette.Rmd;\
-		cp seaice_vignette.md seaice_vignette.Rmd;\
-		cp swdi_vignette.md swdi_vignette.Rmd;\
-		cp homr_vignette.md homr_vignette.Rmd;\
-		cp storms_vignette.md storms_vignette.Rmd
-
-cleanup:
-		cd vignettes;\
-		rm ncdc_vignette.md ncdc_attributes.md ncdc_workflow.md erddap_vignette.md swdi_vignette.md seaice_vignette.md homr_vignette.md storms_vignette.md
+		mv ncdc_vignette.md ncdc_vignette.Rmd;\
+		mv ncdc_attributes.md ncdc_attributes.Rmd;\
+		mv ncdc_workflow.md ncdc_workflow.Rmd;\
+		mv seaice_vignette.md seaice_vignette.Rmd;\
+		mv swdi_vignette.md swdi_vignette.Rmd;\
+		mv homr_vignette.md homr_vignette.Rmd;\
+		mv storms_vignette.md storms_vignette.Rmd;\
+		mv buoy_vignette.md buoy_vignette.Rmd

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2 (4.1.1): do not edit by hand
 
 S3method(ncdc_plot,ncdc_data)
+S3method(print,buoy)
 S3method(print,ghcnd)
 S3method(print,ghcnd_stations)
 S3method(print,isd)
@@ -16,6 +17,8 @@ S3method(type_summ,integer)
 S3method(type_summ,logical)
 S3method(type_summ,matrix)
 S3method(type_summ,numeric)
+export(buoy)
+export(buoys)
 export(erddap_clear_cache)
 export(erddap_data)
 export(erddap_datasets)
@@ -42,7 +45,6 @@ export(is.ncdc_locs_cats)
 export(is.ncdc_stations)
 export(isd)
 export(isd_stations)
-export(latlong2bbox)
 export(ncdc)
 export(ncdc_combine)
 export(ncdc_datacats)
@@ -79,6 +81,7 @@ export(theme_ice)
 export(tornadoes)
 export(type_summ)
 import(ggplot2)
+importFrom(XML,htmlParse)
 importFrom(XML,xmlParse)
 importFrom(XML,xmlToList)
 importFrom(XML,xmlValue)

R/buoy.R

@@ -0,0 +1,182 @@
+#' Get NOAA buoy data from the National Buoy Data Center
+#' 
+#' @importFrom XML htmlParse
+#' @export
+#'
+#' @param dataset (character) Dataset name to query. See below for Details. Required
+#' @param buoyid (integer) Buoy ID. Required
+#' @param datatype (character) Data type, one of 'c', 'cc', 'p', 'o'
+#' @param year (integer) Year of data collection
+#' @param ... Curl options passed on to \code{\link[httr]{GET}} (optional)
+#'
+#' @details Functions:
+#' \itemize{
+#'  \item buoys Get available buoys given a dataset name
+#'  \item buoy Get data given some combination of dataset name, buoy ID, year, and datatype
+#' }
+#' 
+#' Options for the dataset parameter. One of:
+#' \itemize{
+#'  \item adcp - Acoustic Doppler Current Profiler data
+#'  \item adcp2 - MMS Acoustic Doppler Current Profiler data
+#'  \item cwind - Continuous Winds data
+#'  \item dart - Deep-ocean Assessment and Reporting of Tsunamis data
+#'  \item mmbcur - Marsh-McBirney Current Measurements data
+#'  \item ocean - Oceanographic data
+#'  \item pwind - Peak Winds data
+#'  \item stdmet- Standard Meteorological data
+#'  \item swden - Spectral Wave Density data with Spectral Wave Direction data
+#'  \item wlevel - Water Level data
+#' }
+#' @references \url{http://www.ndbc.noaa.gov/} and \url{http://dods.ndbc.noaa.gov/}
+#' @examples \dontrun{
+#' # Get available buoys
+#' buoys(dataset = 'cwind')
+#' 
+#' # Get data for a buoy
+#' ## if no year or datatype specified, we get the first file
+#' buoy(dataset = 'cwind', buoyid = 46085)
+#' 
+#' # Including specific year
+#' buoy(dataset = 'cwind', buoyid = 41001, year = 1999)
+#' 
+#' # Including specific year and datatype
+#' buoy(dataset = 'cwind', buoyid = 41001, year = 2008, datatype = "cc")
+#' buoy(dataset = 'cwind', buoyid = 41001, year = 2008, datatype = "cc")
+#' 
+#' # Other datasets
+#' buoy(dataset = 'ocean', buoyid = 42856)
+#'
+#' # curl debugging
+#' library('httr')
+#' buoy(dataset = 'cwind', buoyid = 46085, config=verbose())
+#' }
+buoy <- function(dataset, buoyid, year=NULL, datatype=NULL, ...) {
+  availbuoys <- buoys(dataset, ...)
+  page <- availbuoys[grep(buoyid, availbuoys$id), "url"]
+  files <- buoy_files(page, buoyid, ...)
+  if (length(files) == 0) stop("No data files found, try a different search", call. = FALSE)
+  fileuse <- pick_year_type(files, year, datatype)
+  toget <- buoy_single_file_url(dataset, buoyid, fileuse)
+  output <- tempdir()
+  ncfile <- get_ncdf_file(toget, buoyid, files[[1]], output)
+  buoy_collect_data(ncfile)
+}
+
+pick_year_type <- function(x, y, z) {
+  if (is.null(y) && is.null(z)) {
+    message("Using ", x[[1]])
+    return(x[[1]])
+  } else if (is.null(z) && !is.null(y)) {
+    tt <- pickme(y, x)
+    message("Using ", tt)
+    return(tt)
+  } else if (is.null(y) && !is.null(z)) {
+    tt <- pickme(z, x)
+    message("Using ", tt)
+    return(tt)
+  } else {
+    pickme(paste0(z, y), x)
+  }
+}
+
+pickme <- function(findme, against) {
+  tmp <- grep(findme, against, value = TRUE)
+  if (length(tmp) > 1) tmp[1] else tmp
+}
+
+#' @export
+#' @rdname buoy
+buoys <- function(dataset, ...) {
+  url <- sprintf('http://dods.ndbc.noaa.gov/thredds/catalog/data/%s/catalog.html', dataset)
+  res <- GET(url, ...)
+  tt <- content(res, as = "text")
+  html <- htmlParse(tt)
+  folders <- xpathSApply(html, "//a//tt", xmlValue)
+  folders <- grep("/", folders, value = TRUE)
+  tmp <- paste0(sprintf('http://dods.ndbc.noaa.gov/thredds/catalog/data/%s/', dataset), folders, "catalog.html")
+  data.frame(id = gsub("/", "", folders), url = tmp, stringsAsFactors = FALSE)
+}
+
+# Get NOAA buoy data from the National Buoy Data Center
+buoy_files <- function(path, buoyid, ...){
+  singlebuoy_files <- GET(path, ...)
+  tt_sbf <- content(singlebuoy_files, as = "text")
+  html_sbf <- htmlParse(tt_sbf)
+  files_sbf <- grep(".nc$", xpathSApply(html_sbf, "//a//tt", xmlValue), value = TRUE)
+  gsub(buoyid, "", files_sbf)
+}
+
+# Make url for a single NOAA buoy data file
+buoy_single_file_url <- function(dataset, buoyid, file){
+  sprintf('http://dods.ndbc.noaa.gov/thredds/fileServer/data/%s/%s/%s%s',
+          dataset, buoyid, buoyid, file)
+}
+
+# Download a single ncdf file
+get_ncdf_file <- function(path, buoyid, file, output){
+  res <- GET(path)
+  outpath <- sprintf("%s/%s%s", output, buoyid, file)
+  writeBin(content(res), outpath)
+  return(outpath)
+}
+
+# Download a single ncdf file
+buoy_collect_data <- function(path){
+  nc <- ncdf::open.ncdf(path)
+
+  out <- list()
+  dims <- names(nc$dim)
+  for (i in seq_along(dims)) {
+    out[[dims[i]]] <- ncdf::get.var.ncdf(nc, nc$dim[[dims[i]]])
+  }
+  out$time <- sapply(out$time, convert_time)
+
+  vars <- names(nc$var)
+  outvars <- list()
+  for (i in seq_along(vars)) {
+    outvars[[ vars[i] ]] <- as.vector(ncdf::get.var.ncdf(nc, vars[i]))
+  }
+  df <- do.call("cbind.data.frame", outvars)
+
+  rows <- length(outvars[[1]])
+  out <- lapply(out, function(z) rep(z, each = rows/length(z)))
+
+  meta <- data.frame(out, stringsAsFactors = FALSE)
+  alldf <- cbind(meta, df)
+
+  nms <- c('name','prec','units','longname','missval','hasAddOffset','hasScaleFact')
+  meta <- lapply(vars, function(x) nc$var[[x]][names(nc$var[[x]]) %in% nms])
+  names(meta) <- vars
+
+  invisible(ncdf::close.ncdf(nc))
+  all <- list(meta = meta, data = alldf)
+  class(all) <- "buoy"
+  return( all )
+}
+
+#' @export
+print.buoy <- function(x, ..., n = 10) {
+  vars <- names(x$meta)
+  dims <- dim(x$data)
+  cat(sprintf('Dimensions (rows/cols): [%s X %s]', dims[1], dims[2]), "\n")
+  cat(sprintf('%s variables: [%s]', length(vars), paste0(vars, collapse = ", ")), "\n\n")
+  trunc_mat_(x$data, n = n)
+}
+
+convert_time <- function(n = NULL, isoTime = NULL) {
+#   if (!is.null(n)) stopifnot(is.numeric(n))
+#   if (!is.null(isoTime)) stopifnot(is.character(isoTime))
+#   check1notboth(n, isoTime)
+  format(as.POSIXct(noaa_compact(list(n, isoTime))[[1]], origin = "1970-01-01T00:00:00Z", tz = "UTC"),
+         format = "%Y-%m-%dT%H:%M:%SZ", tz = "UTC")
+}
+
+# check1notboth <- function(x, y) {
+#   if (is.null(x) && is.null(y)) {
+#     stop(sprintf("One of %s or %s must be non-NULL", deparse(substitute(x)), deparse(substitute(y))), call. = FALSE)
+#   }
+#   if (!is.null(x) && !is.null(y)) {
+#     stop(sprintf("Supply only one of %s or %s", deparse(substitute(x)), deparse(substitute(y))), call. = FALSE)
+#   }
+# }

inst/vign/buoy_vignette.Rmd

@@ -0,0 +1,72 @@
+<!--
+%\VignetteEngine{knitr::knitr}
+%\VignetteIndexEntry{buoy vignette}
+-->
+
+```{r echo=FALSE}
+knitr::opts_chunk$set(
+  fig.width = 10,
+  comment = "#>", 
+  warning = FALSE, 
+  message = FALSE
+)
+```
+
+buoy vignette
+======
+
+This vignette covers NOAA buoy data from the National Buoy Data Center. The
+main function to get data is `buoy`, while `buoys` can be used to
+get the buoy IDs and web pages for each buoy.
+
+```{r}
+library('rnoaa')
+```
+
+## Find out what buoys are available in a dataset
+
+```{r}
+res <- buoys(dataset = "cwind")
+```
+
+Inspect the buoy ids, and the urls for them
+
+```{r}
+head(res)
+```
+
+Or browse them on the web
+
+```{r eval=FALSE}
+browseURL(res[1, 2])
+```
+
+## Get buoy data
+
+With `buoy` you can get data for a particular dataset, buoy id, year, and datatype. 
+
+Get data for a buoy
+
+> if no year or datatype specified, we get the first file
+
+```{r cache=TRUE}
+buoy(dataset = 'cwind', buoyid = 46085)
+```
+
+Including year
+
+```{r cache=TRUE}
+buoy(dataset = 'cwind', buoyid = 41001, year = 1999)
+```
+
+Including year and datatype
+
+```{r cache=TRUE}
+buoy(dataset = 'cwind', buoyid = 41001, year = 2008, datatype = "cc")
+```
+
+Including just datatype
+
+```{r cache=TRUE}
+buoy(dataset = 'cwind', buoyid = 41001, datatype = "cc")
+```