R/ki_timeseries_list.R

Defines functions ki_timeseries_list

Documented in ki_timeseries_list

#' Get list of available time series for station or
#' list of stations.
#'
#' @export
#' @param hub The KiWIS database you are querying. Either one of the defaults or a URL.
#'  See \href{https://github.com/rywhale/kiwisR}{README}.
#' @param station_id Either a single station id or a vector of station ids. Can be string or numeric.
#' Station ids can be found using the ki_station_list function.
#' @param ts_name (Optional) A specific time series short name to search for. Supports the use of "*" as a wildcard.
#' @param coverage (Optional) Whether or not to return period of record columns.
#' Defaults to TRUE, change to FALSE for faster queries.
#' @param group_id (Optional) A time series group id (see ki_group_list)
#' @param return_fields (Optional) Specific fields to return. Consult your KiWIS hub services documentation for available options.
#' Should be a comma separate string or a vector.
#' @return A tibble containing all available time series for selected stations.
#' @examples
#' \dontrun{
#' ki_timeseries_list(hub = "swmc", station_id = "146775")
#' ki_timeseries_list(hub = "swmc", ts_name = "Vel*")
#'}
#'

ki_timeseries_list <- function(hub, station_id, ts_name, coverage = TRUE, group_id, return_fields) {
  # Check for no input
  if (missing(station_id) & missing(ts_name) & missing(group_id)) {
    stop("No station_id, ts_name or group_id provided.")
  }

  # Account for user-provided return fields
  if(missing(return_fields)){
    # Default
    return_fields <- "station_name,station_id,ts_id,ts_name"
  }else{
    if(!inherits(return_fields, "character")){
      stop(
        "User supplied return_fields must be comma separated string or vector of strings"
      )
    }

    # Account for user listing coverage in return_fields
    if(length(grepl("coverage", return_fields))){
      return_fields <- gsub(
        ",coverage|coverage,",
        "",
        return_fields
      )
    }
  }

  # Identify hub
  api_url <- check_hub(hub)

  api_query <- list(
    service = "kisters",
    type = "queryServices",
    request = "getTimeseriesList",
    format = "json",
    kvp = "true",
    returnfields = paste(
      return_fields,
      collapse = ","
      )
    )

  if (!missing(station_id)) {
    # Account for multiple station_ids
    station_id <- paste(station_id, collapse = ",")
    api_query[["station_id"]] <- station_id
  }

  if(coverage == TRUE){
    # Turn coverage columns on
    api_query[['returnfields']] <- paste0(
      api_query[['returnfields']],
      ",coverage"
    )
  }

  # Check for ts_name search
  if (!missing(ts_name)) {
    api_query[["ts_name"]] <- ts_name
  }

  # Check for group_id
  if(!missing(group_id)){
    api_query[["timeseriesgroup_id"]] <- group_id

  }

  # Send request
  raw <- tryCatch({
    httr::GET(
      url = api_url,
      query = api_query,
      httr::timeout(180)
    )}, error = function(e){
      return(e)
    })

  check_ki_response(raw)

  # Parse response
  raw_content <- httr::content(raw, "text")

  # Parse text
  json_content <- jsonlite::fromJSON(raw_content)

  # Check for special case single ts return
  if(nrow(json_content) == 2){
    content_dat <- tibble::as_tibble(
      json_content,
      .name_repair = "minimal"
      )[-1, ]
  }else{
    # Convert to  tibble
    content_dat <- tibble::as_tibble(
      json_content[-1, ],
      .name_repair = "minimal"
      )
  }

  # Add column names
  names(content_dat) <- json_content[1, ]

  # Cast lat/lon columns if they exist
  content_dat <- suppressWarnings(
    dplyr::mutate_at(
      content_dat,
      dplyr::vars(
        dplyr::one_of(c("station_latitude", "station_longitude"))
      ),
      as.double
    )
  )

  # Cast coverage columns if the exist
  content_dat <- suppressWarnings(
    dplyr::mutate_at(
      content_dat,
      dplyr::vars(
        dplyr::one_of(c("from", "to"))
        ),
      lubridate::ymd_hms
    )
  )

 return(content_dat)
}

Try the kiwisR package in your browser

Any scripts or data that you put into this service are public.

kiwisR documentation built on July 13, 2020, 5:08 p.m.