R/plot_layers.R

In pfrater/arcpullr: Pull Data from an 'ArcGIS REST' API

#' Plot a spatial layer
#'
#' This function plots a spatial layer as returned from
#' \code{\link{get_spatial_layer}}.
#'
#' @param x An sf or Raster* object as returned from a
#' \code{get_*_layer} function
#' @param outline_poly Optional. An sf polygon to outline \code{sf_data} for
#' context
#' @param outline_size Numeric argument that controls width of parameter
#' @param outline_color A character vector of a valid color
#' @param plot_pkg Character. The plotting environment to use. Either "ggplot"
#' (default) or "base"
#' @param ... Additional arguments to \code{plot_layer}
#'
#' @return Either a \code{ggplot} object, or simply plots \code{x} if
#' \code{plot_pkg = "base"}
#' @export
#'
#' @name plot_layer
#'
#' @examples
#' \dontrun{
#' plot_layer(iceland_poly)
#' plot_layer(portage_county, outline_poly = wis_poly)
#' }
setGeneric("plot_layer", function(x, ...) standardGeneric("plot_layer"))

setOldClass("sf")

#' @export
plot_layer <- function(x, ...) {
  UseMethod("plot_layer", x)
}

#' @rdname plot_layer
#' @export
plot_layer.sf <- function(x,
                          outline_poly = NULL,
                          outline_size = 1.2,
                          outline_color = "gray30",
                          plot_pkg = "ggplot",
                          ...) {
  if (plot_pkg == "base") {
    if (is.null(outline_poly)) {
      graphics::plot(x$geom, ...)
    } else {
      graphics::plot(
        outline_poly$geom,
        col = "transparent",
        lwd = outline_size,
        border = outline_color,
        ...)
      graphics::plot(
        x$geom, add = TRUE,
        ...) |> suppressWarnings()
    }
  } else if (plot_pkg %in% c("ggplot", "ggplot2")) {
    g <- ggplot2::ggplot(data = NULL)
    g <- g + ggplot2::geom_sf(data = x)
    if (!is.null(outline_poly)) {
      g <-
        g +
        ggplot2::geom_sf(data = outline_poly,
                         fill = ggplot2::alpha(0.01),
                         size = outline_size,
                         color = outline_color)
    }
    g <- g + ggplot2::theme_bw()
    return(g)
  } else {
    stop("This function only set up to work with base plotting or ggplot")
  }
}

#' Plot a SpatRaster object
#'
#' @inheritParams plot_layer
#'
#' @export
#'
#' @examples
#' \dontrun{
#' wi_aerial <- get_map_layer(wi_leaf_off_url, wis_poly)
#' plot_layer(wi_aerial, outline_poly = wis_poly)
#' }
setMethod("plot_layer", "SpatRaster", function(x,
                                               outline_poly = NULL,
                                               outline_size = 1.2,
                                               outline_color = "gray30",
                                               plot_pkg = "ggplot",
                                               ...) {
  if (plot_pkg == "base") {
    if (is.null(outline_poly)) {
      terra::plotRGB(x, colNA = NA, ...)
    } else {
      terra::plotRGB(x, ...)
      graphics::plot(
        outline_poly,
        add = TRUE,
        col = "transparent",
        lwd = outline_size,
        border = outline_color,
        ...
      ) |> suppressWarnings()
    }
  } else if (plot_pkg %in% c("ggplot", "ggplot2")) {
    plot_data <- terra::as.data.frame(x, xy = TRUE)
    if (ncol(plot_data) == 3) {
      plot_data <- setNames(plot_data, c("x", "y", "value"))
    } else {
      plot_data <-
        plot_data |>
        setNames(c("x", "y", "red", "green", "blue")) |>
        dplyr::filter(!dplyr::if_any(
          c(.data$red, .data$green, .data$blue),
          is.na
        )) |>
        dplyr::mutate(
          color = grDevices::rgb(
            .data$red, .data$green, .data$blue,
            maxColorValue = 255
          )
        )
    }
    if (!is.null(attr(x, "legend"))) {
      plot_data <-
        plot_data |>
        dplyr::left_join(attr(x, "legend"), by = "value")
      legend <- attr(x, "legend")
      legend_vals <- legend$color
      names(legend_vals) <- legend$name
      plot_data <- dplyr::filter(plot_data, .data$color != "#000000")
    }
    if (!is.null(attr(x, "legend"))) {
      g <-
        ggplot2::ggplot(data = NULL) +
        ggplot2::geom_raster(
          data = plot_data,
          ggplot2::aes(x = .data$x, y = .data$y, fill = factor(.data$name))
        ) +
        ggplot2::scale_fill_manual(
          name = "Legend",
          values = legend_vals
        )
    } else if ("color" %in% names(plot_data)) {
      g <-
        ggplot2::ggplot(data = NULL) +
        ggplot2::geom_raster(
          data = plot_data,
          ggplot2::aes(x = .data$x, y = .data$y, fill = .data$color),
          show.legend = FALSE
        ) +
        ggplot2::scale_fill_identity()
    } else {
      g <-
        ggplot2::ggplot(data = NULL) +
        ggplot2::geom_raster(
          data = plot_data,
          ggplot2::aes(x = .data$x, y = .data$y)
        )
    }
    if (!is.null(outline_poly)) {
      g <-
        g +
        ggplot2::geom_sf(
          data = outline_poly,
          fill = ggplot2::alpha(0.01),
          size = outline_size,
          color = outline_color
        )
    }
    x_crs <- terra::crs(x)
    g <- g + ggplot2::coord_sf(crs = x_crs)
    if (requireNamespace("cowplot", quietly = TRUE)) {
      g <- g + cowplot::theme_map()
    } else {
      g <- g + ggplot2::theme_minimal()
    }
    if (!is.null(attr(x, "legend"))) {
      g <-
        g +
        ggplot2::theme(
          legend.text = ggplot2::element_text(size = 10),
          legend.title = ggplot2::element_text(size = 14)
        )
    }
    return(g)
  } else {
    stop("This function only set up to work with base plotting or ggplot")
  }
})

#' Plot a RasterLayer object
#'
#' @inheritParams plot_layer
#' @param legend Logical. Only valid when plotting RasterLayers
#' retrieved from \code{\link{get_map_layer}} where legend was also retrieved
#'
#' @export
#'
#' @examples
#' \dontrun{
#' wi_landcover <- get_map_layer(wi_landcover_url, wis_poly)
#' plot_layer(wi_landcover, outline_poly = wis_poly)
#' }
setMethod("plot_layer", "RasterLayer", function(x,
                                                outline_poly = NULL,
                                                outline_size = 1.2,
                                                outline_color = "gray30",
                                                legend = TRUE,
                                                plot_pkg = "ggplot",
                                                ...) {
  if (plot_pkg == "base") {
    if (is.null(outline_poly)) {
      raster::plot(x, ...)
    } else {
      raster::plot(x, ...)
      graphics::plot(
        outline_poly,
        add = TRUE,
        col = "transparent",
        lwd = outline_size,
        border = outline_color,
        ...
      ) |> suppressWarnings()
    }
  } else if (plot_pkg %in% c("ggplot", "ggplot2")) {
    plot_data <- raster_colors(x)
    plot_data <-
      plot_data |>
      dplyr::filter(.data$color != "#000000", !is.na(.data$color))
    g <-
      ggplot2::ggplot(data = NULL) +
      ggplot2::geom_tile(data = plot_data,
                         ggplot2::aes_string("x", "y", fill = "color"))
    if (!is.null(outline_poly)) {
      g <-
        g +
        ggplot2::geom_sf(data = outline_poly,
                         fill = ggplot2::alpha(0.01),
                         size = outline_size,
                         color = outline_color)
    }
    # check to see if legend should be implemented
    if (legend && ("name" %in% names(plot_data))) {
      g <-
        g +
        ggplot2::scale_fill_identity(
          "Legend",
          guide = "legend",
          labels = plot_data$name,
          breaks = plot_data$color
        )
    } else {
      g <- g + ggplot2::scale_fill_identity()
    }
    x_crs <- raster::crs(x)
    g <- g + ggplot2::coord_sf(crs = x_crs)
    if (requireNamespace("cowplot", quietly = TRUE)) {
      g <- g + cowplot::theme_map()
    } else {
      g <- g + ggplot2::theme_minimal()
    }
    return(g)
  } else {
    stop("This function only set up to work with base plotting or ggplot")
  }
})

#' Plot a RasterStack object
#'
#' @inheritParams plot_layer
#'
#' @export
#'
#' @examples
#' \dontrun{
#' wi_aerial <- get_map_layer(wi_leaf_off_url, wis_poly)
#' plot_layer(wi_aerial, outline_poly = wis_poly)
#' }
setMethod("plot_layer", "RasterStack", function(x,
                                                outline_poly = NULL,
                                                outline_size = 1.2,
                                                outline_color = "gray30",
                                                plot_pkg = "ggplot",
                                                ...) {
  if (plot_pkg == "base") {
    if (is.null(outline_poly)) {
      raster::plotRGB(x, colNA = NA, ...)
    } else {
      raster::plotRGB(x, ...)
      graphics::plot(
        outline_poly,
        add = TRUE,
        col = "transparent",
        lwd = outline_size,
        border = outline_color,
        ...
      ) |> suppressWarnings()
    }
  } else if (plot_pkg %in% c("ggplot", "ggplot2")) {
    plot_data <- raster_colors(x)
    plot_data <- dplyr::filter(plot_data, .data$color != "#000000")
    g <-
      ggplot2::ggplot(data = NULL) +
      ggplot2::geom_tile(data = plot_data,
                         ggplot2::aes_string("x", "y",
                                             fill = as.character("color")))
    if (!is.null(outline_poly)) {
      g <-
        g +
        ggplot2::geom_sf(data = outline_poly,
                         fill = ggplot2::alpha(0.01),
                         size = outline_size,
                         color = outline_color)
    }
    x_crs <- raster::crs(x)
    g <- g + ggplot2::scale_fill_identity() + ggplot2::coord_sf(crs = x_crs)
    if (requireNamespace("cowplot", quietly = TRUE)) {
      g <- g + cowplot::theme_map()
    } else {
      g <- g + ggplot2::theme_minimal()
    }
    return(g)
  } else {
    stop("This function only set up to work with base plotting or ggplot")
  }
})


#' Plot a RasterBrick object
#'
#' @inheritParams plot_layer
#'
#' @export
#'
#' @examples
#' \dontrun{
#' wi_aerial <- get_map_layer(wi_leaf_off_url, wis_poly)
#' plot_layer(wi_aerial, outline_poly = wis_poly)
#' }
setMethod("plot_layer", "RasterBrick", function(x,
                                                outline_poly = NULL,
                                                outline_size = 1.2,
                                                outline_color = "gray30",
                                                plot_pkg = "ggplot",
                                                ...) {
  if (plot_pkg == "base") {
    if (is.null(outline_poly)) {
      raster::plotRGB(x, colNA = NA, ...)
    } else {
      raster::plotRGB(x, ...)
      graphics::plot(
        outline_poly,
        add = TRUE,
        col = "transparent",
        lwd = outline_size,
        border = outline_color,
        ...
      ) |> suppressWarnings()
    }
  } else if (plot_pkg %in% c("ggplot", "ggplot2")) {
    plot_data <- raster_colors(x)
    plot_data <- dplyr::filter(plot_data, .data$color != "#000000")
    g <-
      ggplot2::ggplot(data = NULL) +
      ggplot2::geom_tile(data = plot_data,
                         ggplot2::aes_string("x", "y",
                                             fill = as.character("color")))
    if (!is.null(outline_poly)) {
      g <-
        g +
        ggplot2::geom_sf(data = outline_poly,
                         fill = ggplot2::alpha(0.01),
                         size = outline_size,
                         color = outline_color)
    }
    x_crs <- raster::crs(x)
    g <- g + ggplot2::scale_fill_identity() + ggplot2::coord_sf(crs = x_crs)
    if (requireNamespace("cowplot", quietly = TRUE)) {
      g <- g + cowplot::theme_map()
    } else {
      g <- g + ggplot2::theme_minimal()
    }
    return(g)
  } else {
    stop("This function only set up to work with base plotting or ggplot")
  }
})



#' Plot an sf object
#'
#' @inheritParams plot_layer
#'
#' @export
#'
#' @examples
#' \dontrun{
#' plot_layer(wis_poly)
#' }
setMethod("plot_layer", "sf", plot_layer.sf)