Skip to content

Commit

Permalink
Merge pull request #370 from ldecicco-USGS/master
Browse files Browse the repository at this point in the history
Convert old latex'y vignette to markdown
  • Loading branch information
ldecicco-USGS authored May 19, 2017
2 parents 8af138e + e0ec469 commit ec022ea
Show file tree
Hide file tree
Showing 18 changed files with 2,639 additions and 2,001 deletions.
2 changes: 1 addition & 1 deletion .Rbuildignore
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
.Rhistory
vignettes/figure
vignettes/figures
appveyor.yml
.travis.yml
.gitignore
Expand Down
4 changes: 2 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -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
4 changes: 4 additions & 0 deletions NEWS
Original file line number Diff line number Diff line change
@@ -1,3 +1,7 @@
dataRetrieval 2.7.1
==========
* Converted vignette to html

dataRetrieval 2.7.0
==========
* Added National Groundwater Monitoring Network services
Expand Down
8 changes: 6 additions & 2 deletions R/whatNWISData.r
Original file line number Diff line number Diff line change
Expand Up @@ -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)){
Expand Down
251 changes: 176 additions & 75 deletions inst/doc/dataRetrieval.R
Original file line number Diff line number Diff line change
@@ -1,24 +1,22 @@
## ----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)
Expand All @@ -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-----------------------
Expand All @@ -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:
Expand Down Expand Up @@ -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")

Expand Down Expand Up @@ -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------------------------
Expand All @@ -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",
Expand All @@ -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------------------------------------
#
Expand Down Expand Up @@ -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)
Expand Down
Loading

0 comments on commit ec022ea

Please sign in to comment.