importWQP.R 6.37 KB
Newer Older
Laura A DeCicco's avatar
Laura A DeCicco committed
1
2


Laura A DeCicco's avatar
Laura A DeCicco committed
3
#' Basic Water Quality Portal Data parser
Laura A DeCicco's avatar
Laura A DeCicco committed
4
5
6
#'
#' Imports data from the Water Quality Portal based on a specified url.
#' 
7
#' @param obs_url character URL to Water Quality Portal#' @keywords data import USGS web service
8
#' @param zip logical to request data via downloading zip file. Default set to FALSE.
9
#' @param tz character to set timezone attribute of datetime. Default is an empty quote, which converts the 
Laura A DeCicco's avatar
Laura A DeCicco committed
10
11
12
#' datetimes to UTC (properly accounting for daylight savings times based on the data's provided tz_cd column).
#' Possible values to provide are "America/New_York","America/Chicago", "America/Denver","America/Los_Angeles",
#' "America/Anchorage","America/Honolulu","America/Jamaica","America/Managua","America/Phoenix", and "America/Metlakatla"
Laura A DeCicco's avatar
Laura A DeCicco committed
13
#' @return retval dataframe raw data returned from the Water Quality Portal. Additionally, a POSIXct dateTime column is supplied for 
Laura A DeCicco's avatar
Laura A DeCicco committed
14
#' start and end times, and converted to UTC. See \url{https://www.waterqualitydata.us/portal_userguide/} for more information.
Laura A DeCicco's avatar
Laura A DeCicco committed
15
#' @export
Laura A DeCicco's avatar
Laura A DeCicco committed
16
#' @seealso \code{\link{readWQPdata}}, \code{\link{readWQPqw}}, \code{\link{whatWQPsites}}
17
18
#' @import utils
#' @import stats
Laura A DeCicco's avatar
Laura A DeCicco committed
19
20
#' @importFrom readr read_delim
#' @importFrom readr col_character
21
#' @importFrom readr col_number
Laura A DeCicco's avatar
Laura A DeCicco committed
22
23
24
25
26
#' @importFrom readr cols
#' @importFrom dplyr mutate_
#' @importFrom dplyr mutate_each_
#' @importFrom dplyr select_
#' @importFrom dplyr left_join
Laura A DeCicco's avatar
Laura A DeCicco committed
27
28
#' @importFrom lubridate parse_date_time
#' @importFrom lubridate fast_strptime
Laura A DeCicco's avatar
Laura A DeCicco committed
29
30
31
#' @importFrom httr GET
#' @importFrom httr user_agent
#' @importFrom httr write_disk
Laura A DeCicco's avatar
Laura A DeCicco committed
32
33
#' @examples
#' # These examples require an internet connection to run
Laura A DeCicco's avatar
Laura A DeCicco committed
34
#' 
Laura A DeCicco's avatar
Laura A DeCicco committed
35
#' ## Examples take longer than 5 seconds:
Laura A DeCicco's avatar
Laura A DeCicco committed
36
#' \dontrun{
37
38
#' rawSampleURL <- constructWQPURL('USGS-01594440','01075', '', '')
#' 
39
#' rawSample <- importWQP(rawSampleURL)
Laura A DeCicco's avatar
Laura A DeCicco committed
40
#' 
Laura A DeCicco's avatar
Laura A DeCicco committed
41
42
#' rawSampleURL_Zip <- constructWQPURL('USGS-01594440','01075', '', '', TRUE)
#' rawSample2 <- importWQP(rawSampleURL_Zip, zip=TRUE)
Laura A DeCicco's avatar
Laura A DeCicco committed
43
#' 
Laura A DeCicco's avatar
Laura A DeCicco committed
44
45
#' STORETex <- constructWQPURL('WIDNR_WQX-10032762','Specific conductance', '', '')
#' STORETdata <- importWQP(STORETex)
Laura A DeCicco's avatar
Laura A DeCicco committed
46
#' }
47
importWQP <- function(obs_url, zip=FALSE, tz=""){
48
  
49
50
51
52
53
54
55
56
  if(tz != ""){
    tz <- match.arg(tz, c("America/New_York","America/Chicago",
                          "America/Denver","America/Los_Angeles",
                          "America/Anchorage","America/Honolulu",
                          "America/Jamaica","America/Managua",
                          "America/Phoenix","America/Metlakatla"))
  }
  
Laura A DeCicco's avatar
Laura A DeCicco committed
57
  if(!file.exists(obs_url)){
58
    
59
    if(zip){
60
      message("zip encoding access still in development")
61
      temp <- tempfile()
Laura A DeCicco's avatar
Laura A DeCicco committed
62
63
      temp <- paste0(temp,".zip")
      doc <- GET(obs_url, user_agent(default_ua()), 
64
                          write_disk(temp))
Laura A DeCicco's avatar
Laura A DeCicco committed
65

Laura A DeCicco's avatar
Laura A DeCicco committed
66
      headerInfo <- headers(doc)
67
68
69
70
      
    } else {
      doc <- getWebServiceData(obs_url)
      headerInfo <- attr(doc, "headerInfo")
Laura A DeCicco's avatar
Laura A DeCicco committed
71
    }
72
    
Laura A DeCicco's avatar
Laura A DeCicco committed
73
74
75
76
77
78
79
80
81
82
83
    numToBeReturned <- 0
    sitesToBeReturned <- 0
    
    if("total-result-count" %in% names(headerInfo)){
      numToBeReturned <- as.numeric(headerInfo["total-result-count"])
    } 
    
    if("total-site-count" %in% names(headerInfo)){
      sitesToBeReturned <- as.numeric(headerInfo["total-site-count"])
    }
    
84
85
86
87
88
89
90
    
    totalReturned <- sum(numToBeReturned, sitesToBeReturned,na.rm = TRUE)
    
    if(is.na(totalReturned) | totalReturned == 0){
      for(i in grep("Warning",names(headerInfo))){
        warning(headerInfo[i])
      }
Laura A DeCicco's avatar
Laura A DeCicco committed
91
92
93
      emptyReturn <- data.frame(NA)
      attr(emptyReturn, "headerInfo") <- headerInfo
      return(emptyReturn)
94
95
    }  
    
Laura A DeCicco's avatar
Laura A DeCicco committed
96
97
98
99
    if(zip){
      doc <- unzip(temp)
    }
    
100
  } else {
Laura A DeCicco's avatar
Laura A DeCicco committed
101
102
103
104
105
    if(zip){
      doc <- unzip(obs_url)
    } else {
      doc <- obs_url
    }
106
107
    
  }
Laura A DeCicco's avatar
Laura A DeCicco committed
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122

  retval <- suppressWarnings(read_delim(doc, 
                       col_types = cols(`ActivityStartTime/Time` = col_character(),
                                        `ActivityEndTime/Time` = col_character(),
                                        USGSPCode = col_character(),
                                        ResultCommentText=col_character(),
                                        `ActivityDepthHeightMeasure/MeasureValue` = col_number(),
                                        `DetectionQuantitationLimitMeasure/MeasureValue` = col_number(),
                                        ResultMeasureValue = col_number(),
                                        `WellDepthMeasure/MeasureValue` = col_number(),
                                        `WellHoleDepthMeasure/MeasureValue` = col_number(),
                                        `HUCEightDigitCode` = col_character()),
                       quote = "", delim = "\t"))
    
  if(zip) unlink(doc)
Laura A DeCicco's avatar
Laura A DeCicco committed
123
    
Laura A DeCicco's avatar
Laura A DeCicco committed
124
  if(!file.exists(obs_url)){
125
    actualNumReturned <- nrow(retval)
126
    
127
128
129
130
131
132
    if(actualNumReturned != numToBeReturned & actualNumReturned != sitesToBeReturned){
      warning(totalReturned, " sample results were expected, ", actualNumReturned, " were returned")
    } 
  }
  
  if(length(grep("ActivityStartTime",names(retval))) > 0){
Laura A DeCicco's avatar
Laura A DeCicco committed
133
    
134
135
136
137
138
139
140
141
142
143
144

    offsetLibrary <- data.frame(offset=c(5, 4, 6, 5, 7, 6, 8, 7, 9, 8, 10, 10, 0, 0),
                                code=c("EST","EDT","CST","CDT","MST","MDT","PST","PDT","AKST","AKDT","HAST","HST","", NA),
                                stringsAsFactors = FALSE)
    
    retval <- left_join(retval, offsetLibrary, by=c("ActivityStartTime/TimeZoneCode"="code"))
    names(retval)[names(retval) == "offset"] <- "timeZoneStart"
    retval <- left_join(retval, offsetLibrary, by=c("ActivityEndTime/TimeZoneCode"="code"))
    names(retval)[names(retval) == "offset"] <- "timeZoneEnd"
    
    dateCols <- c("ActivityStartDate","ActivityEndDate","AnalysisStartDate","PreparationStartDate")
145
146
147
148

    for(i in dateCols){
      retval[,i] <- suppressWarnings(as.Date(parse_date_time(retval[[i]], c("Ymd", "mdY"))))
    }
149
    
Laura A DeCicco's avatar
Laura A DeCicco committed
150

151
152
    retval <- mutate_(retval, ActivityStartDateTime=~paste(ActivityStartDate, `ActivityStartTime/Time`))
    retval <- mutate_(retval, ActivityEndDateTime=~paste(ActivityEndDate, `ActivityEndTime/Time`))
Laura A DeCicco's avatar
Laura A DeCicco committed
153
    
154
155
156
157
    retval <- mutate_(retval, ActivityStartDateTime=~fast_strptime(ActivityStartDateTime, '%Y-%m-%d %H:%M:%S')+60*60*timeZoneStart)
    retval <- mutate_(retval, ActivityEndDateTime=~fast_strptime(ActivityEndDateTime, '%Y-%m-%d %H:%M:%S')+60*60*timeZoneStart)
    
    retval <- select_(retval, ~-timeZoneEnd, ~-timeZoneStart)
158
  }
Laura A DeCicco's avatar
Laura A DeCicco committed
159
  names(retval)[grep("/",names(retval))] <- gsub("/",".",names(retval)[grep("/",names(retval))])
160
161
162
163
  
  return(retval)
  
  
Laura A DeCicco's avatar
Laura A DeCicco committed
164
}