added additional function for getting shp files for storm data, #57

R/storm_shp.R

@@ -0,0 +1,84 @@
+#' @export
+#' @rdname storms
+#' @examples \donttest{
+#' res <- storm_shp(basin='EP')
+#' storm_shp_read(res)
+#' 
+#' (res2 <- storm_shp(storm='1970143N19091'))
+#' 
+#' # Plot results
+#' library('sp')
+#' 
+#' (res3 <- storm_shp(year=1940))
+#' res3shp <- storm_shp_read(res3)
+#' plot(res3shp)
+#' 
+#' (res3_lines <- storm_shp(year=1940, type="lines"))
+#' res3_linesshp <- storm_shp_read(res3_lines)
+#' plot(res3_linesshp)
+#' 
+#' (res4 <- storm_shp(year=2010))
+#' res4shp <- storm_shp_read(res4)
+#' plot(res4shp)
+#' }
+
+storm_shp <- function(basin=NULL, storm=NULL, year=NULL, type="points", path="~/.rnoaa/storms",
+  overwrite = TRUE)
+{
+  shppath <- shp_local(basin, storm, year, path, type)
+  if(!is_shpstorm(x = shppath)){
+    shppath <- shpstorm_GET(path, basin, storm, year, type, overwrite)
+  }
+  structure(list(path=spth(shppath)), class="storm_shp", 
+            basin=basin, storm=storm, year=year, type=type)
+}
+
+#' @export
+#' @rdname storms
+storm_shp_read <- function(x){
+  readshp2(x$path, filepath2(attr(x, 'basin'), attr(x, 'storm'), attr(x, 'year'), attr(x, 'type')))
+}
+
+an <- function(x, y){ tmp <- attr(x, y); if(is.null(tmp)) '<NA>' else tmp }
+
+spth <- function(x)  grep("\\.shp", x, value = TRUE)
+
+#' @export
+print.storm_shp <- function(x, ...){
+  cat("<NOAA Storm Shp Files>", sep = "\n")
+  cat(sprintf("Path: %s", x$path), sep = "\n")
+  cat(sprintf("Basin: %s", an(x, "basin")), sep = "\n")
+  cat(sprintf("Storm: %s", an(x, "storm")), sep = "\n")
+  cat(sprintf("Year: %s", an(x, "year")), sep = "\n")
+  cat(sprintf("Type: %s", an(x, "type")), sep = "\n")
+}
+
+shpstorm_GET <- function(bp, basin, storm, year, type, overwrite){
+  dir.create(local_base(basin, storm, year, bp), showWarnings = FALSE, recursive = TRUE)
+  fp <- shp_local(basin, storm, year, bp, type)
+  paths <- Map(function(x, y) suppressWarnings(GET(x, write_disk(y, overwrite))), shp_remote(basin, storm, year, type), fp)  
+  vapply(paths, function(z) z$request$writer[[1]], "", USE.NAMES = FALSE)
+}
+
+shpfileext <- function(basin, storm, year, type){
+  tt <- filepath(basin, storm, year)
+  if(grepl("Allstorms", tt)) 
+    paste0(tt, '.ibtracs_all_', type, '.v03r06.', c('dbf','prj','shp','shx'), '.gz')
+  else 
+    paste0(tt, '.ibtracs_all_', type, '.v03r06.', c('dbf','prj','shp','shx'))
+}
+
+filepath2 <- function(basin, storm, year, type){
+  tmp <- filecheck(basin, storm, year)
+  switch(names(tmp),
+         all = 'Allstorms',
+         basin = paste0('Basin.', tmp[[1]], '.ibtracs_all_', type, '.v03r06'),
+         storm = paste0('Storm.', tmp[[1]], '.ibtracs_all_', type, '.v03r06'),
+         year = paste0('Year.', tmp[[1]], '.ibtracs_all_', type, '.v03r06')
+  )
+}
+
+shp_remote <- function(basin, storm, year, type) file.path(stormurl("shp"), shpfileext(basin, storm, year, type))
+shp_local <- function(basin, storm, year, path, type) file.path(path, shpfileext(basin, storm, year, type))
+is_shpstorm <- function(x) if(all(file.exists(x))) TRUE else FALSE
+readshp2 <- function(x, layer) readOGR(dsn = path.expand(x), layer = layer, stringsAsFactors = FALSE)

man/storms.Rd

@@ -0,0 +1,94 @@
+% Generated by roxygen2 (4.0.2): do not edit by hand
+\name{storm_shp}
+\alias{storm_data}
+\alias{storm_meta}
+\alias{storm_shp}
+\alias{storm_shp_read}
+\title{Get NOAA wind storm data from International Best Track Archive for Climate Stewardship (IBTrACS)}
+\usage{
+storm_shp(basin = NULL, storm = NULL, year = NULL, type = "points",
+  path = "~/.rnoaa/storms", overwrite = TRUE)
+
+storm_shp_read(x)
+
+storm_meta(what = "storm_columns")
+
+storm_data(basin = NULL, storm = NULL, year = NULL,
+  path = "~/.rnoaa/storms", overwrite = TRUE)
+}
+\arguments{
+\item{basin}{(character) A basin name, one of EP, NA, NI, SA, SI, SP, or WP.}
+
+\item{storm}{(character) A storm serial number of the form YYYYJJJHTTNNN. See Details.}
+
+\item{year}{(numeric) One of the years from 1842 to 2014}
+
+\item{path}{(character) A path to store the files, Default: \code{~/.rnoaa/storms}}
+
+\item{overwrite}{(logical) To overwrite the path to store files in or not, Default: TRUE.}
+
+\item{what}{(character) One of storm_columns or storm_names.}
+}
+\description{
+Get NOAA wind storm data from International Best Track Archive for Climate Stewardship (IBTrACS)
+}
+\details{
+Details for storm serial numbers:
+\itemize{
+ \item YYYY is the corresponding year of the first recorded observation of the storm
+ \item JJJ is the day of year of the first recorded observation of the storm
+ \item H is the hemisphere of the storm: N=Northern, S=Southern
+ \item TT is the absolute value of the rounded latitude of the first recorded observation of the
+ storm (range 0-90, if basin=SA or SH, then TT in reality is negative)
+ \item NNN is the rounded longitude of the first recorded observation of the storm (range 0-359)
+}
+
+For example: \code{1970143N19091} is a storm in the North Atlantic which started on
+May 23, 1970 near 19°N 91°E
+
+See \url{http://www.ncdc.noaa.gov/ibtracs/index.php?name=numbering} for more.
+}
+\examples{
+\donttest{
+res <- storm_shp(basin='EP')
+storm_shp_read(res)
+
+(res2 <- storm_shp(storm='1970143N19091'))
+
+# Plot results
+library('sp')
+
+(res3 <- storm_shp(year=1940))
+res3shp <- storm_shp_read(res3)
+plot(res3shp)
+
+(res3_lines <- storm_shp(year=1940, type="lines"))
+res3_linesshp <- storm_shp_read(res3_lines)
+plot(res3_linesshp)
+
+(res4 <- storm_shp(year=2010))
+res4shp <- storm_shp_read(res4)
+plot(res4shp)
+}
+\donttest{
+# Metadata
+head( storm_meta() )
+head( storm_meta("storm_columns") )
+head( storm_meta("storm_names") )
+
+# Tabular data
+storm_data(basin='WP')
+storm_data(storm='1970143N19091')
+storm_data(year=1940)
+storm_data(year=1941)
+storm_data(year=2010)
+
+# Or get all data, simply don't specify a value for basin, storm, or year
+res <- storm_data(read=FALSE) # just get path
+head()
+}
+}
+\references{
+\url{http://www.ncdc.noaa.gov/ibtracs/index.php?name=wmo-data}
+}
+