Skip to content

Commit

Permalink
version 1.4.9
Browse files Browse the repository at this point in the history
  • Loading branch information
@cran-robot
Gillian Sharer authored and cran-robot committed Sep 19, 2018
1 parent fcba36c commit 6e9f434
Show file tree
Hide file tree
Showing 136 changed files with 678 additions and 554 deletions.
6 changes: 3 additions & 3 deletions DESCRIPTION
View file
@@ -1,6 +1,6 @@
Type: Package
Package: IRISSeismic
Version: 1.4.8
Version: 1.4.9
Title: Classes and Methods for Seismic Data Analysis
Authors@R: c(
person("Jonathan", "Callahan", email="jonathan@mazamascience.com", role=c("aut")),
Expand All @@ -24,11 +24,11 @@ Collate: Class-Trace.R Class-Stream.R Class-IrisClient.R
License: GPL (>= 2)
Repository: CRAN
NeedsCompilation: yes
Packaged: 2018-05-07 20:23:06 UTC; gillian
Packaged: 2018-09-19 00:16:03 UTC; gillian
Author: Jonathan Callahan [aut],
Rob Casey [aut],
Gillian Sharer [aut, cre],
Mary Templeton [aut],
Chad Trabant [ctb]
Maintainer: Gillian Sharer <gillian@iris.washington.edu>
Date/Publication: 2018-05-07 21:05:03 UTC
Date/Publication: 2018-09-19 05:50:22 UTC
269 changes: 134 additions & 135 deletions MD5
View file

Large diffs are not rendered by default.

118 changes: 87 additions & 31 deletions R/Class-IrisClient.R
View file
Expand Up @@ -55,7 +55,6 @@
#
################################################################################

#options(RCurlOptions = list(followlocation = TRUE, timeout=300, connecttimeout=60))

# check for a user R profile for the IRIS Client site URL
# otherwise, use the default URL
Expand Down Expand Up @@ -181,7 +180,7 @@ getDataselect.IrisClient <- function(obj, network, station, location, channel, s
if (! is.null(irisNetrc)) {
h <- RCurl::basicTextGatherer()
result <- try( dataselectResponse <- RCurl::getBinaryURL(url, useragent=obj@useragent,
netrc=1, netrc.file=irisNetrc, .opts = list(headerfunction = h$update,followlocation = TRUE, timeout=300, connecttimeout=60)),
netrc=1, netrc.file=irisNetrc, .opts = list(headerfunction = h$update,followlocation = TRUE, timeout=300, connecttimeout=300)),
silent=TRUE)

# Handle error response
Expand All @@ -190,38 +189,51 @@ getDataselect.IrisClient <- function(obj, network, station, location, channel, s
stop(paste("getDataselect.IrisClient:",err_msg, url))
}

header <- RCurl::parseHTTPHeader(h$value())
result <- try(header <- RCurl::parseHTTPHeader(h$value()))
if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getDataselect.IrisClient:",err_msg, url))
}

if (header["status"] == "401") { # authentication error, try again
Sys.sleep(1)
Sys.sleep(3)
h <- RCurl::basicTextGatherer()
result <- try( dataselectResponse <- RCurl::getBinaryURL(url, useragent=obj@useragent,
netrc=1, netrc.file=irisNetrc, .opts = list(headerfunction = h$update,followlocation = TRUE, timeout=300, connecttimeout=60)),
netrc=1, netrc.file=irisNetrc, .opts = list(headerfunction = h$update,followlocation = TRUE, timeout=300, connecttimeout=300)),
silent=TRUE)
# Handle error response
if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getDataselect.IrisClient:",err_msg, url))
}
header <- RCurl::parseHTTPHeader(h$value())

result <- try(header <- RCurl::parseHTTPHeader(h$value()))
if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getDataselect.IrisClient:",err_msg, url))
}
}
if (header["status"] == "500") { # internal server error, try again
Sys.sleep(3)
h <- RCurl::basicTextGatherer()
result <- try( dataselectResponse <- RCurl::getBinaryURL(url, useragent=obj@useragent,
netrc=1, netrc.file=irisNetrc, .opts = list(headerfunction = h$update,followlocation = TRUE, timeout=300, connecttimeout=60)),
netrc=1, netrc.file=irisNetrc, .opts = list(headerfunction = h$update,followlocation = TRUE, timeout=300, connecttimeout=300)),
silent=TRUE)
# Handle error response
if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getDataselect.IrisClient:",err_msg, url))
}
header <- RCurl::parseHTTPHeader(h$value())
result <- try(header <- RCurl::parseHTTPHeader(h$value()))
if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getDataselect.IrisClient:",err_msg, url))
}
}

} else {
h <- RCurl::basicTextGatherer()
result <- try( dataselectResponse <- RCurl::getBinaryURL(url, useragent=obj@useragent, .opts = list(headerfunction = h$update,followlocation = TRUE, timeout=300, connecttimeout=60)),
result <- try( dataselectResponse <- RCurl::getBinaryURL(url, useragent=obj@useragent, .opts = list(headerfunction = h$update,followlocation = TRUE, timeout=300, connecttimeout=300)),
silent=TRUE)

# Handle error response
Expand All @@ -230,20 +242,28 @@ getDataselect.IrisClient <- function(obj, network, station, location, channel, s
stop(paste("getDataselect.IrisClient:",err_msg,url))
}

header <- RCurl::parseHTTPHeader(h$value())
result <- try(header <- RCurl::parseHTTPHeader(h$value()))
if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getDataselect.IrisClient:",err_msg, url))
}

if (header["status"] == "500") { # internal server error, try again
Sys.sleep(3)
h <- RCurl::basicTextGatherer()
result <- try( dataselectResponse <- RCurl::getBinaryURL(url, useragent=obj@useragent,
netrc=1, netrc.file=irisNetrc, .opts = list(headerfunction = h$update,followlocation = TRUE, timeout=300, connecttimeout=60)),
netrc=1, netrc.file=irisNetrc, .opts = list(headerfunction = h$update,followlocation = TRUE, timeout=300, connecttimeout=300)),
silent=TRUE)
# Handle error response
if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getDataselect.IrisClient:",err_msg, url))
}
header <- RCurl::parseHTTPHeader(h$value())
result <- try(header <- RCurl::parseHTTPHeader(h$value()))
if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getDataselect.IrisClient:",err_msg, url))
}
}

}
Expand Down Expand Up @@ -476,14 +496,18 @@ getNetwork.IrisClient <- function(obj, network, station, location, channel,
# NOTE: Be sure to set na.strings="" as "NA" is a valid network name

h <- RCurl::basicTextGatherer()
result <- try(gurlc <- RCurl::getURL(url,useragent=obj@useragent,.opts = list(headerfunction = h$update,followlocation = TRUE, timeout=300, connecttimeout=60,timeout=300, connecttimeout=60)),silent=TRUE)
result <- try(gurlc <- RCurl::getURL(url,useragent=obj@useragent,.opts = list(headerfunction = h$update,followlocation = TRUE, timeout=300, connecttimeout=300)),silent=TRUE)

if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getNetwork.IrisClient:",err_msg,url))
}

header <- RCurl::parseHTTPHeader(h$value())
result <- try(header <- RCurl::parseHTTPHeader(h$value()))
if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getNetwork.IrisClient:",err_msg, url))
}


if (header["status"] != "200" && header["status"] != "204") {
Expand Down Expand Up @@ -617,12 +641,16 @@ getStation.IrisClient <- function(obj, network, station, location, channel,
# NOTE: Be sure to set na.strings="" as "NA" is a valid network name

h <- RCurl::basicTextGatherer()
result <- try(gurlc <- RCurl::getURL(url,useragent=obj@useragent,.opts = list(headerfunction = h$update,followlocation = TRUE, timeout=300, connecttimeout=60)),silent=TRUE)

result <- try(gurlc <- RCurl::getURL(url,useragent=obj@useragent,.opts = list(headerfunction = h$update,followlocation = TRUE, timeout=300, connecttimeout=300)),silent=TRUE)
if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getStation.IrisClient:",err_msg, url))
}

result <- try(header <- RCurl::parseHTTPHeader(h$value()))
if (class(result) == "try-error" ) {
stop(paste("getStation.IrisClient:",err_msg, url))
}
header <- RCurl::parseHTTPHeader(h$value())

if (header["status"] != "200" && header["status"] != "204" ) {
err_msg <- gurlc
Expand Down Expand Up @@ -760,14 +788,18 @@ getChannel.IrisClient <- function(obj, network, station, location, channel,
# NOTE: Be sure to set na.strings="" as "NA" is a valid network name

h <- RCurl::basicTextGatherer()
result <- try(gurlc <- RCurl::getURL(url,useragent=obj@useragent,.opts = list(headerfunction = h$update, followlocation = TRUE, timeout=300, connecttimeout=60)),silent=TRUE)
result <- try(gurlc <- RCurl::getURL(url,useragent=obj@useragent,.opts = list(headerfunction = h$update, followlocation = TRUE, timeout=300, connecttimeout=300)),silent=TRUE)

if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getChannel.IrisClient:",err_msg, url))
}

header <- RCurl::parseHTTPHeader(h$value())
result <- try(header <- RCurl::parseHTTPHeader(h$value()))
if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getChannel.IrisClient:",err_msg, url))
}

if (header["status"] != "200" && header["status"] != "204") {
err_msg <- gurlc
Expand Down Expand Up @@ -916,14 +948,18 @@ getAvailability.IrisClient <- function(obj, network, station, location, channel,
# NOTE: Be sure to set na.strings="" as "NA" is a valid network name

h <- RCurl::basicTextGatherer()
result <- try(gurlc <- RCurl::getURL(url,useragent=obj@useragent,.opts = list(headerfunction = h$update, followlocation = TRUE, timeout=300, connecttimeout=60)),silent=TRUE)
result <- try(gurlc <- RCurl::getURL(url,useragent=obj@useragent,.opts = list(headerfunction = h$update, followlocation = TRUE, timeout=300, connecttimeout=300)),silent=TRUE)

if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getAvailability.IrisClient:",err_msg, url))
}

header <- RCurl::parseHTTPHeader(h$value())
result <- try(header <- RCurl::parseHTTPHeader(h$value()))
if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getAvailability.IrisClient:",err_msg, url))
}

if (header["status"] != "200" && header["status"] != "204" ) {
err_msg <- gurlc
Expand Down Expand Up @@ -1120,14 +1156,18 @@ getEvalresp.IrisClient <- function(obj, network, station, location, channel, tim
# Conversion of URL into a data frame is a single line with utils::read.table().

h <- RCurl::basicTextGatherer()
result <- try(gurlc <- RCurl::getURL(url,useragent=obj@useragent,.opts = list(headerfunction = h$update, followlocation = TRUE, timeout=300, connecttimeout=60)),silent=TRUE)
result <- try(gurlc <- RCurl::getURL(url,useragent=obj@useragent,.opts = list(headerfunction = h$update, followlocation = TRUE, timeout=300, connecttimeout=300)),silent=TRUE)

if (class(result) == "try-error") {
err_msg <- geterrmessage()
stop(paste("getEvalresp.IrisClient:", strtrim(err_msg,500), url))
}

header <- RCurl::parseHTTPHeader(h$value())
result <- try(header <- RCurl::parseHTTPHeader(h$value()))
if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getEvalresp.IrisClient:",err_msg, url))
}

if (header["status"] != "200" && header["status"] != "204") {
err_msg <- gurlc
Expand Down Expand Up @@ -1240,23 +1280,31 @@ getEvent.IrisClient <- function(obj, starttime, endtime, minmag, maxmag, magtype
# Conversion of URL into a data frame is a single line with read.table().

h <- RCurl::basicTextGatherer()
result <- try(gurlc <- RCurl::getURL(url,useragent=obj@useragent,.opts = list(headerfunction = h$update, followlocation = TRUE, timeout=300, connecttimeout=60)),silent=TRUE)
result <- try(gurlc <- RCurl::getURL(url,useragent=obj@useragent,.opts = list(headerfunction = h$update, followlocation = TRUE, timeout=300, connecttimeout=300)),silent=TRUE)

if (class(result) == "try-error") {
err_msg <- geterrmessage()
stop(paste("getEvent.IrisClient:",err_msg, url))
}

header <- RCurl::parseHTTPHeader(h$value())
result <- try(header <- RCurl::parseHTTPHeader(h$value()))
if (class(result) == "try-error") {
err_msg <- geterrmessage()
stop(paste("getEvent.IrisClient:",err_msg, url))
}

if (header["status"] == "503" || header["status"] == "500") {
Sys.sleep(3)
h <- RCurl::basicTextGatherer()
result <- try(gurlc <- RCurl::getURL(url,useragent=obj@useragent,.opts = list(headerfunction = h$update, followlocation = TRUE, timeout=300, connecttimeout=60)),silent=TRUE)
result <- try(gurlc <- RCurl::getURL(url,useragent=obj@useragent,.opts = list(headerfunction = h$update, followlocation = TRUE, timeout=300, connecttimeout=300)),silent=TRUE)
if (class(result) == "try-error") {
stop(paste("getEvent.IrisClient:",err_msg, url))
}
result <- try(header <- RCurl::parseHTTPHeader(h$value()))
if (class(result) == "try-error") {
err_msg <- geterrmessage()
stop(paste("getEvent.IrisClient:",err_msg, url))
}
header <- RCurl::parseHTTPHeader(h$value())
}

if (header["status"] != "200" && header["status"] != "204") {
Expand Down Expand Up @@ -1371,14 +1419,18 @@ getTraveltime.IrisClient <- function(obj, latitude, longitude, depth, staLatitud
# Conversion of URL into a data frame is a single line with read.table().

h <- RCurl::basicTextGatherer()
result <- try(gurlc <- RCurl::getURL(url,useragent=obj@useragent,.opts = list(headerfunction = h$update, followlocation = TRUE, timeout=300, connecttimeout=60)),silent=TRUE)
result <- try(gurlc <- RCurl::getURL(url,useragent=obj@useragent,.opts = list(headerfunction = h$update, followlocation = TRUE, timeout=300, connecttimeout=300)),silent=TRUE)

if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getTraveltime.IrisClient:",err_msg, url))
}

header <- RCurl::parseHTTPHeader(h$value())
result <- try(header <- RCurl::parseHTTPHeader(h$value()))
if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getTraveltime.IrisClient:",err_msg, url))
}

if (header["status"] != "200" && header["status"] != "204") {
err_msg <- gurlc
Expand Down Expand Up @@ -1454,7 +1506,7 @@ getDistaz.IrisClient <- function(obj, latitude, longitude, staLatitude, staLongi
# Get data from distaz web service

h <- RCurl::basicTextGatherer()
result <- try( distazXml <- RCurl::getURL(url, useragent=obj@useragent,.opts = list(headerfunction = h$update, followlocation = TRUE, timeout=300, connecttimeout=60)),
result <- try( distazXml <- RCurl::getURL(url, useragent=obj@useragent,.opts = list(headerfunction = h$update, followlocation = TRUE, timeout=300, connecttimeout=300)),
silent=TRUE)

# Handle error response
Expand All @@ -1463,7 +1515,11 @@ getDistaz.IrisClient <- function(obj, latitude, longitude, staLatitude, staLongi
stop(paste("getDistaz.IrisClient:", err_msg))
}

header <- RCurl::parseHTTPHeader(h$value())
result <- try(header <- RCurl::parseHTTPHeader(h$value()))
if (class(result) == "try-error" ) {
err_msg <- geterrmessage()
stop(paste("getDistaz.IrisClient:", err_msg))
}

if (header["status"] != "200" && header["status"] != "204") {
err_msg <- distazXml
Expand Down
4 changes: 2 additions & 2 deletions R/Class-Stream.R
View file
Expand Up @@ -863,9 +863,9 @@ plot.Stream <- function(x, ...) {

plot(tr, ...)
if (length(x@traces) == 1) {
graphics::mtext(paste(length(x@traces),"trace"), side=3, line=0.5, adj=0.05)
graphics::mtext(paste(length(x@traces),"trace"), side=3, line=0.2, adj=0.95)
} else {
graphics::mtext(paste(length(x@traces),"traces"), side=3, line=0.5, adj=0.05)
graphics::mtext(paste(length(x@traces),"traces"), side=3, line=0.2, adj=0.95)
}

}
Expand Down
17 changes: 4 additions & 13 deletions R/Class-Trace.R
View file
Expand Up @@ -940,7 +940,7 @@ plot.Trace <- function(x, starttime=x@stats@starttime, endtime=x@stats@endtime,

# remove ".M" or other quality factor designation as people don't expect it
id <- stringr::str_sub(x@id, 1, stringr::str_length(x@id)-2)
main <- paste("Seismic Trace for ",id)
main <- paste("Seismic Trace for ",id,sep="")
sensorText <- paste("(", x@Sensor, ")")
# Create array of times
times <- seq(from=x@stats@starttime, to=x@stats@endtime, length.out=length(x@data))
Expand All @@ -953,23 +953,14 @@ plot.Trace <- function(x, starttime=x@stats@starttime, endtime=x@stats@endtime,

# Plot
if (difftime(x@stats@endtime,x@stats@starttime,units="days") > "1 day" & difftime(x@stats@endtime,x@stats@starttime,units="days") < "7 days") {
plot(x@data[indices] ~ times[indices], type='l', main="", xaxt="n",
xlim=c(starttime, endtime),
xlab=xlab, ylab=ylab, ...)
plot(x@data[indices] ~ times[indices], type='l',main=main, xaxt="n", xlim=c(starttime, endtime), xlab=xlab,ylab=ylab,...)
graphics::axis.POSIXct(1, at=seq(from=x@stats@starttime, to=x@stats@endtime, by="day"), format="%b %d")

} else {
plot(x@data[indices] ~ times[indices], type='l', main="",
xlim=c(starttime, endtime),
xlab=xlab, ylab=ylab, ...)
plot(x@data[indices] ~ times[indices], type='l', xlim=c(starttime, endtime),main=main,xlab=xlab,ylab=ylab,...)
}
# x-axis
# graphics::axis(1, at=c(1,length(indices)), labels=c("",""))
# graphics::mtext(starttime, side=1, line=0.7, at=1, adj=0)
# graphics::mtext(endtime, side=1, line=0.7, at=length(indices), adj=1)
# title
graphics::title(main)
graphics::mtext(sensorText, line=0.2)
graphics::mtext(sensorText, line=0.2, adj=0.05)

}

Expand Down
14 changes: 7 additions & 7 deletions inst/doc/IRISSeismic-intro.html
View file

Large diffs are not rendered by default.

7 changes: 7 additions & 0 deletions man/IRISSeismic-package.Rd
View file
Expand Up @@ -28,6 +28,13 @@ IRIS DMC web services: \url{http://service.iris.edu/}

\section{History}{

version 1.4.9
\itemize{
\item{ additional error handling }
\item{ minor updates to the plot.Trace and plot.Stream functions }
\item{ updated src/libmseed to version 2.19.6 }
}

version 1.4.8
\itemize{
\item{ updated src/libmseed to version 2.19.5 }
Expand Down

0 comments on commit 6e9f434

Please sign in to comment.