importWaterML2.r 4.48 KB
Newer Older
1
2
#' Function to return data from the WaterML2 data
#'
Laura A DeCicco's avatar
Laura A DeCicco committed
3
4
#' This function accepts a url parameter for a WaterML2 getObservation. This function is still under development,
#' but the general functionality is correct.
5
#'
6
#' @param obs_url character or raw, containing the url for the retrieval or a path to the data file, or raw XML.
David Watkins's avatar
David Watkins committed
7
#' @param asDateTime logical, if \code{TRUE} returns date and time as POSIXct, if \code{FALSE}, character
8
#' @param tz character to set timezone attribute of datetime. Default is an empty quote, which converts the 
9
10
11
#' 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
12
#' @return mergedDF a data frame time, value, description, qualifier, and identifier
13
#' @export
David Watkins's avatar
David Watkins committed
14
15
16
17
#' @importFrom xml2 read_xml
#' @importFrom xml2 xml_find_all
#' @importFrom xml2 xml_text
#' @importFrom xml2 xml_attr
Laura A DeCicco's avatar
Laura A DeCicco committed
18
#' @importFrom dplyr rbind_all
David Watkins's avatar
David Watkins committed
19
#' @importFrom lubridate parse_date_time
20
#' @examples
Laura A DeCicco's avatar
Laura A DeCicco committed
21
#' baseURL <- "https://waterservices.usgs.gov/nwis/dv/?format=waterml,2.0"
22
23
24
25
26
#' URL <- paste(baseURL, "sites=01646500",
#'      "startDT=2014-09-01",
#'      "endDT=2014-09-08",
#'      "statCd=00003",
#'      "parameterCd=00060",sep="&")
27
#' \dontrun{
28
29
30
31
32
33
34
35
#' dataReturned1 <- importWaterML2(URL)
#' URLmulti <-  paste(baseURL,
#'   "sites=04024430,04024000",
#'   "startDT=2014-09-01",
#'   "endDT=2014-09-08",
#'   "statCd=00003",
#'   "parameterCd=00060",sep="&")
#' dataReturnMulti <- importWaterML2(URLmulti)
36
37
38
39
#' }
#' filePath <- system.file("extdata", package="dataRetrieval")
#' fileName <- "WaterML2Example.xml"
#' fullPath <- file.path(filePath, fileName)
40
#' UserData <- importWaterML2(fullPath)
41
#' 
42
importWaterML2 <- function(obs_url, asDateTime=FALSE, tz=""){
43
  
44
45
46
47
48
49
  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"))
David Watkins's avatar
David Watkins committed
50
  }else{tz = "UTC"}
51
  
David Watkins's avatar
David Watkins committed
52
  raw <- FALSE
53
54
55
56
  if(class(obs_url) == "character" && file.exists(obs_url)){
    returnedDoc <- read_xml(obs_url)
  }else if(class(obs_url) == 'raw'){
    returnedDoc <- read_xml(obs_url)
David Watkins's avatar
David Watkins committed
57
58
    raw <- TRUE
  } else {
59
    returnedDoc <- xml_root(getWebServiceData(obs_url, encoding='gzip'))
David Watkins's avatar
David Watkins committed
60
  }
61
  
David Watkins's avatar
David Watkins committed
62
  timeSeries <- xml_find_all(returnedDoc, "//wml2:Collection") #each parameter/site combo
63
  
64
  if(0 == length(timeSeries)){
Laura A DeCicco's avatar
Laura A DeCicco committed
65
    df <- data.frame()
David Watkins's avatar
David Watkins committed
66
    if(!raw){
67
      attr(df, "url") <- obs_url
David Watkins's avatar
David Watkins committed
68
    }
Laura A DeCicco's avatar
Laura A DeCicco committed
69
    return(df)
70
71
  }
  
David Watkins's avatar
David Watkins committed
72
  mergedDF <- NULL
73
  
David Watkins's avatar
David Watkins committed
74
75
76
77
  for(t in timeSeries){
    TVP <- xml_find_all(t, ".//wml2:MeasurementTVP")#time-value pairs
    time <- xml_text(xml_find_all(TVP,".//wml2:time"))
    #TODO: if asDateTime....
78
    if(asDateTime){
David Watkins's avatar
David Watkins committed
79
80
81
82
      time <- parse_date_time(time, c("%Y","%Y-%m-%d","%Y-%m-%dT%H:%M","%Y-%m-%dT%H:%M:%S",
                                      "%Y-%m-%dT%H:%M:%OS","%Y-%m-%dT%H:%M:%OS%z"), exact = TRUE)
      #^^setting tz in as.POSIXct just sets the attribute, does not convert the time!
      attr(time, 'tzone') <- tz 
83
    }
David Watkins's avatar
David Watkins committed
84
85
86
87
88
89
90
91
    values <- as.numeric(xml_text(xml_find_all(TVP,".//wml2:value")))
    #TODO: deal with multiple identifiers (assigning column names)
    idents <- xml_text(xml_find_all(t, ".//gml:identifier"))
    useIdents <- rep(idents, length(values))
    #TODO: check qualifiers in points against default, if both exist, same, etc
    tvpQuals <- xml_text(xml_find_all(TVP, ".//swe:description"))
    defaultPointMeta <- xml_find_all(t, ".//wml2:DefaultTVPMeasurementMetadata")
    defaultQuals <- xml_text(xml_find_all(defaultPointMeta, ".//swe:description"))
Laura A DeCicco's avatar
Laura A DeCicco committed
92
    
David Watkins's avatar
David Watkins committed
93
94
95
96
    if(length(tvpQuals) == 0){
      useQuals <- rep(defaultQuals, length(values))
    }else{
      useQuals <- tvpQuals
97
    }
David Watkins's avatar
David Watkins committed
98
99
100
101
102
103
    if(length(useQuals) == 0){
      df <- cbind.data.frame(time, value=values, identifier=useIdents,
                             stringsAsFactors=FALSE)
    }else{
    df <- cbind.data.frame(time, value=values, qualifier=useQuals, identifier=useIdents,
                           stringsAsFactors=FALSE)
104
    }
David Watkins's avatar
David Watkins committed
105
106
    if (is.null(mergedDF)){
      mergedDF <- df
107
    } else {
David Watkins's avatar
David Watkins committed
108
109
      similarNames <- intersect(colnames(mergedDF), colnames(df))
      mergedDF <- full_join(mergedDF, df, by=similarNames)
110
    }
111
  }
David Watkins's avatar
David Watkins committed
112
  return(mergedDF)
113
}
David Watkins's avatar
David Watkins committed
114
115