constructNWISURL.r 15.3 KB
Newer Older
1
2
#' Construct NWIS url for data retrieval
#'
Laura A DeCicco's avatar
Laura A DeCicco committed
3
4
5
#' Imports data from NWIS web service. This function gets the data from here: \url{https://nwis.waterdata.usgs.gov/nwis/qwdata}
#' A list of parameter codes can be found here: \url{https://nwis.waterdata.usgs.gov/nwis/pmcodes/}
#' A list of statistic codes can be found here: \url{https://nwis.waterdata.usgs.gov/nwis/help/?read_file=stat&format=table}
6
7
8
#'
#' @param siteNumber string or vector of strings USGS site number.  This is usually an 8 digit number
#' @param parameterCd string or vector of USGS parameter code.  This is usually an 5 digit number.
9
10
11
12
#' @param startDate character starting date for data retrieval in the form YYYY-MM-DD. Default is "" which indicates
#' retrieval for the earliest possible record.
#' @param endDate character ending date for data retrieval in the form YYYY-MM-DD. Default is "" which indicates
#' retrieval for the latest possible record.
13
#' @param statCd string or vector USGS statistic code only used for daily value service. This is usually 5 digits.  Daily mean (00003) is the default.
14
#' @param service string USGS service to call. Possible values are "dv" (daily values), "uv" (unit/instantaneous values), 
15
16
#'  "qw" (water quality data), "gwlevels" (groundwater),and "rating" (rating curve), "peak", "meas" (discrete streamflow measurements),
#'  "stat" (statistics web service BETA).
17
18
19
#' @param format string, can be "tsv" or "xml", and is only applicable for daily and unit value requests.  "tsv" returns results faster, but there is a possiblitiy that an incomplete file is returned without warning. XML is slower, 
#' but will offer a warning if the file was incomplete (for example, if there was a momentary problem with the internet connection). It is possible to safely use the "tsv" option, 
#' but the user must carefully check the results to see if the data returns matches what is expected. The default is therefore "xml". 
Laura A DeCicco's avatar
Laura A DeCicco committed
20
#' @param expanded logical defaults to \code{TRUE}. If \code{TRUE}, retrieves additional information, only applicable for qw data.
21
#' @param ratingType can be "base", "corr", or "exsa". Only applies to rating curve data.
David Watkins's avatar
David Watkins committed
22
23
24
25
#' @param statReportType character Only used for statistics service requests.  Time division for statistics: daily, monthly, or annual.  Default is daily.
#' Note that daily provides statistics for each calendar day over the specified range of water years, i.e. no more than 366
#' data points will be returned for each site/parameter.  Use readNWISdata or readNWISdv for daily averages. 
#' Also note that 'annual' returns statistics for the calendar year.  Use readNWISdata for water years. Monthly and yearly 
26
#' provide statistics for each month and year within the range individually.
David Watkins's avatar
David Watkins committed
27
28
#' @param statType character Only used for statistics service requests. Type(s) of statistics to output for daily values.  Default is mean, which is the only
#' option for monthly and yearly report types. See the statistics service documentation 
Laura A DeCicco's avatar
Laura A DeCicco committed
29
#' at \url{https://waterservices.usgs.gov/rest/Statistics-Service.html#statType} for a full list of codes.
30
#' @keywords data import USGS web service
31
#' @return url string
32
#' @export
33
#' @import utils
34
#' @examples
35
36
37
#' siteNumber <- '01594440'
#' startDate <- '1985-01-01'
#' endDate <- ''
38
#' pCode <- c("00060","00010")
39
40
#' url_daily <- constructNWISURL(siteNumber,pCode,
#'            startDate,endDate,'dv',statCd=c("00003","00001"))
Laura A DeCicco's avatar
Laura A DeCicco committed
41
42
#' url_unit <- constructNWISURL(siteNumber,pCode,"2012-06-28","2012-06-30",'iv')
#' 
43
#' url_qw_single <- constructNWISURL(siteNumber,"01075",startDate,endDate,'qw')
Laura A DeCicco's avatar
Laura A DeCicco committed
44
45
46
47
#' url_qw <- constructNWISURL(siteNumber,c('01075','00029','00453'),
#'            startDate,endDate,'qw')
#' url_daily_tsv <- constructNWISURL(siteNumber,pCode,startDate,endDate,'dv',
#'            statCd=c("00003","00001"),format="tsv")
48
49
50
#' url_rating <- constructNWISURL(siteNumber,service="rating",ratingType="base")
#' url_peak <- constructNWISURL(siteNumber, service="peak")
#' url_meas <- constructNWISURL(siteNumber, service="meas")
Laura A DeCicco's avatar
Laura A DeCicco committed
51
#' urlQW <- constructNWISURL("450456092225801","70300",startDate="",endDate="","qw",expanded=TRUE)
Laura A DeCicco's avatar
Laura A DeCicco committed
52
constructNWISURL <- function(siteNumber,parameterCd="00060",startDate="",endDate="",
Laura A DeCicco's avatar
Laura A DeCicco committed
53
                             service,statCd="00003", format="xml",expanded=TRUE,
David Watkins's avatar
David Watkins committed
54
                             ratingType="base",statReportType="daily",statType="mean"){
55

56
  service <- match.arg(service, c("dv","uv","iv","qw","gwlevels","rating","peak","meas","stat"))
57
  
58
  if(any(!is.na(parameterCd) & parameterCd != "all")){
Laura A DeCicco's avatar
Laura A DeCicco committed
59
60
61
    pcodeCheck <- all(nchar(parameterCd) == 5) & all(!is.na(suppressWarnings(as.numeric(parameterCd))))
    
    if(!pcodeCheck){
62
63
      badIndex <- which(nchar(parameterCd) != 5 | is.na(suppressWarnings(as.numeric(parameterCd))))
      stop("The following pCodes appear mistyped:",paste(parameterCd[badIndex],collapse=","))
64
    }
65
    
66
67
68
    if(length(parameterCd) > 200){
      stop("Maximum parameter codes allowed is 200, please adjust data request.")
    }
69
  }
70
  
Laura A DeCicco's avatar
Laura A DeCicco committed
71
  multipleSites <- length(siteNumber) > 1
72
  
Laura A DeCicco's avatar
Laura A DeCicco committed
73
  siteNumber <- paste(siteNumber, collapse=",")
74
75
  
  switch(service,
76
         qw = {
Laura A DeCicco's avatar
Laura A DeCicco committed
77
78
             if(multipleSites){    
               
79
80
81
82
83
84
85
86
               siteNumber <- paste("multiple_site_no",siteNumber,sep="=")
               searchCriteria <- "multiple_site_no"
             } else {
               siteNumber <- paste("search_site_no",siteNumber,sep="=")
               siteNumber <- paste(siteNumber,"search_site_no_match_type=exact",sep="&")
               searchCriteria <- "search_site_no"
             }
             
87
88
             multiplePcodes <- length(parameterCd)>1
             
Laura A DeCicco's avatar
Laura A DeCicco committed
89
             if(multiplePcodes){
90
91
92
93
94
95
96
97
98
99
               pCodes <- paste(parameterCd, collapse=",")
               pCodes <- paste('multiple_parameter_cds', pCodes, sep="=")
               pCodes <- paste(pCodes, "param_cd_operator=OR",sep="&")
             } else {
               pCodes <- paste("multiple_parameter_cds", parameterCd, sep="=")
               pCodes <- paste(pCodes, "param_cd_operator=AND",sep="&")
             }
             
             searchCriteria <- paste(searchCriteria, "multiple_parameter_cds", sep=",")
             searchCriteria <- paste("list_of_search_criteria",searchCriteria,sep="=")
100
101

             baseURL <- drURL("qwdata")
102
             
103
             url <- paste0(baseURL,siteNumber)
104
105
106
107
             url <- paste(url, pCodes,searchCriteria,
                          "group_key=NONE&sitefile_output_format=html_table&column_name=agency_cd",
                          "column_name=site_no&column_name=station_nm&inventory_output=0&rdb_inventory_output=file",
                          "TZoutput=0&pm_cd_compare=Greater%20than&radio_parm_cds=previous_parm_cds&qw_attributes=0",
108
                          "format=rdb&rdb_qw_attributes=0&date_format=YYYY-MM-DD",
109
                          "rdb_compression=value", sep = "&")
110
             if(expanded){
111
               url <- appendDrURL(url,qw_sample_wide="0")
Laura A DeCicco's avatar
Laura A DeCicco committed
112
               url <- gsub("rdb_qw_attributes=0","rdb_qw_attributes=expanded",url)
113
             } else {
114
               url <- appendDrURL(url,qw_sample_wide="separated_wide")
115
             }
116
117
             
             if (nzchar(startDate)) {
118
               url <- appendDrURL(url,begin_date=startDate)
119
120
121
             }
             
             if (nzchar(endDate)) {
122
               url <- appendDrURL(url,end_date=endDate)
123
124
             }
           },
125
126
        rating = {
          ratingType <- match.arg(ratingType, c("base", "corr", "exsa"))
127
          url <- drURL("rating", site_no=siteNumber,file_type=ratingType)
128
129
        },
        peak = {
130
131
132
          url <- drURL("peak", site_no=siteNumber,
                       range_selection="date_range",
                       format="rdb")
133
          if (nzchar(startDate)) {
134
135
            url <- appendDrURL(url,begin_date=startDate)
          } 
136
          if(nzchar(endDate)){
137
            url <- appendDrURL(url, end_date=endDate)
138
139
140
          }
        },
        meas = {
Laura A DeCicco's avatar
Laura A DeCicco committed
141
          url <- drURL("measurements", site_no=siteNumber,
142
                       range_selection="date_range")
143
          if (nzchar(startDate)) {
144
            url <- appendDrURL(url,begin_date=startDate)
145
146
          }
          if(nzchar(endDate)){
147
            url <- appendDrURL(url, end_date=endDate)
148
          }
149
          if(expanded){
150
            url <- appendDrURL(url,format="rdb_expanded")
151
          } else {
152
            url <- appendDrURL(url,format="rdb")
153
          }
154

David Watkins's avatar
David Watkins committed
155
        },
156
        stat = { #for statistics service
157
158
159
160
          
          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")
          
161
          #make sure only statTypes allowed for the statReportType are being requested
David Watkins's avatar
David Watkins committed
162
          if(!grepl("(?i)daily",statReportType) && !all(grepl("(?i)mean",statType)) && !all(grepl("(?i)all",statType))){
163
164
165
166
167
168
            stop("Monthly and annual report types can only provide means")
          }
          
          #make sure dates aren't too specific for statReportType
          if(grepl("(?i)monthly",statReportType) && (length(unlist(gregexpr("-",startDate))) > 1 
             || length(unlist(gregexpr("-",endDate))) > 1)){
169
            stop("Start and end dates for monthly statReportType can only include months and years")
170
171
          }
          if(grepl("(?i)annual",statReportType) && (grepl("-",startDate) || grepl("-",endDate))){
172
            stop("Start and end dates for annual statReportType can only include years")
David Watkins's avatar
David Watkins committed
173
          }
174
          statType <- paste(statType,collapse=",")
David Watkins's avatar
David Watkins committed
175
          parameterCd <- paste(parameterCd,collapse=",")
176
177
178
179
          url <- drURL("stat", sites=siteNumber,
                       statType=statType,
                       statReportType=statReportType,
                       parameterCd=parameterCd)
David Watkins's avatar
David Watkins committed
180
          if (nzchar(startDate)) {
181
            url <- appendDrURL(url,startDT=startDate)
David Watkins's avatar
David Watkins committed
182
183
          }
          if (nzchar(endDate)) {
184
            url <- appendDrURL(url,endDT=endDate)
185
186
          }
          if (!grepl("(?i)daily",statReportType)){
187
            url <- appendDrURL(url,missingData="off")
David Watkins's avatar
David Watkins committed
188
189
          }
          
190
191
        },
        
192
        { # this will be either dv or uv
193
          multiplePcodes <- length(parameterCd)>1
194
          # Check for 5 digit parameter code:
Laura A DeCicco's avatar
Laura A DeCicco committed
195
          if(multiplePcodes){
196
            parameterCd <- paste(parameterCd, collapse=",")
197
          } 
198
          
199
200
201
          if ("uv"==service) {
            service <- "iv"
          }
202
          
203
204
205
206
207
208
209
210
211
212
213
214
          format <- match.arg(format, c("xml","tsv","wml1","wml2","rdb"))
          
          formatURL <- switch(format,
            xml = {if ("gwlevels" == service) {
                "waterml"
              } else {
                "waterml,1.1"
              }
            },
            rdb = "rdb,1.0",
            tsv = "rdb,1.0",
            wml2 = "waterml,2.0",
Laura A DeCicco's avatar
Laura A DeCicco committed
215
216
217
218
219
220
            wml1 = {if ("gwlevels" == service) {
                "waterml"
              } else {
                "waterml,1.1"
              }
            }
221
222
          )

223
          url <- drURL(service, Access=pkg.env$access, site=siteNumber, format=formatURL)
Laura A DeCicco's avatar
Laura A DeCicco committed
224
225
          
          if("gwlevels"!= service){
226
            url <- appendDrURL(url, ParameterCd=parameterCd)
Laura A DeCicco's avatar
Laura A DeCicco committed
227
          }
228
229
          
          if("dv"==service) {
230
231
232
            if(length(statCd) > 1){
              statCd <- paste(statCd, collapse=",")
            }            
233
            url <- appendDrURL(url, StatCd=statCd)
234
235
236
          }
          
          if (nzchar(startDate)) {
237
            url <- appendDrURL(url, startDT=startDate)
238
          } else {
Laura A DeCicco's avatar
Laura A DeCicco committed
239
            startorgin <- "1851-01-01"
240
            if ("iv" == service) startorgin <- "1900-01-01"            
241
            url <- appendDrURL(url, startDT=startorgin)
242
243
244
          }
          
          if (nzchar(endDate)) {
245
            url <- appendDrURL(url, endDT=endDate)
246
247
248
249
          }
        }
         
    )
250

Laura A DeCicco's avatar
Laura A DeCicco committed
251
  return(url)
252
}
253
254
255
256
257
258
259





#' Construct WQP url for data retrieval
#'
Laura A DeCicco's avatar
Laura A DeCicco committed
260
#' Construct WQP url for data retrieval. This function gets the data from here: \url{https://www.waterqualitydata.us}
261
262
263
#'
#' @param siteNumber string or vector of strings USGS site number.  This is usually an 8 digit number
#' @param parameterCd string or vector of USGS parameter code.  This is usually an 5 digit number.
264
265
266
267
#' @param startDate character starting date for data retrieval in the form YYYY-MM-DD. Default is "" which indicates
#' retrieval for the earliest possible record.
#' @param endDate character ending date for data retrieval in the form YYYY-MM-DD. Default is "" which indicates
#' retrieval for the latest possible record.
268
#' @param zip logical to request data via downloading zip file. Default set to FALSE.
269
270
271
272
273
274
275
276
277
278
279
#' @keywords data import WQP web service
#' @return url string
#' @export
#' @examples
#' siteNumber <- '01594440'
#' startDate <- '1985-01-01'
#' endDate <- ''
#' pCode <- c("00060","00010")
#' url_wqp <- constructWQPURL(paste("USGS",siteNumber,sep="-"),
#'            c('01075','00029','00453'),
#'            startDate,endDate)
280
constructWQPURL <- function(siteNumber,parameterCd,startDate,endDate,zip=FALSE){
281
282
283
  
  multipleSites <- length(siteNumber) > 1
  multiplePcodes <- length(parameterCd)>1
284
  siteNumber <- paste(siteNumber, collapse=";")
285
286
287
288
289

  if(all(nchar(parameterCd) == 5)){
    suppressWarnings(pCodeLogic <- all(!is.na(as.numeric(parameterCd))))
  } else {
    pCodeLogic <- FALSE
Laura A DeCicco's avatar
Laura A DeCicco committed
290
    parameterCd <- URLencode(parameterCd, reserved = TRUE)
291
292
293
294
295
  }
  
  if(multiplePcodes){
    parameterCd <- paste(parameterCd, collapse=";")
  }
296
  
Laura A DeCicco's avatar
Laura A DeCicco committed
297
  baseURL <- drURL("wqpData", siteid = siteNumber) 
298
299
300
301
  url <- paste0(baseURL,
                ifelse(pCodeLogic,"&pCode=","&characteristicName="),
                parameterCd)
  
302
303
  if (nzchar(startDate)){
    startDate <- format(as.Date(startDate), format="%m-%d-%Y")
304
    url <- paste0(url, "&startDateLo=",startDate)
305
  }
306
  
307
308
  if (nzchar(endDate)){
    endDate <- format(as.Date(endDate), format="%m-%d-%Y")
309
    url <- paste0(url, "&startDateHi=",endDate)
310
311
  }
  
Laura A DeCicco's avatar
Laura A DeCicco committed
312
  url <- paste0(url,"&sorted=no&mimeType=tsv")
Laura A DeCicco's avatar
Laura A DeCicco committed
313
314
315
316
317
  
  if(zip){
    url <- paste0(url,"&zip=yes")
  }
  
318
  return(url)
319
320

}
David Watkins's avatar
David Watkins committed
321
322
323

#' Construct URL for NWIS water use data service
#' 
Laura A DeCicco's avatar
Laura A DeCicco committed
324
#' Reconstructs URLs to retrieve data from here: \url{https://waterdata.usgs.gov/nwis/wu}
David Watkins's avatar
David Watkins committed
325
#' 
David Watkins's avatar
David Watkins committed
326
327
328
#' @param years integer Years for data retrieval. Must be years ending in 0 or 5, or "ALL", which retrieves all available years.
#' @param stateCd could be character (full name, abbreviation, id), or numeric (id)
#' @param countyCd could be numeric (County IDs from countyCdLookup) or character ("ALL") 
329
#' @param categories character Two-letter cateogory abbreviation(s)
David Watkins's avatar
David Watkins committed
330
331
332
#' @return url string
#' @export
#' @examples
333
#' url <- constructUseURL(years=c(1990,1995),stateCd="Ohio",countyCd = c(1,3), categories = "ALL")
David Watkins's avatar
David Watkins committed
334
#' 
335
constructUseURL <- function(years,stateCd,countyCd,categories){ 
Laura A DeCicco's avatar
Laura A DeCicco committed
336

David Watkins's avatar
David Watkins committed
337
    if(is.null(stateCd)){
Laura A DeCicco's avatar
Laura A DeCicco committed
338
339
      baseURL <- drURL("useNat", format="rdb", rdb_compression="value")
    } else {
David Watkins's avatar
David Watkins committed
340
      stateCd <- stateCdLookup(input = stateCd, outputType = "postal")
Laura A DeCicco's avatar
Laura A DeCicco committed
341
342
      baseURL <- "https://waterdata.usgs.gov/"
      base2 <- "nwis/water_use?format=rdb&rdb_compression=value"
David Watkins's avatar
David Watkins committed
343
      baseURL <- paste0(baseURL,paste0(stateCd,"/"),base2)
Laura A DeCicco's avatar
Laura A DeCicco committed
344
      
David Watkins's avatar
David Watkins committed
345
346
347
348
      if(!is.null(countyCd)){
        
        if(length(countyCd) > 1) {countyCd <- paste(countyCd,collapse="%2C")}
          baseURL <- paste0(baseURL,"&wu_area=county&wu_county=",countyCd)
Laura A DeCicco's avatar
Laura A DeCicco committed
349
350
      } else {
        baseURL <- paste0(baseURL,"&wu_area=State%20Total")
David Watkins's avatar
David Watkins committed
351
      }
Laura A DeCicco's avatar
Laura A DeCicco committed
352
    }
David Watkins's avatar
David Watkins committed
353
    years <- paste(years, collapse="%2C")
354
355
    categories <- paste(categories, collapse = "%2C")
    retURL <- paste0(baseURL,"&wu_year=",years,"&wu_category=",categories)
David Watkins's avatar
David Watkins committed
356
357
358
    
    return(retURL)
}