protomapr/R/palette.R

#' Apply Color Palette to Land Use Categories
#'
#' @description
#' Maps colors from a palette to land use categories, enabling use of
#' viridis, RColorBrewer, and other R color palettes with Protomaps.
#'
#' @param palette Character vector of colors, or a function that generates colors.
#'   Can be output from viridis::viridis(), RColorBrewer::brewer.pal(), etc.
#' @param categories Character vector of category names to map colors to.
#'   Default maps to common land use types: water, park, wood, residential,
#'   commercial, industrial.
#' @param n Integer. Number of colors to generate if palette is a function.
#'   Default is NULL (uses length of categories).
#' @param background Character. Background/default color for unassigned categories.
#'   Default is "#f8f8f8".
#'
#' @return A list of color mappings suitable for pmColors() or addProtomaps(colors=).
#'
#' @examples
#' \dontrun{
#' library(leaflet)
#' library(protomapr)
#'
#' # Using viridis palette for land use
#' if (requireNamespace("viridisLite", quietly = TRUE)) {
#'   colors <- pmPalette(viridisLite::viridis(6))
#'   leaflet() %>%
#'     setView(lng = -122.4, lat = 37.8, zoom = 12) %>%
#'     addProtomaps(url = protomaps_url(), colors = colors)
#' }
#'
#' # Using RColorBrewer
#' if (requireNamespace("RColorBrewer", quietly = TRUE)) {
#'   colors <- pmPalette(RColorBrewer::brewer.pal(6, "Set2"))
#'   leaflet() %>%
#'     setView(lng = -122.4, lat = 37.8, zoom = 12) %>%
#'     addProtomaps(url = protomaps_url(), colors = colors)
#' }
#'
#' # Custom category mapping
#' colors <- pmPalette(
#'   c("#264653", "#2a9d8f", "#e9c46a", "#f4a261", "#e76f51"),
#'   categories = c("water", "park", "sand", "buildings", "highway")
#' )
#' }
#'
#' @seealso \code{\link{pmPaletteStyle}}, \code{\link{pmColors}}
#' @export
pmPalette <- function(palette,
                      categories = NULL,
                      n = NULL,
                      background = "#f8f8f8") {

  if (is.null(categories)) {
    categories <- c("water", "park", "wood", "residential",
                    "commercial", "industrial")
  }

  if (is.function(palette)) {
    n_colors <- n %||% length(categories)
    colors <- palette(n_colors)
  } else {
    colors <- palette
  }

  if (length(colors) < length(categories)) {
    colors <- rep_len(colors, length(categories))
  }

  result <- list(background = background, earth = background)

  category_mapping <- list(
    water = "water",
    park = c("park_a", "park_b"),
    wood = c("wood_a", "wood_b"),
    forest = c("wood_a", "wood_b"),
    residential = "pedestrian",
    commercial = "other",
    industrial = "industrial",
    hospital = "hospital",
    school = "school",
    beach = "beach",
    sand = "sand",
    buildings = "buildings",
    highway = "highway",
    roads = c("highway", "major", "medium", "minor"),
    railway = "railway"
  )

  for (i in seq_along(categories)) {
    cat_name <- categories[i]
    color <- colors[i]

    if (cat_name %in% names(category_mapping)) {
      props <- category_mapping[[cat_name]]
      for (prop in props) {
        result[[prop]] <- color
      }
    } else {
      result[[cat_name]] <- color
    }
  }

  result
}


#' Create a Themed Palette Style
#'
#' @description
#' Creates a complete pm_style using a color palette. Combines pmPalette()
#' with styling for a consistent look.
#'
#' @param palette Character vector of colors or palette function.
#' @param water_color Character. Color for water features. If NULL, uses
#'   first color from palette.
#' @param land_color Character. Color for land/background. Default is "#f8f8f8".
#' @param labels Logical. Whether to include city labels. Default is TRUE.
#' @param label_color Character. Color for labels. Default is "#333333".
#'
#' @return A pm_style object.
#'
#' @examples
#' \dontrun{
#' library(leaflet)
#' library(protomapr)
#'
#' # Viridis-themed map
#' if (requireNamespace("viridisLite", quietly = TRUE)) {
#'   style <- pmPaletteStyle(viridisLite::viridis(5, option = "D"))
#'   leaflet() %>%
#'     setView(lng = -122.4, lat = 37.8, zoom = 12) %>%
#'     addProtomaps(url = protomaps_url(), style = style)
#' }
#'
#' # Custom palette
#' style <- pmPaletteStyle(
#'   c("#264653", "#2a9d8f", "#e9c46a", "#f4a261", "#e76f51"),
#'   water_color = "#264653"
#' )
#' }
#'
#' @seealso \code{\link{pmPalette}}, \code{\link{pmStyle}}
#' @export
pmPaletteStyle <- function(palette,
                           water_color = NULL,
                           land_color = "#f8f8f8",
                           labels = TRUE,
                           label_color = "#333333") {

  if (is.function(palette)) {
    colors <- palette(5)
  } else {
    colors <- palette
  }

  water <- water_color %||% colors[1]

  base_colors <- pmPalette(colors, background = land_color)
  base_colors$water <- water
  base_colors$earth <- land_color
  base_colors$background <- land_color

  labelRules <- list()
  if (labels) {
    labelRules <- list(
      pmLabelRule("places", pmCenteredTextSymbolizer(
        font = "500 12px sans-serif",
        fill = label_color,
        stroke = land_color,
        width = 2
      ), filter = "feature.props.kind === 'locality' && feature.props.min_zoom <= 6")
    )
  }

  structure(
    list(colors = base_colors, labelRules = labelRules),
    class = "pm_style"
  )
}