whatNWISsites.R 2.86 KB
Newer Older
1
2
#' Site Data Import from NWIS
#'
Laura A DeCicco's avatar
Laura A DeCicco committed
3
4
#' Returns a list of sites from the NWIS web service. This function gets the data from: \url{https://waterservices.usgs.gov/rest/Site-Test-Tool.html}.
#' Arguments to the function should be based on \url{https://waterservices.usgs.gov/rest/Site-Service.html#Service}
Laura A DeCicco's avatar
Laura A DeCicco committed
5
#' Mapper format is used
6
#'
Laura A DeCicco's avatar
Laura A DeCicco committed
7
#' @param \dots see \url{https://waterservices.usgs.gov/rest/Site-Service.html#Service} for a complete list of options
8
#' @import utils
Laura A DeCicco's avatar
Laura A DeCicco committed
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
#' @return A data frame with at least the following columns:
#' \tabular{lll}{
#' Name \tab Type \tab Description \cr
#' agency_cd \tab character \tab The NWIS code for the agency reporting the data\cr
#' site_no \tab character \tab The USGS site number \cr
#' station_nm \tab character \tab Station name \cr
#' site_tp_cd \tab character \tab Site type code \cr
#' dec_lat_va \tab numeric \tab Decimal latitude \cr
#' dec_long_va \tab numeric \tab Decimal longitude \cr
#' queryTime \tab POSIXct \tab Query time \cr
#' }
#' 
#' There are also several useful attributes attached to the data frame:
#' \tabular{lll}{
#' Name \tab Type \tab Description \cr
#' url \tab character \tab The url used to generate the data \cr
#' queryTime \tab POSIXct \tab The time the data was returned \cr
#' }
27
#' @export
David Watkins's avatar
David Watkins committed
28
#' @importFrom xml2 xml_root
David Watkins's avatar
David Watkins committed
29
30
31
#' @importFrom xml2 xml_children
#' @importFrom xml2 xml_attr
#' @importFrom dplyr bind_rows
David Watkins's avatar
David Watkins committed
32
#' 
33
#' @examples
34
#' \dontrun{
Laura A DeCicco's avatar
Laura A DeCicco committed
35
#' siteListPhos <- whatNWISsites(stateCd="OH",parameterCd="00665")
36
#' }
Laura A DeCicco's avatar
Laura A DeCicco committed
37
whatNWISsites <- function(...){
38
  
39
  matchReturn <- list(...)
Laura A DeCicco's avatar
Laura A DeCicco committed
40
  values <- sapply(matchReturn, function(x) URLencode(as.character(paste(eval(x),collapse=",",sep=""))))
41
  
Laura A DeCicco's avatar
Laura A DeCicco committed
42
43
  names(values)[names(values) == "siteNumber"] <- "sites"
  names(values)[names(values) == "siteNumbers"] <- "sites"
44
  
Laura A DeCicco's avatar
Laura A DeCicco committed
45
  urlCall <- drURL('site',Access=pkg.env$access, format="mapper", arg.list = values)
46

47
  rawData <- getWebServiceData(urlCall, encoding='gzip')
48

David Watkins's avatar
David Watkins committed
49
  doc <- xml_root(rawData)
David Watkins's avatar
David Watkins committed
50
  siteCategories <- xml_children(doc)
David Watkins's avatar
David Watkins committed
51
  retVal <- NULL
David Watkins's avatar
David Watkins committed
52
53
54
55
  for(sc in siteCategories){
    sites <- xml_children(sc)
    #attrs <- c("sno","sna","cat","lat","lng","agc")
    site_no <- xml_attr(sites, "sno")
David Watkins's avatar
David Watkins committed
56
57
58
59
60
    station_nm <- xml_attr(sites, "sna")
    site_tp_cd <- xml_attr(sites, "cat")
    dec_lat_va <- as.numeric(xml_attr(sites, "lat"))
    dec_long_va <- as.numeric(xml_attr(sites, "lng"))
    agency_cd <- xml_attr(sites, "agc")
David Watkins's avatar
David Watkins committed
61
62
63
64
65
66
67
    
    if(xml_name(sc)=="colocated_sites"){
      colocated <- TRUE
    }else{
      colocated <- FALSE
    }
    
68
    df <- data.frame(agency_cd, site_no, station_nm, site_tp_cd, 
David Watkins's avatar
David Watkins committed
69
                     dec_lat_va, dec_long_va, colocated, stringsAsFactors=FALSE) 
70
    
David Watkins's avatar
David Watkins committed
71
72
73
74
    if(is.null(retVal)){
      retVal <- df
    }else{
      retVal <- bind_rows(retVal, df)
75
    }
76
  }
77
  
David Watkins's avatar
David Watkins committed
78
79
80
81
  retVal <- retVal[!duplicated(retVal),]
  retVal$queryTime <- Sys.time()
  attr(retVal, "url") <- urlCall
  attr(retVal, "queryTime") <- Sys.time()
Laura A DeCicco's avatar
Laura A DeCicco committed
82
  
David Watkins's avatar
David Watkins committed
83
  return(retVal)
84
}