Skip to content

Commit

Permalink
gradient scale
Browse files Browse the repository at this point in the history
  • Loading branch information
@pvictor
pvictor committed May 26, 2018
1 parent 2078762 commit 6ecc4fb
Show file tree
Hide file tree
Showing 11 changed files with 592 additions and 244 deletions.
8 changes: 7 additions & 1 deletion NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,9 @@

export("%>%")
export(add_click)
export(add_continuous_scale)
export(add_continuous_breaks)
export(add_continuous_gradient)
export(add_continuous_gradient2)
export(add_discrete_scale)
export(add_discrete_scale2)
export(add_labs)
Expand All @@ -21,6 +23,10 @@ importFrom(magrittr,"%>%")
importFrom(r2d3,r2d3)
importFrom(scales,brewer_pal)
importFrom(scales,col_numeric)
importFrom(scales,div_gradient_pal)
importFrom(scales,muted)
importFrom(scales,rescale)
importFrom(scales,seq_gradient_pal)
importFrom(scales,viridis_pal)
importFrom(stats,model.frame)
importFrom(utils,modifyList)
Expand Down
228 changes: 4 additions & 224 deletions R/r2d3maps.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,10 @@
#'
d3_map <- function(shape, projection = "Mercator", width = NULL, height = NULL) {

projection <- match.arg(arg = projection, choices = c("Mercator", "Albers", "ConicEqualArea", "NaturalEarth"))
projection <- match.arg(
arg = projection,
choices = c("Mercator", "Albers", "ConicEqualArea", "NaturalEarth")
)

# convert to geojson
suppressWarnings({
Expand Down Expand Up @@ -126,232 +129,9 @@ add_labs <- function(map, title = NULL, caption = NULL) {



#' Add continuous scale to a map
#'
#' @param map A \code{r2d3map} \code{htmlwidget} object.
#' @param var Variable to map.
#' @param palette Color palette, you can use Viridis or Brewer color palette.
#' @param direction Sets the order of colors in the scale.
#' If 1, the default, colors are ordered from darkest to lightest.
#' If -1, the order of colors is reversed.
#' @param n_breaks Number of breaks to cut data (depending on \code{style}, number of breaks can be re-computed).
#' @param style Style for computing breaks, see \code{\link[classInt]{classIntervals}}.
#'
#' @export
#'
#' @importFrom scales col_numeric viridis_pal
#' @importFrom utils type.convert
#' @importFrom classInt classIntervals
#'
#' @examples
#' library( r2d3maps )
#' library( rnaturalearth )
#'
#' # data
#' tunisia <- ne_states(country = "tunisia", returnclass = "sf")
#'
#' # fake percentage
#' tunisia$p <- sample.int(100, nrow(tunisia))
#'
#' # fake continuous var
#' tunisia$foo <- sample.int(1e5, nrow(tunisia))
#'
#'
#' # Tunisia
#' d3_map(shape = tunisia) %>%
#' add_continuous_scale(var = "p")
#'
#' # different color palette
#' d3_map(shape = tunisia) %>%
#' add_continuous_scale(var = "p", palette = "Greens")
#'
#' # legend
#' d3_map(shape = tunisia) %>%
#' add_continuous_scale(var = "p",
#' palette = "inferno",
#' direction = -1) %>%
#' add_legend(title = "Percentage", suffix = "%")
#'
#'
#'
#' # different style of breaks
#'
#' # equal
#' d3_map(shape = tunisia) %>%
#' add_continuous_scale(var = "foo",
#' palette = "inferno",
#' direction = -1,
#' style = "equal") %>%
#' add_legend(title = "foo", d3_format = ".0f")
#'
#' # quantile
#' d3_map(shape = tunisia) %>%
#' add_continuous_scale(var = "foo",
#' palette = "inferno",
#' direction = -1,
#' style = "quantile") %>%
#' add_legend(title = "foo", d3_format = ".0f")
#'
#' # pretty
#' d3_map(shape = tunisia) %>%
#' add_continuous_scale(var = "foo",
#' palette = "inferno",
#' direction = -1,
#' style = "pretty") %>%
#' add_legend(title = "foo", d3_format = ".0f")
add_continuous_scale <- function(map, var, palette = "viridis", direction = 1,
n_breaks = 5, style = "pretty") {
palette <- match.arg(
arg = palette,
choices = c("viridis", "magma", "plasma", "inferno", "cividis",
"Blues", "BuGn", "BuPu", "GnBu", "Greens",
"Greys", "Oranges", "OrRd", "PuBu", "PuBuGn", "PuRd", "Purples",
"RdPu", "Reds", "YlGn", "YlGnBu", "YlOrBr", "YlOrRd")
)
if (is.null(map$x$options$data))
stop("No data !", call. = FALSE)
var_ <- map$x$options$data[[var]]
if (is.null(var_))
stop("Invalid variable supplied to continuous scale !", call. = FALSE)

if (is.character(var_))
var_ <- type.convert(var_)
if (!is.numeric(var_))
stop("'var' must be a numeric vector!", call. = FALSE)
range_col <- classIntervals(var = var_, n = n_breaks, style = style)$brks
n_breaks <- length(range_col) - 1
if (palette %in% c("viridis", "magma", "plasma", "inferno", "cividis")) {
colors <- viridis_pal(option = palette, direction = direction)(n_breaks)
colors <- substr(colors, 1, 7)
} else {
pal <- col_numeric(palette = palette, domain = 0:100, na.color = "#808080")
colors <- pal(seq(from = 20, to = 100, length.out = n_breaks + 1))
if (direction > 0) {
colors <- rev(colors)
}
}
.r2d3map_opt(
map = map, name = "colors",
color_type = "continuous",
color_var = var,
range_var = c(0, max(var_, na.rm = TRUE)),
range_col = range_col,
colors = c("#fafafa", colors)
)
}




#' Add discrete scale to a map
#'
#' Display a discrete value on a map. \code{add_discrete_scale} is for using a color palette,
#' \code{add_discrete_scale2} is to attach custom colors to data levels.
#'
#' @param map A \code{r2d3map} \code{htmlwidget} object.
#' @param var Variable to map
#' @param palette Color palette, you can use Viridis or Brewer color palette.
#' @param direction Sets the order of colors in the scale.
#' If 1, the default, colors are ordered from darkest to lightest.
#' If -1, the order of colors is reversed.
#' @param na.color Color to use for missing values.
#'
#' @export
#'
#' @name discrete-scale
#'
#' @importFrom scales brewer_pal viridis_pal
#'
#' @examples
#' library( r2d3maps )
#' library( rnaturalearth )
#'
#' # data
#' japan <- ne_states(country = "japan", returnclass = "sf")
#'
#' # Japan's regions
#' d3_map(shape = japan) %>%
#' add_discrete_scale(var = "region")
#'
#' # different color palette
#' d3_map(shape = japan) %>%
#' add_discrete_scale(var = "region", palette = "Set2")
#'
#' # custom colors
#' d3_map(shape = japan) %>%
#' add_discrete_scale2(
#' var = "region",
#' values = list(
#' "Chugoku" = "#000080",
#' "Kyushu" = "#6B8E23",
#' "Shikoku" = "#DDA0DD",
#' "Chubu" = "#4169E1",
#' "Kinki" = "#2E8B57",
#' "Hokkaido" = "#4682B4",
#' "Kanto" = "#FFA07A",
#' "Tohoku" = "#F08080",
#' "Okinawa" = "red"
#' ),
#' na.color = "#000"
#' )
#'
#' # with legend
#' d3_map(shape = japan) %>%
#' add_discrete_scale(var = "region", palette = "Set1") %>%
#' add_legend(title = "County")
#'
add_discrete_scale <- function(map, var, palette = "viridis", direction = 1, na.color = "#D8D8D8") {
if (is.null(map$x$options$data))
stop("No data !", call. = FALSE)
var_ <- map$x$options$data[[var]]
if (is.null(var_))
stop("Invalid variable supplied to continuous scale !", call. = FALSE)
values <- if (is.factor(var_)) levels(var_) else unique(var_[!is.na(var_)])
na <- anyNA(var_)
n <- length(values)
if (palette %in% c("viridis", "magma", "plasma", "inferno", "cividis")) {
colors <- viridis_pal(option = palette, direction = direction)(n)
colors <- substr(colors, 1, 7)
} else {
colors <- brewer_pal(palette = palette, direction = direction)(n)
}
.r2d3map_opt(
map = map, name = "colors",
color_type = "discrete",
color_var = var,
values = values,
colors = if (na) c(colors, na.color) else colors
)
}

#' @param values Named list mapping data values to colors.
#' It's recommended to use Hex color code without alpha,
#' e.g. \code{#} followed by 6 chars \code{[0-9a-f]}.
#'
#' @export
#'
#' @rdname discrete-scale
add_discrete_scale2 <- function(map, var, values, na.color = "#D8D8D8") {
if (is.null(map$x$options$data))
stop("No data !", call. = FALSE)
var_ <- map$x$options$data[[var]]
if (is.null(var_))
stop("Invalid variable supplied to continuous scale !", call. = FALSE)
na <- anyNA(var_)
colors <- unlist(values, use.names = FALSE)
values <- names(values)
if (is.null(values)) {
values <- if (is.factor(var_)) levels(var_) else unique(var_[!is.na(var_)])
}
.r2d3map_opt(
map = map, name = "colors",
color_type = "discrete",
color_var = var,
values = values,
colors = if (na) c(colors, na.color) else colors
)
}


#' Add a tooltip on a map
#'
Expand Down
Loading

0 comments on commit 6ecc4fb

Please sign in to comment.