R/qm_preview.R

In qualmap: Opinionated Approach for Digitizing Semi-Structured Qualitative GIS Data

#' Preview Input
#'
#' @description This function renders the input vector as a polygon shapefile using the leaflet package.
#'
#' @usage qm_preview(ref, key, value)
#'
#' @param ref An \code{sf} object that serves as a master list of features
#' @param key Name of geographic id variable in the \code{ref} object to match input values to
#' @param value A vector of input values created with \code{qm_define}
#'
#' @return An interactive leaflet map with the features from the defined vector specified in \code{value}
#'     highlighted in red.
#'
#' @seealso \code{qm_define}
#'
#' @examples
#' \dontrun{
#' # load and format reference data
#' stl <- stLouis
#' stl <- dplyr::mutate(stl, TRACTCE = as.numeric(TRACTCE))
#'
#' # create cluster
#' cluster <- qm_define(118600, 119101, 119300)
#'
#' # preview cluster
#' qm_preview(ref = stl, key = TRACTCE, value = cluster)
#' }
#'
#' @import sf
#' @importFrom dplyr %>%
#' @importFrom dplyr left_join
#' @importFrom dplyr mutate
#' @importFrom dplyr rename
#' @importFrom grDevices colorRamp
#' @importFrom leaflet addPolygons
#' @importFrom leaflet addProviderTiles
#' @importFrom leaflet colorBin
#' @importFrom leaflet leaflet
#' @importFrom rlang :=
#' @importFrom sf st_transform
#'
#' @export
qm_preview <- function(ref, key, value){

  # define undefined global variables as NULL
  COUNT = is = NULL

  # save parameters to list
  paramList <- as.list(match.call())

  # check for missing parameters - ref
  if (missing(ref)) {
    stop('A reference, consisting of a simple features object, must be specified.')
  }

  # check class of reference object
  classList <- class(ref)
  classListElement1 <- classList[1]

  if (classListElement1 != "sf"){
    stop("The reference object must be a simple features object.")
  }

  # check for missing parameters - key
  if (missing(key)) {
    stop('A key identification variable must be specified.')
  }

  # check for missing parameters - value
  if (missing(value)) {
    stop('A vector containing feature ids must be specified.')
  }

  # quote input variables - key
  if (!is.character(paramList$key)) {
    keyVar <- rlang::enquo(key)
  } else if (is.character(paramList$key)) {
    keyVar <- rlang::quo(!! rlang::sym(key))
  }

  keyVarQ <- rlang::quo_name(rlang::enquo(key))

  # validate data
  valid <- tryCatch(qm_validate(ref = ref, key = (!!keyVar), value = value), error = function(e) e, warning = function(w) w)

  if(is(valid, "error") == TRUE) {
    stop("Error in data validation: Use qualmap::qm_validate() to diagnose the problem.")
  } else if (valid == FALSE) {
    stop("Error in data validation: Use qualmap::qm_validate() to diagnose the problem.")
  }

  # convert vector to temporary data frame
  value_df <- as.data.frame(value)

  # prepare temporary data frame for mapping
  value_df %>%
    dplyr::rename(!!keyVarQ := value) %>%
    dplyr::mutate(COUNT = 1) -> value_df

  # join temp data frame to reference data
  result <- dplyr::left_join(ref, value_df, by = keyVarQ)

  # add 0 values to COUNT if NA
  result <- dplyr::mutate(result, COUNT = ifelse(is.na(COUNT) == TRUE, 0, COUNT))

  # transform data to WGS 84
  result <- sf::st_transform(result, 4326)

  # set leaflet variables
  bins <- c(0, 1)
  pal <- leaflet::colorBin(colorRamp(c("#808080", "#ff4e4e")), domain = result$COUNT)
  tiles <- leaflet::providers$CartoDB.Positron

  # create map
  leaflet::leaflet(result) %>%
    leaflet::addProviderTiles(tiles) %>%
    leaflet::addPolygons(fillColor = ~pal(COUNT),
                            weight = 2,
                            opacity = 1,
                            color = "white",
                            dashArray = "3",
                            fillOpacity = 0.7)
}