readNWISdata.r 13.4 KB
Newer Older
1
2
3
#' General Data Import from NWIS
#'
#' Returns data from the NWIS web service.
Laura A DeCicco's avatar
Laura A DeCicco committed
4
#' Arguments to the function should be based on \url{https://waterservices.usgs.gov} service calls.
5
#' See examples below for ideas of constructing queries.
6
#'
7
#' @param service character. Possible values are "iv" (for instantaneous), "dv" (for daily values), "gwlevels" 
David Watkins's avatar
David Watkins committed
8
9
#' (for groundwater levels), "site" (for site service), "qw" (water-quality),"measurement", and "stat" (for 
#' statistics service). Note: "qw" and "measurement" calls go to: 
Laura A DeCicco's avatar
Laura A DeCicco committed
10
11
#' \url{https://nwis.waterdata.usgs.gov/usa/nwis} for data requests, and use different call requests schemes.
#' The statistics service has a limited selection of arguments (see \url{https://waterservices.usgs.gov/rest/Statistics-Service-Test-Tool.html}). 
Laura A DeCicco's avatar
Laura A DeCicco committed
12
13
14
#' @param asDateTime logical, if \code{TRUE} returns date and time as POSIXct, if \code{FALSE}, Date
#' @param convertType logical, defaults to \code{TRUE}. If \code{TRUE}, the function will convert the data to dates, datetimes,
#' numerics based on a standard algorithm. If false, everything is returned as a character
Laura A DeCicco's avatar
Laura A DeCicco committed
15
#' @param \dots see \url{https://waterservices.usgs.gov/rest/Site-Service.html#Service} for a complete list of options
16
17
#' @import utils
#' @import stats
Laura A DeCicco's avatar
Laura A DeCicco committed
18
19
20
21
22
#' @return A data frame with the following columns:
#' \tabular{lll}{
#' Name \tab Type \tab Description \cr
#' agency \tab character \tab The NWIS code for the agency reporting the data\cr
#' site \tab character \tab The USGS site number \cr
23
24
25
26
27
28
#' dateTime \tab POSIXct \tab The date and time (if applicable) of the measurement, 
#'           converted to UTC for unit value data. R only allows one time zone attribute per column. For unit data 
#'           spanning a time zone change, converting the data to UTC solves this problem. For daily data,
#'           the time zone attribute is the time zone of the first returned measurement.
#'            \cr
#' tz_cd \tab character \tab The time zone code for dateTime column\cr
Laura A DeCicco's avatar
Laura A DeCicco committed
29
30
31
32
33
34
35
36
37
38
#' code \tab character \tab Any codes that qualify the corresponding value\cr
#' value \tab numeric \tab The numeric value for the parameter \cr
#' }
#' Note that code and value are repeated for the parameters requested. The names are of the form 
#' X_D_P_S, where X is literal, 
#' D is an option description of the parameter, 
#' P is the parameter code, 
#' and S is the statistic code (if applicable).
#' 
#' There are also several useful attributes attached to the data frame:
Laura A DeCicco's avatar
Laura A DeCicco committed
39
#' \tabular{lll}{
Laura A DeCicco's avatar
Laura A DeCicco committed
40
41
42
43
44
45
46
47
48
#' Name \tab Type \tab Description \cr
#' url \tab character \tab The url used to generate the data \cr
#' siteInfo \tab data.frame \tab A data frame containing information on the requested sites \cr
#' variableInfo \tab data.frame \tab A data frame containing information on the requested parameters \cr
#' statisticInfo \tab data.frame \tab A data frame containing information on the requested statistics on the data \cr
#' queryTime \tab POSIXct \tab The time the data was returned \cr
#' }
#' 
#' @seealso \code{\link{renameNWISColumns}},  \code{\link{importWaterML1}}, \code{\link{importRDB1}}
49
50
#' @export
#' @examples
51
52
#' \dontrun{
#' # Examples not run for time considerations
Laura A DeCicco's avatar
Laura A DeCicco committed
53
#' dataTemp <- readNWISdata(stateCd="OH",parameterCd="00010", service="dv")
54
55
56
#' instFlow <- readNWISdata(sites="05114000", service="iv", 
#'                    parameterCd="00060", 
#'                    startDate="2014-05-01T00:00Z",endDate="2014-05-01T12:00Z")
57
#'                                                    
58
59
60
61
62
#' instFlowCDT <- readNWISdata(sites="05114000", service="iv", 
#'                    parameterCd="00060", 
#'                    startDate="2014-05-01T00:00",endDate="2014-05-01T12:00",
#'                    tz="America/Chicago")
#'
63
#' #Empty:
64
65
#' multiSite <- readNWISdata(sites=c("04025000","04072150"), service="iv", 
#'                            parameterCd="00010")
66
#' #Not empty:
67
68
#' multiSite <- readNWISdata(sites=c("04025500","040263491"), 
#'                            service="iv", parameterCd="00060")
Laura A DeCicco's avatar
Laura A DeCicco committed
69
#' bBoxEx <- readNWISdata(bBox=c(-83,36.5,-81,38.5), parameterCd="00010")
70
#' 
Laura A DeCicco's avatar
Laura A DeCicco committed
71
72
73
74
#' startDate <- as.Date("2013-10-01")
#' endDate <- as.Date("2014-09-30")
#' waterYear <- readNWISdata(bBox=c(-83,36.5,-81,38.5), parameterCd="00010", 
#'                   service="dv", startDate=startDate, endDate=endDate)
75
76
#' siteInfo <- readNWISdata(stateCd="WI", parameterCd="00010",
#'                   hasDataTypeCd="iv", service="site")
77
78
79
80
#' qwData <- readNWISdata(bBox=c(-82.5,41.52,-81,41),startDate=as.Date("2000-01-01"),
#'                   drain_area_va_min=50, qw_count_nu=50,qw_attributes="expanded",
#'                   qw_sample_wide="wide",list_of_search_criteria=c("lat_long_bounding_box",
#'                   "drain_area_va","obs_count_nu"),service="qw")
Laura A DeCicco's avatar
Laura A DeCicco committed
81
82
#' temp <- readNWISdata(bBox=c(-83,36.5,-81,38.5), parameterCd="00010", service="site", 
#'                    seriesCatalogOutput=TRUE)
Laura A DeCicco's avatar
Laura A DeCicco committed
83
#' wiGWL <- readNWISdata(stateCd="WI",service="gwlevels")
84
#' meas <- readNWISdata(state_cd="WI",service="measurements",format="rdb_expanded")
David Watkins's avatar
David Watkins committed
85
86
87
#' 
#' waterYearStat <- readNWISdata(site=c("03112500"),service="stat",statReportType="annual",
#'                  statYearType="water", missingData="on")
88
89
90
91
92
93
94
95
96
97
98
#' monthlyStat <- readNWISdata(site=c("03112500","03111520"),
#'                             service="stat",
#'                             statReportType="monthly")                                   
#' dailyStat <- readNWISdata(site=c("03112500","03111520"),
#'                           service="stat",
#'                           statReportType="daily",
#'                           statType=c("p25","p50","p75","min","max"),
#'                           parameterCd="00065")
#' allDailyStats <- readNWISdata(site=c("03111548"),
#'                               service="stat",
#'                               statReportType="daily")
Laura A DeCicco's avatar
Laura A DeCicco committed
99
100
101
#'                               service="stat",statReportType="daily",
#'                               statType=c("p25","p50","p75","min","max"),
#'                               parameterCd="00065")
Laura A DeCicco's avatar
Laura A DeCicco committed
102
103
#'
#'dailyWV <- readNWISdata(stateCd = "West Virginia", parameterCd = "00060")
104
#' }
Laura A DeCicco's avatar
Laura A DeCicco committed
105
readNWISdata <- function(service="dv", ..., asDateTime=TRUE,convertType=TRUE){
106
  
107
  matchReturn <- list(...)
108
  
109
  match.arg(service, c("dv","iv","gwlevels","site", "uv","qw","measurements","qwdata","stat"))
Laura A DeCicco's avatar
Laura A DeCicco committed
110
111
112
  
  if(service == "uv"){
    service <- "iv"
113
114
  } else if (service == "qw"){
    service <- "qwdata"
Laura A DeCicco's avatar
Laura A DeCicco committed
115
  }
116
  
117
118
119
120
  if(length(service) > 1){
    stop("Only one service call allowed.")
  }
  
Laura A DeCicco's avatar
Laura A DeCicco committed
121
  values <- sapply(matchReturn, function(x) as.character(paste(eval(x),collapse=",",sep="")))
122
  
123
124
  names(values)[names(values) == "startDate"] <- "startDT"
  names(values)[names(values) == "endDate"] <- "endDT"
Laura A DeCicco's avatar
Laura A DeCicco committed
125
126
127
  names(values)[names(values) == "siteNumber"] <- "sites"
  names(values)[names(values) == "siteNumbers"] <- "sites"
  
128
  format.default <- "waterml,1.1"
129
  
Laura A DeCicco's avatar
Laura A DeCicco committed
130
131
132
133
  if("stateCd" %in% names(values)){
    values["stateCd"] <- stateCdLookup(values["stateCd"], "postal")
  }
  
Laura A DeCicco's avatar
Laura A DeCicco committed
134
135
136
137
138
  if("statecode" %in% names(values)){
    values["statecode"] <- stateCdLookup(values["statecode"], "postal")
    names(values)[names(values) == "statecode"] <- "stateCd"
  }
  
Laura A DeCicco's avatar
Laura A DeCicco committed
139
  if (service %in% c("qwdata","measurements")){
140

141
    format.default <- "rdb"
142
143
144
145
146
147
148
149
150
151
152
153
154
    
    names(values)[names(values) == "startDT"] <- "begin_date"
    names(values)[names(values) == "endDT"] <- "end_date"
    
    if("bBox" %in% names(values)){
      values["nw_longitude_va"] <- as.character(matchReturn$bBox[1])
      values["nw_latitude_va"] <- as.character(matchReturn$bBox[2])
      values["se_longitude_va"] <- as.character(matchReturn$bBox[3])
      values["se_latitude_va"] <- as.character(matchReturn$bBox[4])
      values["coordinate_format"] <- "decimal_degrees"
      values <- values[-which("bBox" %in% names(values))] 
    }
    
155
156
157
158
159
160
161
162
163
164
165
166
167
    values["date_format"] <- "YYYY-MM-DD"
    values["rdb_inventory_output"] <- "file"
    values["TZoutput"] <- "0"
    
    if(all(c("begin_date","end_date") %in% names(values))){
      values["range_selection"] <- "date_range"
    }
    
    if(service == "qwdata"){
      values["qw_sample_wide"] <- "wide"
    }
    
  } 
Laura A DeCicco's avatar
Laura A DeCicco committed
168
  
169
170
171
172
173
174
175
  if("tz" %in% names(values)){
    tz <- values["tz"]
    if(tz != ""){
      rTZ <- c("America/New_York","America/Chicago",
               "America/Denver","America/Los_Angeles",
               "America/Anchorage","America/Honolulu",
               "America/Jamaica","America/Managua",
Laura A DeCicco's avatar
Laura A DeCicco committed
176
               "America/Phoenix","America/Metlakatla","UTC")
177
      tz <- match.arg(tz, rTZ)
Laura A DeCicco's avatar
Laura A DeCicco committed
178
      if("UTC" == tz) tz <- ""
179
180
181
182
183
184
    }
    values <- values[!(names(values) %in% "tz")]
  } else {
    tz <- ""
  }
  
185
  if(service %in% c("site","gwlevels","stat")){
186
187
188
    format.default <- "rdb"
  }
  
189
190
191
192
193
194
  if(service == "stat"){
    message("Please be aware the NWIS data service feeding this function is in BETA.\n
          Data formatting could be changed at any time, and is not guaranteed")
    
  }
  
195
196
  if(!("format" %in% names(values))){
    values["format"] <- format.default
Laura A DeCicco's avatar
Laura A DeCicco committed
197
  }
198
  
Laura A DeCicco's avatar
Laura A DeCicco committed
199
200
  values <- sapply(values, function(x) URLencode(x))
  
201
  baseURL <- drURL(service, arg.list=values)
202
  
203
204
205
  if(service %in% c("site","dv","iv","gwlevels")) {
    baseURL <- appendDrURL(baseURL, Access=pkg.env$access)
  }
206
  #actually get the data
207
  if(length(grep("rdb",values["format"])) >0){
208
    retval <- importRDB1(baseURL, tz = tz, asDateTime=asDateTime, convertType=convertType)
209
  } else {
210
    retval <- importWaterML1(baseURL, tz= tz, asDateTime=asDateTime)
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
  }
  
  if("dv" == service){
    
    tzLib <- setNames(c("America/New_York","America/New_York",
                                "America/Chicago","America/Chicago",
                                "America/Denver","America/Denver",
                                "America/Los_Angeles","America/Los_Angeles",
                                "America/Anchorage","America/Anchorage",
                                "America/Honolulu","America/Honolulu","UTC"),
                              c("EST","EDT",
                                "CST","CDT",
                                "MST","MDT",
                                "PST","PDT",
                                "AKST","AKDT",
                                "HAST","HST","UTC"))
    #TODO: Think about dates that cross a time zone boundary.
Laura A DeCicco's avatar
Laura A DeCicco committed
228
    if(values["format"] == "waterml,1.1" & nrow(retval) > 0){
Laura A DeCicco's avatar
Laura A DeCicco committed
229
230
231
      retval$dateTime <- as.POSIXct(retval$dateTime, tzLib[tz=retval$tz_cd[1]])
    }
    
232
  }
233
    
234
235
236
237
238
  if("iv" == service){
    if(tz == ""){
      retval$tz_cd <- rep("UTC", nrow(retval))
    } else {
      retval$tz_cd <- rep(tz, nrow(retval))
239
    }
Laura A DeCicco's avatar
Laura A DeCicco committed
240
  }
Laura A DeCicco's avatar
Laura A DeCicco committed
241
  
Laura A DeCicco's avatar
Laura A DeCicco committed
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
  return(retval)
}

#' State code look up 
#'
#' Function to simplify finding state and state code definitions. Used in \code{readNWISdata}
#' and \code{readWQPdata}.
#'
#' @param input could be character (full name, abbreviation, id), or numeric (id)
#' @param outputType character can be "postal","fullName","tableIndex", or "id". 
#' @export
#' @examples
#' fullName <- stateCdLookup("wi", "fullName")
#' abbriev <- stateCdLookup("Wisconsin", "postal")
#' id <- stateCdLookup("WI", "id")
#' name <- stateCdLookup(55, "fullName")
#' index <- stateCdLookup("WI", "tableIndex")
#' stateCd[index,]
Laura A DeCicco's avatar
Laura A DeCicco committed
260
#' stateCdLookup(c("West Virginia", "Wisconsin", 55, "MN"))
Laura A DeCicco's avatar
Laura A DeCicco committed
261
262
263
264
stateCdLookup <- function(input, outputType="postal"){
  
  outputType <- match.arg(outputType, c("postal","fullName","tableIndex","id"))
  
Laura A DeCicco's avatar
Laura A DeCicco committed
265
  retVal <- NA
266
  
Laura A DeCicco's avatar
Laura A DeCicco committed
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
  for(i in input){
    if(is.numeric(i) | !is.na(suppressWarnings(as.numeric(i)))){
      i <- which(as.numeric(i) == as.numeric(stateCd$STATE))
    } else if(nchar(i) == 2){
      i <- which(tolower(i) == tolower(stateCd$STUSAB))
    } else {
      i <- which(tolower(i) == tolower(stateCd$STATE_NAME))
    }
    
    output <- switch(outputType,
                     postal = stateCd$STUSAB[i],
                     fullName = stateCd$STATE_NAME[i],
                     tableIndex = i,
                     id = as.integer(stateCd$STATE[i])
    )
    
    retVal <- c(retVal,output)
  }
285
  
Laura A DeCicco's avatar
Laura A DeCicco committed
286
  return(retVal[-1])
287
}
David Watkins's avatar
David Watkins committed
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309

#' County code look up 
#'
#' Function to simplify finding county and county code definitions. Used in \code{readNWISdata}
#' and \code{readNWISuse}.
#'
#' @param state could be character (full name, abbreviation, id), or numeric (id)
#' @param county could be character (name, with or without "County") or numeric (id)
#' @param outputType character can be "fullName","tableIndex", "id", or "fullEntry". 
#' @export
#' @examples
#' id <- countyCdLookup(state = "WI", county = "Dane")
#' name <- countyCdLookup(state = "OH", county = 13, output = "fullName")
#' index <- countyCdLookup(state = "Pennsylvania", county = "ALLEGHENY COUNTY", output = "tableIndex")
#' fromIDs <- countyCdLookup(state = 13, county = 5, output = "fullName")
countyCdLookup <- function(state, county, outputType = "id"){
  outputType <- match.arg(outputType, c("fullName","tableIndex","id","fullEntry"))
  
  #first turn state into stateCd postal name
  stateCd <- stateCdLookup(state,outputType = "postal")
  
  if(is.numeric(county) | !is.na(suppressWarnings(as.numeric(county)))){
David Watkins's avatar
David Watkins committed
310
    county <- which(as.numeric(county) == as.numeric(countyCd$COUNTY) & stateCd == countyCd$STUSAB)
David Watkins's avatar
David Watkins committed
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
  } else {
    #check if "County" was included on string - need it to match countyCd data frame
    county <- ifelse(!grepl('(?i)\\County$',county),paste(county,"County"),county)
    county <- which(tolower(county) == tolower(countyCd$COUNTY_NAME) & stateCd == countyCd$STUSAB)
  }
  
  retVal <- switch(outputType,
                   fullName = countyCd$COUNTY_NAME[county],
                   tableIndex = county,
                   id = countyCd$COUNTY[county],
                   fullEntry = countyCd[county,]
  )
  
  return(retVal)
}