Commit ec022eae authored by Laura A DeCicco's avatar Laura A DeCicco Committed by GitHub
Browse files

Merge pull request #370 from ldecicco-USGS/master

Convert old latex'y vignette to markdown
parents 8af138e6 e0ec4699
.Rhistory
vignettes/figure
vignettes/figures
appveyor.yml
.travis.yml
.gitignore
......
......@@ -39,11 +39,11 @@ Imports:
readr (>= 1.0.0),
jsonlite
Suggests:
xtable,
htmlTable,
knitr,
testthat
VignetteBuilder: knitr
BuildVignettes: true
VignetteBuilder: knitr
BugReports: https://github.com/USGS-R/dataRetrieval/issues
URL: https://pubs.usgs.gov/tm/04/a10/
RoxygenNote: 6.0.1
dataRetrieval 2.7.1
==========
* Converted vignette to html
dataRetrieval 2.7.0
==========
* Added National Groundwater Monitoring Network services
......
......@@ -69,8 +69,12 @@ whatNWISdata <- function(siteNumbers,service="all",parameterCd="all",statCd="all
siteNumber <- paste(siteNumbers,collapse=",")
if(!("all" %in% service)){
service <- match.arg(service, c("dv","uv","qw","ad","id","pk","sv","gw","aw","all","ad","iv","rt"), several.ok = TRUE)
}
service <- match.arg(service, c("dv","uv","qw","ad","id","pk","sv","gw","aw","all","ad","iv"), several.ok = TRUE)
if(service == "uv"){
service <- "iv"
}
}
if(!("all" %in% parameterCd)){
if(anyNA(parameterCd)){
......
## ----openLibrary, echo=FALSE------------------------------
library(xtable)
options(continue=" ")
options(width=60)
## ----setup, include=FALSE, message=FALSE------------------
library(knitr)
library(dataRetrieval)
## ----include=TRUE ,echo=FALSE,eval=TRUE-------------------
opts_chunk$set(highlight=TRUE, tidy=TRUE, keep.space=TRUE, keep.blank.space=FALSE, keep.comment=TRUE, tidy=FALSE,comment="")
options(continue=" ")
options(width=60)
knitr::opts_chunk$set(echo = TRUE,
warning = FALSE,
message = FALSE,
fig.height = 7,
fig.width = 7)
opts_chunk$set(highlight=TRUE,
tidy=TRUE,
keep.space=TRUE,
keep.blank.space=FALSE,
keep.comment=TRUE)
knit_hooks$set(inline = function(x) {
if (is.numeric(x)) round(x, 3)})
knit_hooks$set(crop = hook_pdfcrop)
bold.colHeaders <- function(x) {
x <- gsub("\\^(\\d)","$\\^\\1$",x)
x <- gsub("\\%","\\\\%",x)
x <- gsub("\\_"," ",x)
returnX <- paste("\\multicolumn{1}{c}{\\textbf{\\textsf{", x, "}}}", sep = "")
}
addSpace <- function(x) ifelse(x != "1", "[5pt]","")
library(dataRetrieval)
## ----workflow, echo=TRUE,eval=FALSE-----------------------
# library(dataRetrieval)
......@@ -39,38 +37,98 @@ library(dataRetrieval)
# pCode <- readNWISpCode(parameterCd)
#
## ----tableParameterCodes, echo=FALSE,results='asis'-------
## ----echo=FALSE-------------------------------------------
library(htmlTable)
Functions <- c("readNWISdata","",
"readNWISdv","","","","",
"readNWISqw","","","","",
"readNWISuv","","","",
"readNWISrating","",
"readNWISmeas","","",
"readNWISpeak","","",
"readNWISgwl","","",
"readNWISuse","","","",
"readNWISstat","","","","","",
"readNWISpCode",
"readNWISsite",
"whatNWISsites",
"whatNWISdata","",
"readWQPdata",
"readWQPqw","","","",
"whatWQPsites")
Arguments <- c("...","service", #readNWISdata
"siteNumber","parameterCd","startDate","endDate","statCd", #readNWISdv
"siteNumber","parameterCd","startDate","endDate","expanded", #readNWISqw
"siteNumber","parameterCd","startDate","endDate", #readNWISuv
"siteNumber","type", #readNWISrating
"siteNumber","startDate","endDate", #readNWISmeas
"siteNumber","startDate","endDate", #readNWISpeak
"siteNumber","startDate","endDate", #readNWISgwl
"stateCd","countyCd","years","categories", #readNWISuse
"siteNumbers","parameterCd","startDate","endDate","statReportType","statType", #readNWISstat
"parameterCd", #readNWISpCode
"siteNumber", #readNWISsite
"...", #whatNWISsites
"siteNumber","service", #whatNWISdata
"...", #readWQPdata
"siteNumber","parameterCd","startDate","endDate", #readWQPqw
"...") #whatWQPsites
Description <- c("NWIS data using user-specified queries","", #readNWISdata
"NWIS daily data","","","","", #readNWISdv
"NWIS water quality data","","","","", #readNWISqw
"NWIS instantaneous value data","","","", #readNWISuv
"NWIS rating table for active streamgage","", #readNWISrating
"NWIS surface-water measurements","","", #readNWISmeas
"NWIS peak flow data","","", #readNWISpeak
"NWIS groundwater level measurements","","", #readNWISgwl
"NWIS water use","","","", #readNWISuse
"NWIS statistical service","","","","","", #readNWISstat
"NWIS parameter code information", #readNWISpCode
"NWIS site information", #readNWISsite
"NWIS site search using user-specified queries",
"NWIS data availability, including period of record and count","",
"WQP data using user-specified queries",
"WQP data","","","",
"WQP site search using user-specified queries")
data.df <- data.frame(`Function Name` = Functions, Arguments, Description, stringsAsFactors=FALSE)
htmlTable(data.df,
caption="Table 1: dataRetrieval functions",
rnames=FALSE, align=c("l","l","l","l"),
col.rgroup = c("none", "#F7F7F7"),
css.cell="padding-bottom: 0.0em; padding-right: 0.5em; padding-top: 0.0em;")
## ----tableParameterCodes, echo=FALSE----------------------
pCode <- c('00060', '00065', '00010','00045','00400')
shortName <- c("Discharge [ft$^3$/s]","Gage height [ft]","Temperature [C]", "Precipitation [in]", "pH")
shortName <- c("Discharge [ft<sup>3</sup>/s]","Gage height [ft]","Temperature [C]", "Precipitation [in]", "pH")
data.df <- data.frame(pCode, shortName, stringsAsFactors=FALSE)
print(xtable(data.df,
label="tab:params",
caption="Common USGS Parameter Codes"),
caption.placement="top",
size = "\\footnotesize",
latex.environment=NULL,
sanitize.text.function = function(x) {x},
sanitize.colnames.function = bold.colHeaders,
sanitize.rownames.function = addSpace
)
htmlTable(data.df,
caption="Table 2: Common USGS Parameter Codes",
rnames=FALSE, align=c("c","c"), col.rgroup = c("none", "#F7F7F7"),
css.cell="padding-bottom: 0.0em; padding-right: 0.5em; padding-top: 0.0em;")
## ----tableStatCodes, echo=FALSE,results='asis'------------
## ----tableStatCodes, echo=FALSE---------------------------
StatCode <- c('00001', '00002', '00003','00008')
shortName <- c("Maximum","Minimum","Mean", "Median")
data.df <- data.frame(StatCode, shortName, stringsAsFactors=FALSE)
print(xtable(data.df,label="tab:stat",
caption="Commonly used USGS Stat Codes"),
caption.placement="top",
size = "\\footnotesize",
latex.environment=NULL,
sanitize.colnames.function = bold.colHeaders,
sanitize.rownames.function = addSpace
)
htmlTable(data.df,
caption="Table 3: Commonly used USGS Stat Codes",
rnames=FALSE, align=c("c","c"), col.rgroup = c("none", "#F7F7F7"),
css.cell="padding-bottom: 0.0em; padding-right: 0.5em; padding-top: 0.0em;")
## ----getSite, echo=TRUE, eval=FALSE-----------------------
......@@ -89,33 +147,28 @@ print(xtable(data.df,label="tab:stat",
#
#
## ----tablegda, echo=FALSE,eval=FALSE----------------------
# tableData <- with(dailyDataAvailable,
# data.frame(
# siteNumber= site_no,
# srsname=srsname,
# startDate=as.character(begin_date),
# endDate=as.character(end_date),
# count=as.character(count_nu),
# units=parameter_units,
# # statCd = stat_cd,
# stringsAsFactors=FALSE)
# )
#
# tableData$units[which(tableData$units == "ft3/s")] <- "ft$^3$/s"
# tableData$units[which(tableData$units == "uS/cm @25C")] <- "$\\mu$S/cm @25C"
#
#
# print(xtable(tableData,label="tab:gda",
# caption="Reformatted version of output from \\texttt{whatNWISdata} function for the Choptank River near Greensboro, MD, and from Seneca Creek at Dawsonville, MD from the daily values service [Some columns deleted for space considerations]"),
# caption.placement="top",
# size = "\\footnotesize",
# latex.environment=NULL,
# sanitize.text.function = function(x) {x},
# sanitize.colnames.function = bold.colHeaders,
# sanitize.rownames.function = addSpace
# )
#
## ----echo=FALSE-------------------------------------------
tableData <- data.frame(
siteNumber = c("01491000","01491000","01645000","01491000","01491000","01491000"),
srsname = c("Temperature, water","Stream flow, mean daily",
"Stream flow, mean daily",
"Specific conductance",
"Suspended sediment concentration (SSC)",
"Suspended sediment discharge" ),
startDate = c("2010-10-01","1948-01-01","1930-09-26","2010-10-01","1980-10-01","1980-10-01"),
endDate = c("2012-05-09","2017-05-17","2017-05-17","2012-05-09","1991-09-30","1991-09-30"),
count = c("529","25340","31646","527","4017","4017"),
units = c("deg C","ft<sup>3</sup>/s","ft<sup>3</sup>/s","uS/cm @25C","mg/l","tons/day"),
stringsAsFactors = FALSE)
htmlTable(tableData,
caption="Table 4: Reformatted version of output from the whatNWISdata function for the Choptank River near Greensboro, MD, and from Seneca Creek at Dawsonville, MD from the daily values service [Some columns deleted for space considerations]",
rnames=FALSE,
col.rgroup = c("none", "#F7F7F7"),
css.cell="padding-bottom: 0.0em; padding-right: 0.5em; padding-top: 0.0em;")
## ----label=getPCodeInfo, echo=TRUE, eval=FALSE------------
# # Using defaults:
......@@ -167,7 +220,7 @@ variableInfo <- attr(temperatureAndFlow, "variableInfo")
siteInfo <- attr(temperatureAndFlow, "siteInfo")
## ----getNWIStemperaturePlot, echo=TRUE, fig.cap="Temperature and discharge plot of Choptank River in 2012.",out.width='1\\linewidth',out.height='1\\linewidth',fig.show='hold'----
## ---------------------------------------------------------
variableInfo <- attr(temperatureAndFlow, "variableInfo")
siteInfo <- attr(temperatureAndFlow, "siteInfo")
......@@ -205,8 +258,8 @@ legend("topleft", variableInfo$param_units,
# startDate, endDate)
#
# # Or the wide return:
# # dfWide <- readNWISqw(siteNumber, parameterCd,
# # startDate, endDate, reshape=TRUE)
# dfWide <- readNWISqw(siteNumber, parameterCd,
# startDate, endDate, reshape=TRUE)
#
## ----qwmeta, echo=TRUE, eval=FALSE------------------------
......@@ -232,15 +285,57 @@ legend("topleft", variableInfo$param_units,
# surfaceData <- readNWISmeas(siteNumber)
#
## ----eval=FALSE-------------------------------------------
# allegheny <- readNWISuse(stateCd = "Pennsylvania",
# countyCd = "Allegheny")
#
#
# national <- readNWISuse(stateCd = NULL,
# countyCd = NULL,
# transform = TRUE)
#
## ----eval=FALSE-------------------------------------------
# discharge_stats <- readNWISstat(siteNumbers=c("02319394"),
# parameterCd=c("00060"),
# statReportType="annual")
#
## ----label=getQWData, echo=TRUE, eval=FALSE---------------
# specificCond <- readWQPqw('WIDNR_WQX-10032762',
# 'Specific conductance','2011-05-01','2011-09-30')
# 'Specific conductance',
# '2011-05-01','2011-09-30')
## ----siteSearch, eval=FALSE-------------------------------
# sites <- whatNWISsites(bBox=c(-83.0,36.5,-81.0,38.5),
# parameterCd=c("00010","00060"),
# hasDataTypeCd="dv")
## ----echo=FALSE-------------------------------------------
Service <- c("dv","iv","gwlevels","qwdata","measurements","peak","stat")
Description <- c("Daily","Instantaneous","Groundwater Levels","Water Quality","Surface Water Measurements","Peak Flow","Statistics Service")
URL <- c("<a href='https://waterservices.usgs.gov/rest/DV-Test-Tool.html' target='_blank'>https://waterservices.usgs.gov/rest/DV-Test-Tool.html<a>",
"<a href='https://waterservices.usgs.gov/rest/IV-Test-Tool.html' target='_blank'>https://waterservices.usgs.gov/rest/IV-Test-Tool.html<a>",
"<a href='https://waterservices.usgs.gov/rest/GW-Levels-Test-Tool.html' target='_blank'>https://waterservices.usgs.gov/rest/GW-Levels-Test-Tool.html<a>",
"<a href='https://nwis.waterdata.usgs.gov/nwis/qwdata' target='_blank'>https://nwis.waterdata.usgs.gov/nwis/qwdata<a>",
"<a href='https://waterdata.usgs.gov/nwis/measurements/' target='_blank'>https://waterdata.usgs.gov/nwis/measurements/<a>",
"<a href='https://nwis.waterdata.usgs.gov/usa/nwis/peak/' target='_blank'>https://nwis.waterdata.usgs.gov/usa/nwis/peak/<a>",
"<a href='https://waterservices.usgs.gov/rest/Statistics-Service-Test-Tool.html' target='_blank'>https://waterservices.usgs.gov/rest/Statistics-Service-Test-Tool.html<a>")
tableData <- data.frame(Service,
Description,
URL,
stringsAsFactors = FALSE)
htmlTable(tableData,
caption="Table 5: NWIS general data calls",
rnames=FALSE, align=c("l","l","l"),
col.rgroup = c("none", "#F7F7F7"),
css.cell="padding-bottom: 0.0em; padding-right: 0.5em; padding-top: 0.0em;")
## ----dataExample, eval=FALSE------------------------------
# dischargeWI <- readNWISdata(service="dv",
# stateCd="WI",
......@@ -258,10 +353,19 @@ legend("topleft", variableInfo$param_units,
#
## ----phData, eval=FALSE-----------------------------------
#
# dataPH <- readWQPdata(statecode="US:55",
# characteristicName="pH")
#
## ----eval=FALSE-------------------------------------------
# type <- "Stream"
# sites <- whatWQPdata(countycode="US:55:025",siteType=type)
## ----eval=FALSE-------------------------------------------
# site <- whatWQPsamples(siteid="USGS-01594440")
## ----eval=FALSE-------------------------------------------
# type <- "Stream"
# sites <- whatWQPmetrics(countycode="US:55:025",siteType=type)
## ----meta1, eval=FALSE------------------------------------
#
......@@ -289,10 +393,7 @@ legend("topleft", variableInfo$param_units,
# comment(peakData)
#
# #Which is equivalent to:
# # attr(peakData, "comment")
## ----helpFunc,eval = FALSE--------------------------------
# ?readNWISpCode
# attr(peakData, "comment")
## ----seeVignette,eval = FALSE-----------------------------
# vignette(dataRetrieval)
......
This diff is collapsed.
This diff is collapsed.
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -312,6 +312,7 @@ test_that("NGWMN functions working", {
context("getWebServiceData")
test_that("long urls use POST", {
testthat::skip_on_cran()
url <- paste0(rep("reallylongurl", 200), collapse = '')
with_mock(
RETRY = function(method, ...) {
......@@ -324,7 +325,9 @@ test_that("long urls use POST", {
.env = "httr"
)
})
test_that("ngwmn urls don't use post", {
testthat::skip_on_cran()
url <- paste0(rep("urlwithngwmn", 200), collapse = '')
with_mock(
RETRY = function(method, ...) {
......
......@@ -202,6 +202,8 @@ test_that("readNWISuse tests", {
context("state tests")
test_that("state county tests",{
testthat::skip_on_cran()
fullName <- stateCdLookup("wi", "fullName")
expect_equal(fullName, "Wisconsin")
......@@ -235,6 +237,7 @@ df_test <- data.frame(site_no = as.character(1:13),
result_va = 1:13, stringsAsFactors = FALSE)
test_that("addWaterYear works with Date, POSIXct, character, but breaks with numeric", {
testthat::skip_on_cran()
library(dplyr)
df_date <- df_test
......@@ -254,7 +257,7 @@ test_that("addWaterYear works with Date, POSIXct, character, but breaks with num
})
test_that("addWaterYear works for each column name", {
testthat::skip_on_cran()
nwisqw_style <- df_test
nwisqw_style_wy <- addWaterYear(nwisqw_style)
expect_equal(ncol(nwisqw_style_wy), ncol(nwisqw_style) + 1)
......@@ -277,6 +280,7 @@ test_that("addWaterYear works for each column name", {
})
test_that("addWaterYear correctly calculates the WY and is numeric", {
testthat::skip_on_cran()
df_test_wy <- addWaterYear(df_test)
expect_is(df_test_wy[['waterYear']], "numeric")
expect_true(all(df_test_wy[['waterYear']][1:9] == 2010))
......@@ -284,18 +288,21 @@ test_that("addWaterYear correctly calculates the WY and is numeric", {
})
test_that("addWaterYear adds column next to dateTime", {
testthat::skip_on_cran()
df_test_wy <- addWaterYear(df_test)
dateTime_col <- which(names(df_test_wy) == "dateTime")
expect_equal(names(df_test_wy)[dateTime_col + 1], "waterYear")
})
test_that("addWaterYear can be used with pipes", {
testthat::skip_on_cran()
library(dplyr)
df_test_wy <- df_test %>% addWaterYear()
expect_equal(ncol(df_test_wy), ncol(df_test) + 1)
})
test_that("addWaterYear doesn't add another WY column if it exists", {
testthat::skip_on_cran()
df_test_wy <- addWaterYear(df_test)
expect_equal(ncol(df_test_wy), ncol(df_test) + 1)
df_test_wy2 <- addWaterYear(df_test_wy)
......@@ -303,6 +310,7 @@ test_that("addWaterYear doesn't add another WY column if it exists", {
})
test_that("calcWaterYear can handle missing values", {
testthat::skip_on_cran()
dateVec <- seq(as.Date("2010-01-01"),as.Date("2011-01-31"), by="months")
dateVec[c(3,7,12)] <- NA
wyVec <- dataRetrieval:::calcWaterYear(dateVec)
......@@ -314,6 +322,7 @@ test_that("calcWaterYear can handle missing values", {
context("Construct NWIS urls")
test_that("Construct NWIS urls", {
testthat::skip_on_cran()
siteNumber <- '01594440'
startDate <- '1985-01-01'
......@@ -368,7 +377,17 @@ test_that("Construct NWIS urls", {
context("Construct WQP urls")
test_that("Construct WQP urls", {
testthat::skip_on_cran()
site_id <- '01594440'
startDate <- '1985-01-01'
endDate <- ''
pCode <- c("00060","00010")
url_wqp <- constructWQPURL(paste("USGS",site_id,sep="-"),
c('01075','00029','00453'),
startDate,endDate)
expect_equal(url_wqp, "https://www.waterqualitydata.us/Result/search?siteid=USGS-01594440&pCode=01075;00029;00453&startDateLo=01-01-1985&sorted=no&mimeType=tsv")
})
context("checkWQPdates")
......
This diff is collapsed.
This diff is collapsed.
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment