Skip to content

Commit

Permalink
Version 0.3.0
Browse files Browse the repository at this point in the history
Added plotting functions, tracks in (x, y, z, t ) space,  cleaned up code
  • Loading branch information
rmendels committed Aug 31, 2017
1 parent 2215e25 commit 62bfbfa
Show file tree
Hide file tree
Showing 15 changed files with 464 additions and 258 deletions.
12 changes: 3 additions & 9 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: rerddapXtracto
Type: Package
Title: Extracts Environmental Data from ERD's ERDDAP Web Service
Version: 0.2.0
Version: 0.3.0
Authors@R: person("Roy", "Mendelssohn", email = "[email protected]", role = c("aut","cre"))
Description: The xtractomatic package contains three functions that access
environmental data from ERD's ERDDAP service. The rxtracto function extracts
Expand All @@ -15,25 +15,19 @@ Description: The xtractomatic package contains three functions that access
to be extracted.
URL: https://github.com/rmendels/rerddapXtracto
BugReports: https://github.com/rmendels/rerddapXtracto/issues
Depends:
R (>= 3.3.0)
License: CC0
LazyData: TRUE
Imports:
abind,
methods,
ncdf4,
parsedate,
plotdap,
rerddap,
sp,
stats
Suggests:
akima,
dplyr,
ggfortify,
ggplot2,
knitr,
lubridate,
mapdata,
xts
RoxygenNote: 5.0.1
RoxygenNote: 6.0.1
33 changes: 26 additions & 7 deletions R/checkBounds.R
Original file line number Diff line number Diff line change
Expand Up @@ -20,14 +20,33 @@ checkBounds <- function(dataCoordList, dimargs) {
dimLen <- length(names(dataCoordList))
for (i in (1:dimLen)) {
cIndex <- which(names(dataCoordList)[i] == names(dimargs))
if ((min(dimargs[[cIndex]]) < min(dataCoordList[[i]])) | (max(dimargs[[cIndex]]) > max(dataCoordList[[i]]))) {
print('dimension coordinate out of bounds')
print(paste0('dimension name: ', names(dimargs)[cIndex]))
print(paste('given coordinate bounds', dimargs[cIndex]))
returnCode <- 1
print(paste('ERDDAP datasets bounds', min(dataCoordList[i]), max(dataCoordList[i])))
if (names(dimargs)[cIndex] == 'time') {
min_dimargs <- min(as.numeric(dimargs[[cIndex]]))
max_dimargs <- max(as.numeric(dimargs[[cIndex]]))
temp_time <- parsedate::parse_iso_8601(dataCoordList[[i]])
min_coord <- min( as.numeric(temp_time))
max_coord <- max( as.numeric(temp_time))
} else {
min_dimargs <- min(dimargs[[cIndex]])
max_dimargs <- max(dimargs[[cIndex]])
min_coord <- min(dimargs[[cIndex]])
max_coord <- max(dimargs[[cIndex]])
}
if ((min_dimargs < min_coord) | (max_dimargs > max_coord)) {
if (names(dimargs)[cIndex] == 'time') {
print('dimension coordinate out of bounds')
print(paste0('dimension name: ', names(dimargs)[cIndex]))
print(paste('given coordinate bounds', min_dimargs, max_dimargs))
returnCode <- 1
print(paste('ERDDAP datasets bounds', as.Date(min_coord), as.Date( max_coord)))
} else {
print('dimension coordinate out of bounds')
print(paste0('dimension name: ', names(dimargs)[cIndex]))
print(paste('given coordinate bounds', min_dimargs, max_dimargs))
returnCode <- 1
print(paste('ERDDAP datasets bounds', min_coord, max_coord))
}
}

}


Expand Down
4 changes: 2 additions & 2 deletions R/checkInput.R
Original file line number Diff line number Diff line change
Expand Up @@ -49,8 +49,8 @@ checkInput <- function(dataInfo, parameter, urlbase, callDims) {
}
# check that the base url ends in /
lenURL <- nchar(urlbase)
if (substr(urlbase, lenURL, lenURL) == '/') {
urlbase <- substr(urlbase, 1, (lenURL - 1))
if (substr(urlbase, lenURL, lenURL) != '/') {
urlbase <- paste0(urlbase, '/')
}

# check that urlbase connects to an ERDDAP
Expand Down
2 changes: 1 addition & 1 deletion R/getFIleCoords.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@ getfileCoords <- function(datasetID, dataCoords, urlbase) {
# to start do brute force way with for loop
coordList <- list()
for (i in 1:length(dataCoords)) {
myURL <- paste0(urlbase, '/griddap/', datasetID, '.csv?', dataCoords[i], '[0:1:last]')
myURL <- paste0(urlbase, 'griddap/', datasetID, '.csv?', dataCoords[i], '[0:1:last]')
coordVals <- utils::read.csv(myURL, skip = 2, header = FALSE, stringsAsFactors = FALSE)
coordVals <- coordVals[, 1]
coordList[[i]] <- coordVals
Expand Down
84 changes: 84 additions & 0 deletions R/plotBox.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,84 @@
#' plot result of xtracto_3D or rxtracto_3D
#'
#' \code{plotBox} is a function to plot the results from
#' rxtracto() and xtracto()
#'
#' @export
#' @param resp data frame returned from rxtracto() or xtracto()
#' @param plotColor the color to use in plot from rerddap
#' @param time a function to map multi-time to one, or else identity for animation
#' @param animate if multiple times, if TRUE will animate the maps
#' @param myFunc function of one argument to transform the data
#' @param maxpixels maximum numbe rof pixels to use in making the map - controls resolution
#' @return a plotdap plot
#'
#' @examples
#' tagData <- Marlintag38606
#' xpos <- tagData$lon
#' ypos <- tagData$lat
#' tpos <- tagData$date
#' zpos <- rep(0., length(xpos))
#' urlbase <- 'http://upwell.pfeg.noaa.gov/erddap'
#' swchlInfo <- rerddap::info('erdSWchla8day')
#' swchl <- rxtracto(swchlInfo, parameter = 'chlorophyll', xcoord = xpos, ycoord = ypos, tcoord = tpos, zcoord = zpos, xlen = .2, ylen = .2)
#' plotBox(xpos, ypos, swchl, plotColor = 'chlorophyll')

plotBox <- function(resp, plotColor = 'viridis', time = NA, animate = FALSE, name = NA, myFunc = NA, maxpixels = 10000){
require(rerddap)
require(plotdap)
if (!is.function(time)) {
time <- function(x) mean(x, na.rm = TRUE)
}
if (is.function(myFunc)) {
resp[[1]] <- myFunc(resp[[1]])
}
if (!is.na(name)) {
names(resp)[1] <- name
}
paramName = names(resp)[1]
myStruct <- meltnc(resp)
myStruct <- structure(
myStruct,
class = c("griddap_nc", "nc", "data.frame")
)
p <- plotdap::plotdap()
parameter1 <- as.formula(paste('~', paramName))
myList <- list(p, myStruct, parameter1, plotColor, time, animate, maxpixels )
names(myList) <- c('plot', 'grid', 'var', 'fill', 'time', 'animate', 'maxpixels')
myplot <- do.call(plotdap::add_griddap, myList)
myplot
}

meltnc <- function(resp ){
## modified from rerddap::ncdf4_get
rows = length(resp[[1]])
if (is.null(resp$time)) {
exout <- do.call("expand.grid", list(longitude = resp$longtiude, latitude = resp$latitude))
meta <- dplyr::arrange_(exout, names(exout)[1])
} else {
time <- as.character(resp$time)
time <- suppressWarnings(rep(time, each = rows/length(resp$time)))
lat <- rep(rep(resp$latitude, each = length(resp$longitude)),
length(resp$time))
lon <- rep(rep(resp$longitude, times = length(resp$latitude)),
times = length(resp$time))
meta <- data.frame(time, lat, lon, stringsAsFactors = FALSE)
}

# make data.frame
df <- as.vector(resp[[1]])
df <- data.frame(df)
names(df) <- names(resp)[1]
alldf <- if (NROW(meta) > 0) cbind(meta, df) else df

# Fool plotdap that there is a summary
summary_time = list(vals = as.numeric(resp$time))
summary_lons <- list(vals = resp$longitude)
summary_lats <- list(vals = resp$latitude)
dims <- list(time = summary_time, longitude = summary_lons, latitude = summary_lats)
summary <- list(dims)
names(summary) <- 'dim'
# output
list(summary = summary, data = alldf)
}

53 changes: 53 additions & 0 deletions R/plotTrack.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,53 @@
#' plot result of xtracto or rxtracto
#'
#' \code{plotTrack} is a function to plot the results from
#' rxtracto() and xtracto()
#' @export
#' @param xcoord passed to rxtracto() or xtracto()
#' @param ycoord passed to rxtracto() or xtracto()
#' @param resp data frame returned from rxtracto() or xtracto()
#' @param plotColor the color to use in plot from rerddap
#' @param myFunc function of one argument to transform the data
#' @return a plotdap plot
#'
#' @examples
#' tagData <- Marlintag38606
#' xpos <- tagData$lon
#' ypos <- tagData$lat
#' tpos <- tagData$date
#' zpos <- rep(0., length(xpos))
#' urlbase <- 'http://upwell.pfeg.noaa.gov/erddap'
#' swchlInfo <- rerddap::info('erdSWchla8day')
#' swchl <- rxtracto(swchlInfo, parameter = 'chlorophyll', xcoord = xpos, ycoord = ypos, tcoord = tpos, zcoord = zpos, xlen = .2, ylen = .2)
#' plotTrack(xpos, ypos, swchl, plotColor = 'chlorophyll')

plotTrack <- function(xcoord, ycoord, resp, plotColor = 'viridis', name = NA, myFunc = NA, shape = 20, size = .5){
require(rerddap)
require(plotdap)
ind <- which(xcoord > 180)
xcoord[ind] <- xcoord[ind] - 360
if (is.function(myFunc)) {
resp[[1]] <- myFunc(resp[[1]])
}
myDataFrame = data.frame(xcoord, ycoord, resp[[1]])
nameLen <- nchar(names(resp))
if (is.na(name)) {
paramName <- substr(names(resp)[1], 6, nameLen)
}else{
paramName = name
}
names(myDataFrame) <- c('longitude', 'latitude', paramName)
myStruct <- structure(
myDataFrame,
class = c("tabledap", "data.frame")
)
p <- plotdap::plotdap()
paramName1 <- as.formula(paste('~', paramName))
myList <- list(p, myStruct, paramName1, plotColor, shape, size)
names(myList) <- c('plot', 'table', 'var', 'color', 'shape', 'size')
#plotCmd <- paste0('add_tabledap(plotdap(), myStruct, ~', paramName,
# ', color = ', deparse(plotColor), ', shape =20, size= .5)')
#myPlot <- eval(parse(text = plotCmd))
myPlot <- do.call(plotdap::add_tabledap, myList)
myPlot
}
12 changes: 6 additions & 6 deletions R/rxtracto.R
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,7 @@
#' \item column 11 = median absolute deviation of data within search radius
#' }
#' @examples
#' urlbase <- 'http://upwell.pfeg.noaa.gov/erddap'
#' urlbase <- 'https://upwell.pfeg.noaa.gov/erddap'
#' dataInfo <- rerddap::info('erdMBsstd8day')
#' parameter <- 'sst'
#' xcoord <- c(230, 231)
Expand Down Expand Up @@ -72,7 +72,7 @@



rxtracto <- function(dataInfo, parameter = NULL, xcoord=NULL, ycoord = NULL, zcoord = NULL, tcoord = NULL, xlen = 0., ylen = 0., zlen = 0., xName = 'longitude', yName = 'latitude', zName = 'altitude', tName = 'time', urlbase = 'http://upwell.pfeg.noaa.gov/erddap', verbose = FALSE) {
rxtracto <- function(dataInfo, parameter = NULL, xcoord=NULL, ycoord = NULL, zcoord = NULL, tcoord = NULL, xlen = 0., ylen = 0., zlen = 0., xName = 'longitude', yName = 'latitude', zName = 'altitude', tName = 'time', urlbase = 'https://upwell.pfeg.noaa.gov/erddap', verbose = FALSE) {

# Check Passed Info -------------------------------------------------------
rerddap::cache_setup(temp_dir = TRUE)
Expand Down Expand Up @@ -127,8 +127,8 @@ rxtracto <- function(dataInfo, parameter = NULL, xcoord=NULL, ycoord = NULL, zco
tcoordLim <- NULL
if (!is.null(working_coords$tcoord1)) {
isoTime <- dataCoordList$time
udtTime <- parsedate::parse_date(isoTime)
tcoord1 <- parsedate::parse_date(working_coords$tcoord1)
udtTime <- parsedate::parse_iso_8601(isoTime)
tcoord1 <- parsedate::parse_iso_8601(working_coords$tcoord1)
tcoordLim <- c(min(tcoord1), max(tcoord1))
}

Expand Down Expand Up @@ -199,12 +199,12 @@ latSouth <- working_coords$latSouth
# the call will be the same as last time, so no need to repeat
out_dataframe[i,] <- oldDataFrame
} else {
griddapCmd <- makeCmd(urlbase, xName, yName, zName, tName, parameter,
griddapCmd <- makeCmd(dataInfo, urlbase, xName, yName, zName, tName, parameter,
erddapCoords$erddapXcoord, erddapCoords$erddapYcoord,
erddapCoords$erddapTcoord, erddapCoords$erddapZcoord,
verbose )

extract <- eval(parse(text = griddapCmd))
extract <- do.call(rerddap::griddap, griddapCmd )

if (length(extract) == 0) {
print(griddapCmd)
Expand Down
12 changes: 6 additions & 6 deletions R/rxtracto_3D.R
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@
#' \item extract$time - the times of the extracts
#' }
#' @examples
#' urlbase <- 'http://upwell.pfeg.noaa.gov/erddap'
#' urlbase <- 'https://upwell.pfeg.noaa.gov/erddap'
#' dataInfo <- rerddap::info('erdMBsstd8day')
#' parameter <- 'sst'
#' xcoord <- c(230, 235)
Expand Down Expand Up @@ -74,7 +74,7 @@
#' yName = yName, zName = zName)
#'

rxtracto_3D <- function(dataInfo, parameter = NULL, xcoord = NULL, ycoord = NULL, zcoord = NULL, tcoord = NULL, xName = 'longitude', yName = 'latitude', zName = 'altitude', tName = 'time', urlbase = 'https://upwell.pfeg.noaa.gov/erddap', verbose=FALSE) {
rxtracto_3D <- function(dataInfo, parameter = NULL, xcoord = NULL, ycoord = NULL, zcoord = NULL, tcoord = NULL, xName = 'longitude', yName = 'latitude', zName = 'altitude', tName = 'time', urlbase = 'https://upwell.pfeg.noaa.gov/erddap/', verbose=FALSE) {


# Check Passed Info -------------------------------------------------------
Expand Down Expand Up @@ -120,8 +120,8 @@ if (!is.null(working_coords$tcoord1)) {
isoTime <- dataCoordList$time
udtTime <- parsedate::parse_date(isoTime)
tcoord1 <- removeLast(isoTime, working_coords$tcoord1)
tcoord1 <- parsedate::parse_date(tcoord1)
tcoordLim <- c(min(tcoord1), max(tcoord1))
tcoord1 <- parsedate::parse_iso_8601(tcoord1)
tcoordLim <- tcoord1
}

dimargs <- list(xcoordLim, ycoordLim, zcoordLim, tcoordLim)
Expand All @@ -145,7 +145,7 @@ erddapCoords <- erddapList$erddapCoords



griddapCmd <- makeCmd(urlbase, xName, yName, zName, tName, parameter,
griddapCmd <- makeCmd(dataInfo, urlbase, xName, yName, zName, tName, parameter,
erddapCoords$erddapXcoord, erddapCoords$erddapYcoord,
erddapCoords$erddapTcoord, erddapCoords$erddapZcoord,
verbose )
Expand All @@ -154,7 +154,7 @@ griddapCmd <- makeCmd(urlbase, xName, yName, zName, tName, parameter,
# Get the data ------------------------------------------------------------


griddapExtract <- eval(parse(text = griddapCmd))
griddapExtract <- do.call(rerddap::griddap, griddapCmd )



Expand Down
2 changes: 1 addition & 1 deletion R/rxtractogon.R
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,7 @@



rxtractogon <- function(dataInfo, parameter, xcoord = NULL, ycoord = NULL, zcoord = NULL, tcoord = NULL, xName = 'longitude', yName = 'latitude', zName = 'altitude', tName = 'time', urlbase = 'http://upwell.pfeg.noaa.gov/erddap', verbose = FALSE) {
rxtractogon <- function(dataInfo, parameter, xcoord = NULL, ycoord = NULL, zcoord = NULL, tcoord = NULL, xName = 'longitude', yName = 'latitude', zName = 'altitude', tName = 'time', urlbase = 'https://upwell.pfeg.noaa.gov/erddap', verbose = FALSE) {

rerddap::cache_setup(temp_dir = TRUE)

Expand Down
Loading

0 comments on commit 62bfbfa

Please sign in to comment.