#' 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" ) }