R/create-query.R

In yizhexu/weatherawhere:

#' Create a weather request query string
#'
#' Create a query string with multiple options
#' @param latitude A decimal-formmated number indicate the latitude of a
#' location
#' @param longitude A decimal-formmated number indicate the longitude of a
#' location
#' @param x Optional, number of grids on x axis (latitude)
#' @param y Optional, number of grids on y axis (longitude)
#' @param date Optional, a matrix with start date, end date and plant date
#' generated by \code{\link{set_date}}. Without given start date, the package
#' will use \code{Sys.Date()} as a start date.
#' @param attribute Optional, a vector with weather attributes. Generated by
#' \code{\link{get_attribute}}. By default, it will use minTemperature,
#' maxTemperature and precip.
#' @param gdd_method Optional,
#' @export
#' @return A query object if succesful, otherwise \code{failure}
#' @examples
#' create_query(latitude, longitude)
#' create_query(latitude, longitude, x = 5, y = 5)
#' create_query(latitude, longitude, x = 5, y = 5, set_date(start_date, end_date))
#' create_query(latitude, longitude, date = set_date(start_date, plant_date =
#' plant_date), attribute = get_attribute(c("^acc", "gdd$")), gdd_method =
#' set_gdd(gdd_method = "modifiedstandard"))

create_query <- function(latitude, longitude, x = NULL, y = NULL, size = NULL, date = NULL, attribute = NULL, gdd_method = NULL) {

  check_location(latitude)
  check_location(longitude)

  if(is.null(x)) x <- 1
  if(is.null(y)) y <- 1

  str_loc <- set_grid(latitude, longitude, x, y, size)

  str_att <- if(!is.null(attribute)) paste0("&", paste("attribute", attribute, sep = "=", collapse = "&"))

  str_date <- if(!is.null(date)) {

    paste0("&", sapply(1:dim(date)[1], function(i) {
      paste(colnames(date), date[i,, drop = TRUE], sep = "=", collapse = "&")
    }))

  } else {
    paste0("&", paste(c("startDate", "endDate"), set_date(as.character(Sys.Date())), sep = "=", collapse = "&"))
  }

  str_gdd <- if(!is.null(gdd_method)) paste0("&", paste(names(gdd_method), gdd_method, sep = "=", collapse = "&"))

  str_p2 <- paste0(str_att, str_date, str_gdd)

  query <- unlist(as.list(outer(str_loc, str_p2, paste0)))

  structure(query, class = "query")
}