├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── R ├── data.R ├── guide_colourbox.R ├── guide_colourfan.R ├── multiscales.R ├── pal_bivariate.R ├── pal_hue_sat.R ├── pal_vsup.R ├── range_bivariate.R ├── scale_bivariate.R ├── utilities_ggplot2.R └── zip.R ├── README.Rmd ├── README.md ├── data-raw ├── FL-house-values.R └── US_polling │ ├── US_polling.R │ ├── electoral_votes.csv │ └── polling.csv ├── data ├── FL_house_values.rda ├── US_polling.rda └── US_polling_cartogram.rda ├── man ├── FL_house_values.Rd ├── US_polling.Rd ├── bivariate_range.Rd ├── bivariate_scale.Rd ├── figures │ ├── README-unnamed-chunk-2-1.png │ └── README-unnamed-chunk-3-1.png ├── guide_colourbox.Rd ├── guide_colourfan.Rd ├── multiscales.Rd ├── pal_bivariate_carto.Rd ├── pal_hue_sat.Rd ├── pal_vsup.Rd ├── pal_vsup_carto.Rd ├── pal_vsup_viridis.Rd ├── train_bivariate.Rd └── zip.Rd └── multiscales.Rproj /.Rbuildignore: -------------------------------------------------------------------------------- 1 | visual_test 2 | ^data-raw$ 3 | ^.*\.Rproj$ 4 | ^\.Rproj\.user$ 5 | ^\.travis\.yml$ 6 | ^\.codecov\.yml$ 7 | ^README\.Rmd$ 8 | ^cran-comments.md$ 9 | ^ISSUE_TEMPLATE\.md$ 10 | ^TODO\.Rmd$ 11 | ^revdep$ 12 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # Example code in package build process 9 | *-Ex.R 10 | 11 | # Output files from R CMD build 12 | /*.tar.gz 13 | 14 | # Output files from R CMD check 15 | /*.Rcheck/ 16 | 17 | # RStudio files 18 | .Rproj.user/ 19 | 20 | # produced vignettes 21 | vignettes/*.html 22 | vignettes/*.pdf 23 | 24 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 25 | .httr-oauth 26 | 27 | # knitr and R markdown default cache directories 28 | /*_cache/ 29 | /cache/ 30 | 31 | # Temporary files created by R markdown 32 | *.utf8.md 33 | *.knit.md 34 | 35 | # Shiny token, see https://shiny.rstudio.com/articles/shinyapps.html 36 | rsconnect/ 37 | .Rproj.user 38 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: multiscales 2 | Type: Package 3 | Title: Multivariate scales for 'ggplot2' 4 | Version: 0.1.0 5 | Authors@R: c( 6 | person("Claus O.", "Wilke", , "wilke@austin.utexas.edu", c("cre", "aut"))) 7 | Description: Multivariate scales for 'ggplot2'. 8 | URL: https://github.com/clauswilke/multiscales 9 | Depends: 10 | R (>= 3.2) 11 | Imports: 12 | colorspace, 13 | digest, 14 | grid, 15 | gtable, 16 | ggplot2 (>= 2.2.1), 17 | purrr, 18 | plyr, 19 | rlang, 20 | tibble, 21 | scales, 22 | viridisLite, 23 | withr (>= 2.1.1) 24 | License: MIT + file LICENSE 25 | LazyData: true 26 | Suggests: 27 | dplyr, 28 | MASS, 29 | knitr, 30 | rmarkdown, 31 | testthat, 32 | vdiffr 33 | VignetteBuilder: knitr 34 | Collate: 35 | 'data.R' 36 | 'guide_colourbox.R' 37 | 'guide_colourfan.R' 38 | 'multiscales.R' 39 | 'pal_bivariate.R' 40 | 'pal_hue_sat.R' 41 | 'pal_vsup.R' 42 | 'range_bivariate.R' 43 | 'scale_bivariate.R' 44 | 'utilities_ggplot2.R' 45 | 'zip.R' 46 | RoxygenNote: 6.0.1.9000 47 | Roxygen: list(markdown = TRUE) 48 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2018 2 | COPYRIGHT HOLDER: Claus O. Wilke 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2018 Claus O. Wilke 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(guide_gengrob,colourbox) 4 | S3method(guide_gengrob,colourfan) 5 | S3method(guide_geom,colourbox) 6 | S3method(guide_geom,colourfan) 7 | S3method(guide_merge,colourbox) 8 | S3method(guide_merge,colourfan) 9 | S3method(guide_train,colourbox) 10 | S3method(guide_train,colourfan) 11 | export(RangeBivariate) 12 | export(ScaleBivariate) 13 | export(bivariate_range) 14 | export(bivariate_scale) 15 | export(guide_colorbox) 16 | export(guide_colorfan) 17 | export(guide_colourbox) 18 | export(guide_colourfan) 19 | export(pal_bivariate_carto) 20 | export(pal_hue_sat) 21 | export(pal_vsup) 22 | export(pal_vsup_carto) 23 | export(pal_vsup_viridis) 24 | export(train_bivariate) 25 | export(zip) 26 | import(ggplot2) 27 | import(grid) 28 | import(gtable) 29 | import(rlang) 30 | import(scales) 31 | import(tibble) 32 | importFrom(purrr,transpose) 33 | -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | #' Median house values Florida counties 2 | #' 3 | #' Median house values in Florida counties, from the 2015 five-year American Community Survey. 4 | #' 5 | #' @examples 6 | #' library(ggplot2) 7 | #' library(colorspace) 8 | #' 9 | #' # B25077_001: Median house value in the past 12 months (in 2015 Inflation-adjusted dollars) 10 | #' 11 | #' # univariate scale 12 | #' ggplot(FL_house_values, aes(fill = estimate)) + 13 | #' geom_sf(color = "gray30", size = 0.2) + 14 | #' coord_sf(xlim = c(-88, -79.8), ylim = c(24.1, 31.2), datum = NA) + 15 | #' scale_fill_continuous_carto( 16 | #' palette = "Sunset", rev = TRUE, 17 | #' name = "median house values", 18 | #' guide = guide_colorbar( 19 | #' direction = "horizontal", 20 | #' label.position = "bottom", 21 | #' title.position = "top", 22 | #' barwidth = grid::unit(2.0, "in") 23 | #' ) 24 | #' ) + 25 | #' theme_void() + 26 | #' theme( 27 | #' legend.title.align = 0.5, 28 | #' legend.text.align = 0.5, 29 | #' legend.justification = c(0, 0), 30 | #' legend.position = c(0.1, 0.3) 31 | #' ) 32 | #' 33 | #' # bivariate value-suppressing uncertainty scale 34 | #' ggplot(FL_house_values, aes(fill = zip(estimate, moe/estimate))) + 35 | #' geom_sf(color = "gray30", size = 0.2) + 36 | #' coord_sf(xlim = c(-88, -79.8), ylim = c(24.1, 31.2), datum = NA) + 37 | #' bivariate_scale( 38 | #' "fill", "bivariate_scale", 39 | #' pal_carto_vsup(palette = "Sunset", rev = TRUE), 40 | #' guide = "colourbox", 41 | #' name = c("median house values", "uncertainty") 42 | #' ) + 43 | #' theme_void() + 44 | #' theme( 45 | #' legend.title.align = 0.5, 46 | #' legend.text.align = 0.5, 47 | #' legend.justification = c(0, 0), 48 | #' legend.position = c(0.15, 0.2) 49 | #' ) 50 | #' 51 | "FL_house_values" 52 | 53 | #' Polling data from the 2016 US presidential election 54 | #' 55 | #' Polling data from the 2016 US presidential election, combined with map of US states. Also provided is an 56 | #' alternative map in cartogram style where each state is scaled in proportion to the number of electoral 57 | #' college votes it has. 58 | #' 59 | #' @source 60 | #' Michael Correll, Dominik Moritz, Jeffrey Heer (2018) Value-Suppressing Uncertainty Palettes. 61 | #' ACM Human Factors in Computing Systems (CHI) 62 | #' \url{https://github.com/uwdata/papers-vsup/tree/master/examples} 63 | "US_polling" 64 | 65 | #' @rdname US_polling 66 | "US_polling_cartogram" 67 | -------------------------------------------------------------------------------- /R/guide_colourbox.R: -------------------------------------------------------------------------------- 1 | #' Colourbox guide 2 | #' 3 | #' @export 4 | guide_colourbox <- function( 5 | 6 | # title 7 | title = waiver(), 8 | title.x.position = "top", 9 | title.y.position = "right", 10 | title.theme = NULL, 11 | title.hjust = NULL, ## can be deleted? 12 | title.vjust = NULL, ## can be deleted? 13 | 14 | # label 15 | label = TRUE, 16 | label.theme = NULL, 17 | 18 | # bar 19 | barwidth = NULL, 20 | barheight = NULL, 21 | nbin = 100, 22 | 23 | # general 24 | reverse = FALSE, 25 | order = 0, 26 | available_aes = c("colour", "color", "fill"), 27 | 28 | ...) { 29 | 30 | if (!is.null(barwidth) && !is.unit(barwidth)) barwidth <- unit(barwidth, default.unit) 31 | if (!is.null(barheight) && !is.unit(barheight)) barheight <- unit(barheight, default.unit) 32 | 33 | structure(list( 34 | # title 35 | title = title, 36 | title.x.position = title.x.position, 37 | title.y.position = title.y.position, 38 | title.theme = title.theme, 39 | title.hjust = title.hjust, 40 | title.vjust = title.vjust, 41 | 42 | # label 43 | label = label, 44 | label.theme = label.theme, 45 | 46 | # bar 47 | barwidth = barwidth, 48 | barheight = barheight, 49 | nbin = nbin, 50 | 51 | # general 52 | reverse = reverse, 53 | order = order, 54 | 55 | # parameter 56 | available_aes = available_aes, 57 | ..., 58 | name = "colourbox"), 59 | class = c("guide", "colourbox") 60 | ) 61 | } 62 | 63 | #' @export 64 | guide_train.colourbox <- function(guide, scale, aesthetic = NULL) { 65 | 66 | # do nothing if scale are inappropriate 67 | if (length(intersect(scale$aesthetics, guide$available_aes)) == 0) { 68 | warning("colorbox guide needs appropriate scales: ", 69 | paste(guide$available_aes, collapse = ", ")) 70 | return(NULL) 71 | } 72 | if (!scale$is_bivariate()) { 73 | warning("colorbox guide needs bivariate scales.") 74 | return(NULL) 75 | } 76 | 77 | # create tick positions and labels 78 | breaks <- scale$get_breaks() 79 | if (length(breaks[[1]]) == 0 && length(breaks[[2]]) == 0 || 80 | all(is.na(breaks[[1]])) && all(is.na(breaks[[2]]))) 81 | return() 82 | labels <- scale$get_labels(breaks) 83 | 84 | guide$ticks1 <- tibble(value = breaks[[1]], label = labels[[1]]) 85 | guide$ticks2 <- tibble(value = breaks[[2]], label = labels[[2]]) 86 | 87 | # needed to make guide show, even if this is not how we keep track of labels and ticks 88 | key <- as.data.frame( 89 | setNames(list(NA), aesthetic %||% scale$aesthetics[1]), 90 | stringsAsFactors = FALSE 91 | ) 92 | guide$key <- key 93 | 94 | # box specification 95 | limits <- scale$get_limits() 96 | v1 <- seq(limits[[1]][1], limits[[1]][2], length = guide$nbin) 97 | if (length(v1) == 0) { 98 | v1 = unique(limits[[1]]) 99 | } 100 | v2 <- seq(limits[[2]][1], limits[[2]][2], length = guide$nbin) 101 | if (length(v2) == 0) { 102 | v2 = unique(limits[[2]]) 103 | } 104 | # box data matrix 105 | guide$box <- expand.grid(x = v1, y = v2) 106 | guide$box$colour <- scale$map(zip(guide$box$x, guide$box$y)) 107 | 108 | # keep track of individual values along x and y also 109 | guide$box.x <- v1 110 | guide$box.y <- v2 111 | 112 | ## need to think about proper implementation 113 | #if (guide$reverse) { 114 | # guide$key <- guide$key[nrow(guide$key):1, ] 115 | # guide$bar <- guide$bar[nrow(guide$bar):1, ] 116 | #} 117 | guide$hash <- with(guide, digest::digest(list(title, ticks1, ticks2, name))) 118 | guide 119 | } 120 | 121 | # simply discards the new guide 122 | #' @export 123 | guide_merge.colourbox <- function(guide, new_guide) { 124 | guide 125 | } 126 | 127 | # this guide is not geom-based. 128 | #' @export 129 | guide_geom.colourbox <- function(guide, layers, default_mapping) { 130 | # Layers that use this guide 131 | guide_layers <- plyr::llply(layers, function(layer) { 132 | matched <- matched_aes(layer, guide, default_mapping) 133 | 134 | if (length(matched) && ((is.na(layer$show.legend) || layer$show.legend))) { 135 | layer 136 | } else { 137 | # This layer does not use this guide 138 | NULL 139 | } 140 | }) 141 | 142 | # Remove this guide if no layer uses it 143 | if (length(plyr::compact(guide_layers)) == 0) guide <- NULL 144 | 145 | guide 146 | } 147 | 148 | #' @export 149 | guide_gengrob.colourbox <- function(guide, theme) { 150 | title.x.position <- guide$title.x.position %||% "top" 151 | title.y.position <- guide$title.y.position %||% "right" 152 | 153 | boxwidth <- width_cm(theme$legend.key.width * 5) 154 | boxheight <- height_cm(theme$legend.key.height * 5) 155 | nbreak <- nrow(guide$key) 156 | 157 | # make the colourbox grob (`grob.box`) 158 | image <- matrix(guide$box$colour, nrow = guide$nbin, ncol = guide$nbin, byrow = TRUE) 159 | grob.box <- rasterGrob( 160 | image = image, width = boxwidth, height = boxheight, default.units = "cm", 161 | gp = gpar(col = NA), interpolate = FALSE 162 | ) 163 | 164 | # make ticks and labels 165 | tick.x.pos <- rescale( 166 | guide$ticks1$value, 167 | c(0.5, guide$nbin - 0.5), 168 | guide$box.x[c(1, length(guide$box.x))] 169 | ) * boxwidth / guide$nbin 170 | label.x.pos <- unit(tick.x.pos, "cm") 171 | 172 | tick.y.pos <- rescale( 173 | guide$ticks2$value, 174 | c(guide$nbin - 0.5, 0.5), 175 | guide$box.y[c(1, length(guide$box.y))] 176 | ) * boxheight / guide$nbin 177 | label.y.pos <- unit(tick.y.pos, "cm") 178 | 179 | # make the label grobs (`grob.label.x` and `grob.label.y`) 180 | 181 | # get the label theme 182 | label.theme <- guide$label.theme %||% calc_element("legend.text", theme) 183 | 184 | # We break inheritance for hjust and vjust, because that's more intuitive here; it still allows manual 185 | # setting of hjust and vjust if desired. The alternative is to ignore hjust and vjust altogether, which 186 | # seems worse 187 | if (is.null(guide$label.theme$hjust) && is.null(theme$legend.text$hjust)) label.theme$hjust <- NULL 188 | if (is.null(guide$label.theme$vjust) && is.null(theme$legend.text$vjust)) label.theme$vjust <- NULL 189 | 190 | # label.theme in param of guide_legend() > theme$legend.text.align > default 191 | hjust <- label.theme$hjust %||% 0.5 192 | vjust <- label.theme$vjust %||% 0.5 193 | 194 | if (!guide$label) # are we drawing labels? 195 | grob.label.x <- NULL 196 | else { 197 | x <- label.x.pos 198 | y <- rep(vjust, length(label.x.pos)) 199 | margin_x <- FALSE 200 | margin_y <- TRUE 201 | 202 | label <- guide$ticks1$label 203 | 204 | # If any of the labels are quoted language objects, convert them 205 | # to expressions. Labels from formatter functions can return these 206 | ## TODO: this should be a separate function to keep the code clean 207 | # maybe scales::parse_format()? 208 | if (any(vapply(label, is.call, logical(1)))) { 209 | label <- lapply( 210 | label, 211 | function(l) { 212 | if (is.call(l)) substitute(expression(x), list(x = l)) 213 | else l 214 | } 215 | ) 216 | label <- do.call(c, label) 217 | } 218 | grob.label.x <- element_grob( 219 | element = label.theme, 220 | label = label, 221 | x = x, 222 | y = y, 223 | hjust = hjust, 224 | vjust = vjust, 225 | margin_x = margin_x, 226 | margin_y = margin_y 227 | ) 228 | grob.label.x <- ggname("guide.label.x", grob.label.x) 229 | } 230 | 231 | label.x.width <- width_cm(grob.label.x) 232 | label.x.height <- height_cm(grob.label.x) 233 | 234 | if (!guide$label) # are we drawing labels? 235 | grob.label.y <- NULL 236 | else { 237 | x <- rep(hjust, length(label.y.pos)) 238 | y <- label.y.pos 239 | margin_x <- TRUE 240 | margin_y <- FALSE 241 | 242 | label <- guide$ticks2$label 243 | 244 | # If any of the labels are quoted language objects, convert them 245 | # to expressions. Labels from formatter functions can return these 246 | ## TODO: this should be a separate function to keep the code clean 247 | # maybe scales::parse_format()? 248 | if (any(vapply(label, is.call, logical(1)))) { 249 | label <- lapply( 250 | label, 251 | function(l) { 252 | if (is.call(l)) substitute(expression(x), list(x = l)) 253 | else l 254 | } 255 | ) 256 | label <- do.call(c, label) 257 | } 258 | grob.label.y <- element_grob( 259 | element = label.theme, 260 | label = label, 261 | x = x, 262 | y = y, 263 | hjust = hjust, 264 | vjust = vjust, 265 | margin_x = margin_x, 266 | margin_y = margin_y 267 | ) 268 | grob.label.y <- ggname("guide.label.y", grob.label.y) 269 | } 270 | 271 | label.y.width <- width_cm(grob.label.y) 272 | label.y.height <- height_cm(grob.label.y) 273 | 274 | # make titles 275 | 276 | # obtain the theme for the legend title. We need this both for the title grob 277 | # and to obtain the title fontsize. 278 | title.theme <- guide$title.theme %||% calc_element("legend.title", theme) 279 | 280 | title.hjust <- guide$title.hjust %||% theme$legend.title.align %||% title.theme$hjust %||% 0 281 | title.vjust <- guide$title.vjust %||% title.theme$vjust %||% 0.5 282 | 283 | # make title grobs if needed 284 | title.x.label <- guide$title[1] 285 | if (is.null(title.x.label) || is.na(title.x.label)) { 286 | title.x.position <- "none" 287 | } else { 288 | grob.title.x <- ggname( 289 | "guide.title.x", 290 | element_grob( 291 | title.theme, 292 | label = title.x.label, 293 | hjust = title.hjust, 294 | vjust = title.vjust, 295 | margin_x = TRUE, 296 | margin_y = TRUE 297 | ) 298 | ) 299 | title.x.width <- width_cm(grob.title.x) 300 | title.x.height <- height_cm(grob.title.x) 301 | } 302 | 303 | title.y.label <- guide$title[2] 304 | if (is.null(title.y.label) || is.na(title.y.label)) { 305 | title.y.position <- "none" 306 | } else { 307 | grob.title.y <- ggname( 308 | "guide.title.y", 309 | element_grob( 310 | title.theme, 311 | label = title.y.label, 312 | hjust = title.hjust, 313 | vjust = title.vjust, 314 | angle = -90, # angle hard-coded for now, needs to be fixed eventually, also further down in `justify_grobs()` 315 | margin_x = TRUE, 316 | margin_y = TRUE 317 | ) 318 | ) 319 | title.y.width <- width_cm(grob.title.y) 320 | title.y.height <- height_cm(grob.title.y) 321 | } 322 | 323 | # gap between keys etc 324 | # the default horizontal and vertical gap need to be the same to avoid strange 325 | # effects for certain guide layouts 326 | title_fontsize <- title.theme$size %||% calc_element("legend.title", theme)$size %||% 0 327 | hgap <- width_cm(theme$legend.spacing.x %||% (0.5 * unit(title_fontsize, "pt"))) 328 | vgap <- height_cm(theme$legend.spacing.y %||% (0.5 * unit(title_fontsize, "pt"))) 329 | 330 | # legend padding 331 | padding <- convertUnit(theme$legend.margin %||% margin(), "cm") 332 | 333 | # we set up the entire legend as an 11x11 table which contains: 334 | # margin, title, gap, labels, ticks, box, ticks, labels, gap, title, margin 335 | # depending on where titles and labels are added, some cells remain empty 336 | 337 | widths <- c(padding[4], 0, 0, 0, 0, boxwidth, 0, 0, 0, 0, padding[2]) 338 | heights <- c(padding[1], 0, 0, 0, 0, boxheight, 0, 0, 0, 0, padding[3]) 339 | 340 | ## TODO: need to figure out where and how to correctly set label sizes 341 | heights[4] <- label.x.height 342 | widths[8] <- label.y.width 343 | 344 | # titles 345 | grob.title.x.top <- NULL 346 | grob.title.x.bottom <- NULL 347 | if (title.x.position %in% c("top", "both")) { 348 | heights[2] <- title.x.height 349 | heights[3] <- vgap 350 | grob.title.x.top <- justify_grobs( 351 | grob.title.x, 352 | hjust = title.hjust, 353 | vjust = title.vjust, 354 | int_angle = title.theme$angle, 355 | debug = title.theme$debug 356 | ) 357 | } 358 | if (title.x.position %in% c("bottom", "both")) { 359 | heights[10] <- title.x.height 360 | heights[9] <- vgap 361 | grob.title.x.bottom <- justify_grobs( 362 | grob.title.x, 363 | hjust = title.hjust, 364 | vjust = title.vjust, 365 | int_angle = title.theme$angle, 366 | debug = title.theme$debug 367 | ) 368 | } 369 | 370 | grob.title.y.left <- NULL 371 | grob.title.y.right <- NULL 372 | if (title.y.position %in% c("left", "both")) { 373 | widths[2] <- title.y.width 374 | widths[3] <- hgap 375 | grob.title.y.left <- justify_grobs( 376 | grob.title.y, 377 | hjust = title.hjust, 378 | vjust = title.vjust, 379 | int_angle = -90, 380 | debug = title.theme$debug 381 | ) 382 | } 383 | if (title.y.position %in% c("right", "both")) { 384 | widths[10] <- title.y.width 385 | widths[9] <- hgap 386 | grob.title.y.right <- justify_grobs( 387 | grob.title.y, 388 | hjust = title.hjust, 389 | vjust = title.vjust, 390 | int_angle = -90, 391 | debug = title.theme$debug 392 | ) 393 | } 394 | 395 | # background 396 | grob.background <- element_render(theme, "legend.background") 397 | 398 | gt <- gtable(widths = unit(widths, "cm"), heights = unit(heights, "cm")) 399 | gt <- gtable_add_grob( 400 | gt, grob.background, name = "background", clip = "off", 401 | t = 1, r = -1, b = -1, l = 1 402 | ) 403 | gt <- gtable_add_grob( 404 | gt, grob.box, name = "box", clip = "off", 405 | t = 6, r = 6, b = 6, l = 6 406 | ) 407 | if (!is.null(grob.title.x.top)) { 408 | gt <- gtable_add_grob( 409 | gt, grob.title.x.top, name = "title.x.top", clip = "off", 410 | t = 2, r = 6, b = 2, l = 6 411 | ) 412 | } 413 | if (!is.null(grob.label.x)) { 414 | gt <- gtable_add_grob( 415 | gt, grob.label.x, name = "label.x.top", clip = "off", 416 | t = 4, r = 6, b = 4, l = 6 417 | ) 418 | } 419 | if (!is.null(grob.title.x.bottom)) { 420 | gt <- gtable_add_grob( 421 | gt, grob.title.x.bottom, name = "title.x.bottom", clip = "off", 422 | t = 10, r = 6, b = 10, l = 6 423 | ) 424 | } 425 | if (!is.null(grob.title.y.left)) { 426 | gt <- gtable_add_grob( 427 | gt, grob.title.y.left, name = "title.y.left", clip = "off", 428 | t = 6, r = 2, b = 6, l = 2 429 | ) 430 | } 431 | if (!is.null(grob.title.y.right)) { 432 | gt <- gtable_add_grob( 433 | gt, grob.title.y.right, name = "title.y.right", clip = "off", 434 | t = 6, r = 10, b = 6, l = 10 435 | ) 436 | } 437 | if (!is.null(grob.label.y)) { 438 | gt <- gtable_add_grob( 439 | gt, grob.label.y, name = "label.y.top", clip = "off", 440 | t = 6, r = 8, b = 6, l = 8 441 | ) 442 | } 443 | 444 | 445 | gt 446 | } 447 | 448 | #' @export 449 | #' @rdname guide_colourbox 450 | guide_colorbox <- guide_colourbox 451 | -------------------------------------------------------------------------------- /R/guide_colourfan.R: -------------------------------------------------------------------------------- 1 | #' Colourfan guide 2 | #' 3 | #' @export 4 | guide_colourfan <- function( 5 | 6 | # title 7 | title = waiver(), 8 | title.x.position = "top", 9 | title.y.position = "right", 10 | title.theme = NULL, 11 | title.hjust = NULL, ## can be deleted? 12 | title.vjust = NULL, ## can be deleted? 13 | 14 | # label 15 | label = TRUE, 16 | label.theme = NULL, 17 | 18 | # bar 19 | barwidth = NULL, 20 | barheight = NULL, 21 | nbin = 32, 22 | 23 | # general 24 | reverse = FALSE, 25 | order = 0, 26 | available_aes = c("colour", "color", "fill"), 27 | 28 | ...) { 29 | 30 | if (!is.null(barwidth) && !is.unit(barwidth)) barwidth <- unit(barwidth, default.unit) 31 | if (!is.null(barheight) && !is.unit(barheight)) barheight <- unit(barheight, default.unit) 32 | 33 | structure(list( 34 | # title 35 | title = title, 36 | title.x.position = title.x.position, 37 | title.y.position = title.y.position, 38 | title.theme = title.theme, 39 | title.hjust = title.hjust, 40 | title.vjust = title.vjust, 41 | 42 | # label 43 | label = label, 44 | label.theme = label.theme, 45 | 46 | # bar 47 | barwidth = barwidth, 48 | barheight = barheight, 49 | nbin = nbin, 50 | 51 | # general 52 | reverse = reverse, 53 | order = order, 54 | 55 | # parameter 56 | available_aes = available_aes, 57 | ..., 58 | name = "colourfan"), 59 | class = c("guide", "colourfan") 60 | ) 61 | } 62 | 63 | #' @export 64 | guide_train.colourfan <- function(guide, scale, aesthetic = NULL) { 65 | 66 | # do nothing if scale are inappropriate 67 | if (length(intersect(scale$aesthetics, guide$available_aes)) == 0) { 68 | warning("colorfan guide needs appropriate scales: ", 69 | paste(guide$available_aes, collapse = ", ")) 70 | return(NULL) 71 | } 72 | if (!scale$is_bivariate()) { 73 | warning("colorfan guide needs bivariate scales.") 74 | return(NULL) 75 | } 76 | 77 | # create tick positions and labels 78 | breaks <- scale$get_breaks() 79 | if (length(breaks[[1]]) == 0 && length(breaks[[2]]) == 0 || 80 | all(is.na(breaks[[1]])) && all(is.na(breaks[[2]]))) 81 | return() 82 | labels <- scale$get_labels(breaks) 83 | 84 | guide$ticks1 <- tibble(value = breaks[[1]], label = labels[[1]]) 85 | guide$ticks2 <- tibble(value = breaks[[2]], label = labels[[2]]) 86 | 87 | # needed to make guide show, even if this is not how we keep track of labels and ticks 88 | key <- as.data.frame( 89 | setNames(list(NA), aesthetic %||% scale$aesthetics[1]), 90 | stringsAsFactors = FALSE 91 | ) 92 | guide$key <- key 93 | 94 | # fan specification 95 | limits <- scale$get_limits() 96 | v1 <- seq(limits[[1]][1], limits[[1]][2], length = guide$nbin) 97 | if (length(v1) == 0) { 98 | v1 = unique(limits[[1]]) 99 | } 100 | v2 <- seq(limits[[2]][1], limits[[2]][2], length = guide$nbin) 101 | if (length(v2) == 0) { 102 | v2 = unique(limits[[2]]) 103 | } 104 | # fan data matrix 105 | guide$fan <- expand.grid(x = v1, y = v2) 106 | guide$fan$colour <- scale$map(zip(guide$fan$x, guide$fan$y)) 107 | 108 | # keep track of individual values along x and y also 109 | guide$fan.x <- v1 110 | guide$fan.y <- v2 111 | 112 | ## need to think about proper implementation 113 | #if (guide$reverse) { 114 | # guide$key <- guide$key[nrow(guide$key):1, ] 115 | # guide$bar <- guide$bar[nrow(guide$bar):1, ] 116 | #} 117 | guide$hash <- with(guide, digest::digest(list(title, ticks1, ticks2, name))) 118 | guide 119 | } 120 | 121 | # simply discards the new guide 122 | #' @export 123 | guide_merge.colourfan <- function(guide, new_guide) { 124 | guide 125 | } 126 | 127 | # this guide is not geom-based. 128 | #' @export 129 | guide_geom.colourfan <- function(guide, layers, default_mapping) { 130 | # Layers that use this guide 131 | guide_layers <- plyr::llply(layers, function(layer) { 132 | matched <- matched_aes(layer, guide, default_mapping) 133 | 134 | if (length(matched) && ((is.na(layer$show.legend) || layer$show.legend))) { 135 | layer 136 | } else { 137 | # This layer does not use this guide 138 | NULL 139 | } 140 | }) 141 | 142 | # Remove this guide if no layer uses it 143 | if (length(plyr::compact(guide_layers)) == 0) guide <- NULL 144 | 145 | guide 146 | } 147 | 148 | #' @export 149 | guide_gengrob.colourfan <- function(guide, theme) { 150 | title.x.position <- guide$title.x.position %||% "top" 151 | title.y.position <- guide$title.y.position %||% "right" 152 | 153 | fanwidth <- width_cm(theme$legend.key.width * 5) 154 | fanheight <- height_cm(theme$legend.key.height * 5) 155 | nbreak <- nrow(guide$key) 156 | 157 | # make the fan grob (`grob.fan`) 158 | grob.fan <- colourfan_grob(guide$fan$colour, nrow = guide$nbin, ncol = guide$nbin) 159 | 160 | # make ticks and labels 161 | tick.x.pos <- rescale( 162 | guide$ticks1$value, 163 | c(0.5, guide$nbin - 0.5), 164 | guide$fan.x[c(1, length(guide$fan.x))] 165 | ) / guide$nbin 166 | 167 | tick.y.pos <- rescale( 168 | guide$ticks2$value, 169 | c(guide$nbin - 0.5, 0.5), 170 | guide$fan.y[c(1, length(guide$fan.y))] 171 | ) / guide$nbin 172 | 173 | label.x.pos <- transform_radial(tibble(x = tick.x.pos, y = 1), yoff = 0.04) 174 | label.y.pos <- transform_radial(tibble(x = 1, y = tick.y.pos), xoff = 0.04) 175 | 176 | # make the label grobs (`grob.label.x` and `grob.label.y`) 177 | 178 | # get the label theme 179 | label.theme <- guide$label.theme %||% calc_element("legend.text", theme) 180 | 181 | # We break inheritance for hjust and vjust, because that's more intuitive here; it still allows manual 182 | # setting of hjust and vjust if desired. The alternative is to ignore hjust and vjust altogether, which 183 | # seems worse 184 | if (is.null(guide$label.theme$hjust) && is.null(theme$legend.text$hjust)) label.theme$hjust <- NULL 185 | if (is.null(guide$label.theme$vjust) && is.null(theme$legend.text$vjust)) label.theme$vjust <- NULL 186 | 187 | # label.theme in param of guide_legend() > theme$legend.text.align > default 188 | hjust <- label.theme$hjust %||% 0.5 189 | vjust <- label.theme$vjust %||% 0.5 190 | 191 | if (!guide$label) # are we drawing labels? 192 | grob.label.x <- NULL 193 | else { 194 | x <- unit(fanwidth*label.x.pos$x, "cm") 195 | y <- unit(fanheight*label.x.pos$y, "cm") 196 | margin_x <- FALSE 197 | margin_y <- FALSE 198 | 199 | label <- guide$ticks1$label 200 | 201 | # If any of the labels are quoted language objects, convert them 202 | # to expressions. Labels from formatter functions can return these 203 | ## TODO: this should be a separate function to keep the code clean 204 | # maybe scales::parse_format()? 205 | if (any(vapply(label, is.call, logical(1)))) { 206 | label <- lapply( 207 | label, 208 | function(l) { 209 | if (is.call(l)) substitute(expression(x), list(x = l)) 210 | else l 211 | } 212 | ) 213 | label <- do.call(c, label) 214 | } 215 | grob.label.x <- element_grob( 216 | element = label.theme, 217 | label = label, 218 | x = x, 219 | y = y, 220 | hjust = 0.5, 221 | vjust = 0, 222 | margin_x = margin_x, 223 | margin_y = margin_y 224 | ) 225 | grob.label.x <- ggname("guide.label.x", grob.label.x) 226 | } 227 | 228 | label.x.width <- width_cm(grob.label.x) 229 | label.x.height <- height_cm(grob.label.x) 230 | 231 | if (!guide$label) # are we drawing labels? 232 | grob.label.y <- NULL 233 | else { 234 | x <- unit(fanwidth*label.y.pos$x, "cm") 235 | y <- unit(fanheight*label.y.pos$y, "cm") 236 | margin_x <- FALSE 237 | margin_y <- FALSE 238 | 239 | label <- guide$ticks2$label 240 | 241 | # If any of the labels are quoted language objects, convert them 242 | # to expressions. Labels from formatter functions can return these 243 | ## TODO: this should be a separate function to keep the code clean 244 | # maybe scales::parse_format()? 245 | if (any(vapply(label, is.call, logical(1)))) { 246 | label <- lapply( 247 | label, 248 | function(l) { 249 | if (is.call(l)) substitute(expression(x), list(x = l)) 250 | else l 251 | } 252 | ) 253 | label <- do.call(c, label) 254 | } 255 | grob.label.y <- element_grob( 256 | element = label.theme, 257 | label = label, 258 | x = x, 259 | y = y, 260 | hjust = 0, 261 | vjust = 0.5, 262 | margin_x = margin_x, 263 | margin_y = margin_y 264 | ) 265 | grob.label.y <- ggname("guide.label.y", grob.label.y) 266 | } 267 | 268 | label.y.width <- width_cm(grob.label.y) 269 | label.y.height <- height_cm(grob.label.y) 270 | 271 | # make titles 272 | 273 | # obtain the theme for the legend title. We need this both for the title grob 274 | # and to obtain the title fontsize. 275 | title.theme <- guide$title.theme %||% calc_element("legend.title", theme) 276 | 277 | title.hjust <- guide$title.hjust %||% theme$legend.title.align %||% title.theme$hjust %||% 0 278 | title.vjust <- guide$title.vjust %||% title.theme$vjust %||% 0.5 279 | 280 | # make title grobs if needed 281 | title.x.label <- guide$title[1] 282 | if (is.null(title.x.label) || is.na(title.x.label)) { 283 | title.x.position <- "none" 284 | } else { 285 | grob.title.x <- ggname( 286 | "guide.title.x", 287 | element_grob( 288 | title.theme, 289 | label = title.x.label, 290 | hjust = title.hjust, 291 | vjust = title.vjust, 292 | margin_x = TRUE, 293 | margin_y = TRUE 294 | ) 295 | ) 296 | title.x.width <- width_cm(grob.title.x) 297 | title.x.height <- height_cm(grob.title.x) 298 | } 299 | 300 | title.y.label <- guide$title[2] 301 | if (is.null(title.y.label) || is.na(title.y.label)) { 302 | title.y.position <- "none" 303 | } else { 304 | title.y.pos <- transform_radial( 305 | tibble(x = 1, y = 0.5), xoff = 0.3 306 | ) 307 | 308 | grob.title.y <- element_grob( 309 | element = title.theme, 310 | label = title.y.label, 311 | x = unit(fanwidth * title.y.pos$x, "cm"), 312 | y = unit(fanheight * title.y.pos$y, "cm"), 313 | hjust = 0.4, 314 | vjust = 0, 315 | angle = 60, 316 | margin_x = FALSE, 317 | margin_y = FALSE 318 | ) 319 | title.y.width <- width_cm(grob.title.y) 320 | title.y.height <- height_cm(grob.title.y) 321 | } 322 | 323 | # gap between keys etc 324 | # the default horizontal and vertical gap need to be the same to avoid strange 325 | # effects for certain guide layouts 326 | title_fontsize <- title.theme$size %||% calc_element("legend.title", theme)$size %||% 0 327 | hgap <- width_cm(theme$legend.spacing.x %||% (0.25 * unit(title_fontsize, "pt"))) 328 | vgap <- height_cm(theme$legend.spacing.y %||% (0.25 * unit(title_fontsize, "pt"))) 329 | 330 | # legend padding 331 | padding <- convertUnit(theme$legend.margin %||% margin(), "cm") 332 | 333 | # we set up the entire legend as an 11x11 table which contains: 334 | # margin, title, gap, labels, ticks, fan, ticks, labels, gap, title, margin 335 | # depending on where titles and labels are added, some cells remain empty 336 | 337 | widths <- c(padding[4], 0, 0, 0, 0, fanwidth, 0, 0, 0, 0, padding[2]) 338 | heights <- c(padding[1], 0, 0, 0, 0, fanheight, 0, 0, 0, 0, padding[3]) 339 | 340 | ## TODO: need to figure out where and how to correctly set label sizes 341 | heights[4] <- label.x.height - fanheight*(1 - min(label.x.pos$y)) 342 | widths[8] <- label.y.width - fanwidth*(1 - min(label.y.pos$x)) 343 | 344 | # titles 345 | grob.title.x.top <- NULL 346 | grob.title.x.bottom <- NULL 347 | if (title.x.position %in% c("top", "both")) { 348 | heights[2] <- title.x.height 349 | heights[3] <- vgap 350 | grob.title.x.top <- justify_grobs( 351 | grob.title.x, 352 | hjust = title.hjust, 353 | vjust = title.vjust, 354 | int_angle = title.theme$angle, 355 | debug = title.theme$debug 356 | ) 357 | } 358 | if (title.x.position %in% c("bottom", "both")) { 359 | heights[10] <- title.x.height 360 | heights[9] <- vgap 361 | grob.title.x.bottom <- justify_grobs( 362 | grob.title.x, 363 | hjust = title.hjust, 364 | vjust = title.vjust, 365 | int_angle = title.theme$angle, 366 | debug = title.theme$debug 367 | ) 368 | } 369 | 370 | grob.title.y.left <- NULL 371 | grob.title.y.right <- NULL 372 | if (title.y.position %in% c("right", "both")) { 373 | #widths[10] <- title.y.width 374 | #widths[9] <- hgap 375 | grob.title.y.right <- grob.title.y 376 | } 377 | 378 | # background 379 | grob.background <- element_render(theme, "legend.background") 380 | 381 | gt <- gtable(widths = unit(widths, "cm"), heights = unit(heights, "cm")) 382 | gt <- gtable_add_grob( 383 | gt, grob.background, name = "background", clip = "off", 384 | t = 1, r = -1, b = -1, l = 1 385 | ) 386 | gt <- gtable_add_grob( 387 | gt, grob.fan, name = "fan", clip = "off", 388 | t = 6, r = 6, b = 6, l = 6 389 | ) 390 | if (!is.null(grob.title.x.top)) { 391 | gt <- gtable_add_grob( 392 | gt, grob.title.x.top, name = "title.x.top", clip = "off", 393 | t = 2, r = 6, b = 2, l = 6 394 | ) 395 | } 396 | if (!is.null(grob.label.x)) { 397 | gt <- gtable_add_grob( 398 | gt, grob.label.x, name = "label.x.top", clip = "off", 399 | t = 6, r = 6, b = 6, l = 6 400 | ) 401 | } 402 | if (!is.null(grob.title.x.bottom)) { 403 | gt <- gtable_add_grob( 404 | gt, grob.title.x.bottom, name = "title.x.bottom", clip = "off", 405 | t = 10, r = 6, b = 10, l = 6 406 | ) 407 | } 408 | if (!is.null(grob.title.y.left)) { 409 | gt <- gtable_add_grob( 410 | gt, grob.title.y.left, name = "title.y.left", clip = "off", 411 | t = 6, r = 2, b = 6, l = 2 412 | ) 413 | } 414 | if (!is.null(grob.title.y.right)) { 415 | gt <- gtable_add_grob( 416 | gt, grob.title.y.right, name = "title.y.right", clip = "off", 417 | t = 6, r = 6, b = 6, l = 6 418 | ) 419 | } 420 | if (!is.null(grob.label.y)) { 421 | gt <- gtable_add_grob( 422 | gt, grob.label.y, name = "label.y.top", clip = "off", 423 | t = 6, r = 6, b = 6, l = 6 424 | ) 425 | } 426 | 427 | 428 | gt 429 | } 430 | 431 | #' @export 432 | #' @rdname guide_colourfan 433 | guide_colorfan <- guide_colourfan 434 | 435 | 436 | colourfan_grob <- function(colours, nrow, ncol, nmunch = 10) { 437 | # the trick is that we first make square polygons and then transform coordinates 438 | dx <- 1 / ncol 439 | dy <- 1 / nrow 440 | 441 | # grid of base points 442 | x <- rep((0:(ncol-1))/ncol, nrow) 443 | y <- rep(((nrow-1):0)/nrow, each = ncol) 444 | 445 | # turn into polygon boundaries 446 | x <- unlist(lapply(x, function(x) c(x+dx*(0:nmunch)/nmunch, x+dx*(nmunch:0)/nmunch))) 447 | y <- unlist(lapply(y, function(y) c(rep(y, nmunch + 1), rep(y+dy, nmunch + 1)))) 448 | id <- rep(1:(nrow*ncol), each = 22) 449 | 450 | # now transform coordinates and make polygon 451 | data <- transform_radial(tibble(x, y)) 452 | polygonGrob(data$x, data$y, id, gp = gpar(fill = colours, col = colours, lwd = 0.5, lty = 1)) 453 | } 454 | 455 | 456 | # map square into fan 457 | # assumes x and y run from 0 to 1 458 | # x runs left to right 459 | # y runs top to bottom 460 | transform_radial <- function(data, xoff = 0, yoff = 0) { 461 | phi <- (data$x * 60 - 30)*(pi/180) 462 | Y <- (data$y + yoff) * cos(phi) - xoff * sin(60*pi/360) 463 | X <- (data$y + yoff) * sin(phi) + 0.5 + xoff * cos(60*pi/360) 464 | tibble(x = X, y = Y) 465 | } 466 | 467 | -------------------------------------------------------------------------------- /R/multiscales.R: -------------------------------------------------------------------------------- 1 | #' Multivariate scales for ggplot2 2 | #' 3 | #' @name multiscales 4 | #' @docType package 5 | #' @import ggplot2 6 | #' @import gtable 7 | #' @import grid 8 | #' @import rlang 9 | #' @import scales 10 | #' @import tibble 11 | #' @importFrom purrr transpose 12 | NULL 13 | 14 | 15 | # ************************************************* 16 | # Setup 17 | # ************************************************* 18 | 19 | .onAttach <- function(libname, pkgname) { 20 | packageStartupMessage("Note: The package \"multiscales\" is highly experimental. Use at your own risk.") 21 | } 22 | -------------------------------------------------------------------------------- /R/pal_bivariate.R: -------------------------------------------------------------------------------- 1 | #' Bivariate palette based on Carto colors 2 | #' 3 | #' Returns a palette function that turns `v` (value) and `u` (uncertainty) (both between 0 and 1) into 4 | #' colors. 5 | #' @param palette Name of the palette 6 | #' @param max_light Maximum amount of lightening 7 | #' @param max_desat Maximum amount of desaturation 8 | #' @param pow_light Power exponent of lightening 9 | #' @param pow_desat Power exponent of desaturation 10 | #' @param ... Other arguments to be given to `carto_hcl()` 11 | #' @export 12 | pal_bivariate_carto <- function(palette = "Earth", max_light = 0.9, max_desat = 0, pow_light = 0.5, pow_desat = 1, ...) { 13 | cols <- colorspace::carto_hcl(n = 11, palette = palette, ...) 14 | ramp <- colour_ramp(cols) 15 | 16 | function(v, u){ 17 | # limit maximal desaturation and lightening 18 | des_amt <- max_desat*u^pow_desat 19 | light_amt <- max_light*u^pow_light 20 | colorspace::lighten(colorspace::desaturate(ramp(v), des_amt), light_amt, space = "HLS") 21 | } 22 | } 23 | 24 | -------------------------------------------------------------------------------- /R/pal_hue_sat.R: -------------------------------------------------------------------------------- 1 | #' Hue-saturation palette using HSV color space 2 | #' 3 | #' Returns a palette function that turns `h` and `s` values (both between 0 and 1) into 4 | #' colors. 5 | #' @param h_range The range of H values to be used. 6 | #' @param s_range The range of S values to be used. 7 | #' @param v The value (V) of the colors in HSV space. 8 | #' @export 9 | pal_hue_sat <- function(h_range = c(0, 1), s_range = c(0, 1), v = 1) { 10 | function(h, s){ 11 | # hsv can't handle NAs, so we need to take care of that 12 | 13 | # first we find some value that is in the range of data 14 | hmin <- min(h, na.rm = TRUE) 15 | if (is.na(hmin)) hmin <- 0 16 | smin <- min(s, na.rm = TRUE) 17 | if (is.na(smin)) smin <- 0 18 | 19 | # now we find the NA values 20 | i1 <- is.na(h) 21 | i2 <- is.na(s) 22 | 23 | # and replace with the values previously identified 24 | h[i1] <- hmin 25 | s[i2] <- smin 26 | 27 | # now rescale to allowed limits 28 | h <- rescale(h, to = h_range) 29 | s <- rescale(s, to = s_range) 30 | 31 | # create colors 32 | ifelse(i1 | i2, NA, hsv(h, s, v)) 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /R/pal_vsup.R: -------------------------------------------------------------------------------- 1 | #' Variance suppressing uncertainty palette 2 | #' 3 | #' Returns a palette function that turns `v` (value) and `u` (uncertainty) (both between 0 and 1) into 4 | #' colors. 5 | #' @param values Color values to be used at minimum uncertainty. Needs to be a vector of 6 | #' length `2^unc_levels`. 7 | #' @param unc_levels Number of discrete uncertainty levels. The number of discrete colors 8 | #' at each level doubles. 9 | #' @param max_light Maximum amount of lightening 10 | #' @param max_desat Maximum amount of desaturation 11 | #' @param pow_light Power exponent of lightening 12 | #' @param pow_desat Power exponent of desaturation 13 | #' @seealso [`pal_vsup_carto()`], [`pal_vsup_viridis()`] 14 | #' @export 15 | pal_vsup <- function(values, unc_levels = 4, max_light = 0.9, max_desat = 0, pow_light = 0.8, pow_desat = 1) { 16 | n <- 2^(unc_levels - 1) 17 | if (length(values) != n) { 18 | stop(length(values), " colors are provided but ", n, " colors are needed for ", unc_levels, " uncertainty levels.", call. = FALSE) 19 | } 20 | 21 | ramp <- colour_ramp(values) 22 | 23 | # v = value, 0: small, 1: large 24 | # u = uncertainty, 0: completely certain, 1: completely uncertain 25 | map_to_discrete <- function(v, u) { 26 | j <- 1 + floor((1 - u) * unc_levels) 27 | j <- ifelse(j >= unc_levels, unc_levels, j) 28 | 29 | val_levels <- 2^(j-1) # total number of value levels at that uncertainty 30 | i <- 1 + floor(v * val_levels) 31 | i <- ifelse( i >= val_levels, val_levels, i) 32 | 33 | list(i = i, j = j, v = ((i - 0.5)/val_levels - 0.5/n)*n/(n - 1), u = 1 - (j - 1)/(unc_levels - 1)) 34 | } 35 | 36 | function(v, u){ 37 | x <- map_to_discrete(v, u) 38 | v <- x$v 39 | u <- x$u # need maximum lightening for 0 certainty 40 | 41 | # limit maximal desaturation and lightening 42 | des_amt <- max_desat*u^pow_desat 43 | light_amt <- max_light*u^pow_light 44 | cols_des <- colorspace::desaturate(ramp(v), des_amt) 45 | nas <- is.na(light_amt) 46 | light_amt[nas] <- 0 47 | ifelse(nas, NA, colorspace::lighten(cols_des, light_amt, space = "HLS")) 48 | } 49 | } 50 | 51 | 52 | #' Value-suppressing uncertainty palettes using carto colors 53 | #' 54 | #' @inheritParams pal_vsup 55 | #' @param palette Name of the palette 56 | #' @param ... Other arguments to be given to [`carto_hcl()`]. 57 | #' @seealso [`pal_vsup()`] 58 | #' @export 59 | pal_vsup_carto <- function(palette = "Earth", max_light = 0.9, max_desat = 0, pow_light = 0.5, pow_desat = 1, unc_levels = 4, ...) { 60 | n <- 2^(unc_levels - 1) 61 | 62 | values <- colorspace::carto_hcl(n = n, palette = palette, ...) 63 | 64 | pal_vsup(values, unc_levels, max_light, max_desat, pow_light, pow_desat) 65 | } 66 | 67 | #' Value-suppressing uncertainty palettes using viridis colors 68 | #' 69 | #' @inheritParams pal_vsup 70 | #' @param option Palette to be used, as in [`viridisLite::viridis()`]. 71 | #' @param begin Hue in \[0, 1] at which the colormap begins. 72 | #' @param end Hue in \[0, 1] at which the colormap ends. 73 | #' @param direction If 1 (default), colors go from light to dark. If -1, colors 74 | #' go dark to light. (Note that this is reversed from standard viridis setup.) 75 | #' @param alpha Alpha transparency of the colors, specified as a number in \[0, 1]. 76 | #' (0 means transparent and 1 means opaque) 77 | #' @param ... Other arguments to be given to [`pal_vsup()`]. 78 | #' @seealso [`pal_vsup()`] 79 | #' @export 80 | pal_vsup_viridis <- function(unc_levels = 4, option = "E", begin = 0.1, end = 0.7, direction = 1, 81 | alpha = 1, ...) { 82 | n <- 2^(unc_levels - 1) 83 | 84 | # swap direction relative to viridis() 85 | direction <- -1*direction 86 | tmp <- begin 87 | begin <- 1 - end 88 | end <- 1 - tmp 89 | 90 | values <- viridisLite::viridis( 91 | n = n, 92 | option = option, 93 | begin = begin, 94 | end = end, 95 | direction = direction, 96 | alpha = alpha 97 | ) 98 | 99 | pal_vsup(values, unc_levels, ...) 100 | } 101 | 102 | -------------------------------------------------------------------------------- /R/range_bivariate.R: -------------------------------------------------------------------------------- 1 | #' Train range for bivariate scale 2 | #' 3 | #' @param new New data on which to train. 4 | #' @param existing Existing range 5 | #' @export 6 | train_bivariate <- function(new, existing = NULL) { 7 | if (is.null(new)) return(existing) 8 | 9 | ## fix for data frames 10 | range1 <- scales::train_continuous(unlist(transpose(new)[[1]]), existing$range1) 11 | range2 <- scales::train_continuous(unlist(transpose(new)[[2]]), existing$range2) 12 | 13 | tibble(range1, range2) 14 | } 15 | 16 | 17 | Range <- ggproto("Range", NULL, 18 | range = NULL, 19 | reset = function(self) { 20 | self$range <- NULL 21 | } 22 | ) 23 | 24 | #' @rdname bivariate_range 25 | #' @usage NULL 26 | #' @export 27 | RangeBivariate <- ggproto("RangeBivariate", Range, 28 | train = function(self, x) { 29 | self$range <- train_bivariate(x, self$range) 30 | } 31 | ) 32 | 33 | #' Constructor for bivariate range object 34 | #' @export 35 | bivariate_range <- function() { 36 | ggproto(NULL, RangeBivariate) 37 | } 38 | -------------------------------------------------------------------------------- /R/scale_bivariate.R: -------------------------------------------------------------------------------- 1 | #' @rdname bivariate_scale 2 | #' @usage NULL 3 | #' @export 4 | ScaleBivariate <- ggproto("ScaleBivariate", Scale, 5 | range = bivariate_range(), 6 | rescaler = list(rescale, rescale), 7 | oob = censor, 8 | trans = list(identity_trans, identity_trans), 9 | 10 | is_discrete = function() FALSE, 11 | is_bivariate = function() TRUE, 12 | 13 | train = function(self, x) { 14 | if (length(x) == 0) return() 15 | self$range$train(x) 16 | }, 17 | 18 | transform = function(self, x) { 19 | ## fix for data frames 20 | if (!is.list(x)) { 21 | stop("For bivariate scale, aesthetic needs to be a list of two data columns. Did you forget `zip()`?", call. = FALSE) 22 | } 23 | x1 <- unlist(transpose(x)[[1]]) 24 | x2 <- unlist(transpose(x)[[2]]) 25 | 26 | x1 <- self$trans[[1]]$transform(x1) 27 | x2 <- self$trans[[2]]$transform(x2) 28 | 29 | ## fix for data frames 30 | zip(x1, x2) 31 | }, 32 | 33 | map = function(self, x, limits = self$get_limits()) { 34 | ## fix for data frames 35 | x1 <- unlist(transpose(x)[[1]]) 36 | x2 <- unlist(transpose(x)[[2]]) 37 | 38 | x1 <- self$rescaler[[1]](self$oob(x1, range = limits[[1]]), from = limits[[1]]) 39 | x2 <- self$rescaler[[2]](self$oob(x2, range = limits[[2]]), from = limits[[2]]) 40 | 41 | scaled <- self$palette(x1, x2) 42 | 43 | ifelse(!is.na(scaled), scaled, self$na.value) 44 | }, 45 | 46 | # if scale contains a NULL, use the default scale range 47 | # if scale contains a NA, use the default range for that axis, otherwise 48 | # use the user defined limit for that axis 49 | get_limits = function(self) { 50 | if (self$is_empty()) return(tibble(limits1 = c(0, 1), limits2 = c(0, 1))) 51 | 52 | if (is.null(self$limits)) { 53 | return(tibble(limits1 = self$range$range[[1]], limits2 = self$range$range[[2]])) 54 | } else { 55 | limits1 <- ifelse(!is.na(self$limits[[1]]), self$limits[[1]], self$range$range[[1]]) 56 | limits2 <- ifelse(!is.na(self$limits[[2]]), self$limits[[2]], self$range$range[[2]]) 57 | return(tibble(limits1, limits2)) 58 | } 59 | }, 60 | 61 | get_breaks = function(self, limits = self$get_limits()) { 62 | breaks1 <- self$get_breaks_1d(1, limits[[1]]) 63 | breaks2 <- self$get_breaks_1d(2, limits[[2]]) 64 | 65 | list(breaks1 = breaks1, breaks2 = breaks2) 66 | }, 67 | 68 | # breaks for one data dimension 69 | get_breaks_1d = function(self, i = 1, limits = self$get_limits()[[i]]) { 70 | if (self$is_empty()) return(numeric(0)) 71 | 72 | # Limits in transformed space need to be converted back to data space 73 | limits <- self$trans[[i]]$inverse(limits) 74 | 75 | if (is.null(self$breaks)) { 76 | return(NULL) 77 | } else if (identical(self$breaks[[i]], NA)) { 78 | stop("Invalid breaks specification. Use NULL, not NA") 79 | } else if (zero_range(as.numeric(limits))) { 80 | breaks <- limits[[i]][1] 81 | } else if (is.waive(self$breaks[[i]])) { 82 | breaks <- self$trans[[i]]$breaks(limits) 83 | } else if (is.function(self$breaks[[i]])) { 84 | breaks <- self$breaks[[i]](limits) 85 | } else { 86 | breaks <- self$breaks[[i]] 87 | } 88 | 89 | # Breaks in data space need to be converted back to transformed space 90 | # And any breaks outside the dimensions need to be flagged as missing 91 | # 92 | # @kohske 93 | # TODO: replace NA with something else for flag. 94 | # guides cannot discriminate oob from missing value. 95 | breaks <- censor(self$trans[[i]]$transform(breaks), self$trans[[i]]$transform(limits), 96 | only.finite = FALSE) 97 | breaks 98 | }, 99 | 100 | get_labels = function(self, breaks = self$get_breaks()) { 101 | labels1 <- self$get_labels_1d(1, breaks[[1]]) 102 | labels2 <- self$get_labels_1d(2, breaks[[2]]) 103 | 104 | list(labels1 = labels1, labels2 = labels2) 105 | }, 106 | 107 | # labels for one data dimension 108 | get_labels_1d = function(self, i = 1, breaks = self$get_breaks()[[i]]) { 109 | if (is.null(breaks)) return(NULL) 110 | 111 | breaks <- self$trans[[i]]$inverse(breaks) 112 | 113 | if (is.null(self$labels[[i]])) { 114 | return(NULL) 115 | } else if (identical(self$labels[[i]], NA)) { 116 | stop("Invalid labels specification. Use NULL, not NA", call. = FALSE) 117 | } else if (is.waive(self$labels[[i]])) { 118 | labels <- self$trans[[i]]$format(breaks) 119 | } else if (is.function(self$labels[[i]])) { 120 | labels <- self$labels[[i]](breaks) 121 | } else { 122 | labels <- self$labels[[i]] 123 | } 124 | if (length(labels) != length(breaks)) { 125 | stop("Breaks and labels are different lengths") 126 | } 127 | labels 128 | }, 129 | 130 | 131 | clone = function(self) { 132 | new <- ggproto(NULL, self) 133 | new$range <- bivariate_range() 134 | new 135 | } 136 | ) 137 | 138 | 139 | #' Constructor for bivariate scale object 140 | #' 141 | #' @inheritParams ggplot2::continuous_scale 142 | #' @param limits Data frame with two columns of length two each defining the limits for the two data dimensions. 143 | #' @param trans Either one transformation applied to both data dimensions or list of two transformations, one 144 | #' for each data dimension. Transformations can be given as either the name of a transformation object 145 | #' or the object itself. See [`ggplot2::continuous_scale()`] for details. 146 | #' @param rescaler Either one rescaling function applied to both data dimensions or list of two rescaling functions, 147 | #' one for each data dimension. 148 | #' @export 149 | bivariate_scale <- function(aesthetics, palette, name = waiver(), 150 | breaks = waiver(), labels = waiver(), limits = NULL, 151 | rescaler = rescale, oob = censor, expand = waiver(), na.value = NA_real_, 152 | trans = "identity", guide = "none", super = ScaleBivariate, 153 | scale_name = "bivariate_scale") { 154 | 155 | breaks <- bivariatize_arg(breaks, "breaks") 156 | labels <- bivariatize_arg(labels, "labels") 157 | 158 | #check_breaks_labels(breaks, labels) 159 | 160 | #if (is.null(breaks) && !is_position_aes(aesthetics) && guide != "none") { 161 | # guide <- "none" 162 | #} 163 | 164 | # TODO 165 | # Need to bivariatize censor, oob, and expand 166 | trans <- bivariatize_arg(trans, "trans") 167 | trans[[1]] <- as.trans(trans[[1]]) 168 | trans[[2]] <- as.trans(trans[[2]]) 169 | 170 | rescaler <- bivariatize_arg(rescaler, "rescaler") 171 | 172 | if (!is.null(limits)) { 173 | # Check that limits are data frame or list with two columns of two values 174 | if (!is.list(limits)) { 175 | stop("Limits argument has to be a data frame or list of vectors", call. = FALSE) 176 | } else if (length(limits) != 2 || length(limits[[1]]) != 2 || length(limits[[2]]) != 2) { 177 | stop("Limits need to be two values each for both data dimensions", call. = FALSE) 178 | } 179 | 180 | # limits are given and valid, need to transform 181 | limits <- tibble( 182 | limits1 = trans[[1]]$transform(limits[[1]]), 183 | limits2 = trans[[2]]$transform(limits[[2]]) 184 | ) 185 | } 186 | 187 | ggproto( 188 | NULL, super, 189 | call = match.call(), 190 | 191 | aesthetics = aesthetics, 192 | scale_name = scale_name, 193 | palette = palette, 194 | 195 | range = bivariate_range(), 196 | limits = limits, 197 | trans = trans, 198 | na.value = na.value, 199 | expand = expand, 200 | rescaler = rescaler, 201 | oob = oob, 202 | 203 | name = name, 204 | breaks = breaks, 205 | 206 | labels = labels, 207 | guide = guide 208 | ) 209 | } 210 | 211 | bivariatize_arg <- function(arg, name = "argument") { 212 | if (!is.null(oldClass(arg)) || is.function(arg) || is.atomic(arg)) { 213 | return(list(arg, arg)) 214 | } 215 | 216 | if (!is.list(arg) || length(arg) != 2) { 217 | stop(paste0("In `bivariate_scale()`, argument `", name, "` needs to be given either as one argument applied to both data dimensions or as a list of exactly two arguments."), call. = FALSE) 218 | } 219 | 220 | arg 221 | } 222 | -------------------------------------------------------------------------------- /R/utilities_ggplot2.R: -------------------------------------------------------------------------------- 1 | # copied over from ggplot2 2 | 3 | width_cm <- function(x) { 4 | if (is.grob(x)) { 5 | convertWidth(grobWidth(x), "cm", TRUE) 6 | } else if (is.unit(x)) { 7 | convertWidth(x, "cm", TRUE) 8 | } else if (is.list(x)) { 9 | vapply(x, width_cm, numeric(1)) 10 | } else { 11 | stop("Unknown input") 12 | } 13 | } 14 | 15 | height_cm <- function(x) { 16 | if (is.grob(x)) { 17 | convertHeight(grobHeight(x), "cm", TRUE) 18 | } else if (is.unit(x)) { 19 | convertHeight(x, "cm", TRUE) 20 | } else if (is.list(x)) { 21 | vapply(x, height_cm, numeric(1)) 22 | } else { 23 | stop("Unknown input") 24 | } 25 | } 26 | 27 | matched_aes <- function(layer, guide, defaults) { 28 | all <- names(c(layer$mapping, if (layer$inherit.aes) defaults, layer$stat$default_aes)) 29 | geom <- c(layer$geom$required_aes, names(layer$geom$default_aes)) 30 | matched <- intersect(intersect(all, geom), names(guide$key)) 31 | matched <- setdiff(matched, names(layer$geom_params)) 32 | setdiff(matched, names(layer$aes_params)) 33 | } 34 | 35 | # not copied for now 36 | element_render <- ggplot2:::element_render 37 | ggname <- ggplot2:::ggname 38 | justify_grobs <- ggplot2:::justify_grobs 39 | is.waive <- ggplot2:::is.waive 40 | -------------------------------------------------------------------------------- /R/zip.R: -------------------------------------------------------------------------------- 1 | #' Zip two or more lists into a list of lists 2 | #' 3 | #' @param ... Lists to be zipped 4 | #' @export 5 | zip <- function(...) transpose(list(...)) 6 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, echo = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | dpi = 300 13 | ) 14 | ``` 15 | 16 | # multiscales 17 | 18 | Multivariate scales for ggplot2, written by Claus O. Wilke 19 | 20 | 21 | ## Installation 22 | 23 | This package can be installed from github. It requires the development version of the colorspace package. It also requires ggplot2 3.0.0, which was released on July 3, 2018. 24 | ``` 25 | install.packages("colorspace", repos = "http://R-Forge.R-project.org") 26 | devtools::install_github("clauswilke/multiscales") 27 | ``` 28 | This is an experimental package. Use at your own risk. API is not stable. No user support provided. 29 | 30 | ## Examples 31 | 32 | Visualizing the lead/lag of Clinton vs. Trump in the 2016 presidential election jointly with the uncertainty of the lead/lag estimates. This visualization shows that for many states the outcome was difficult to predict. (Example taken from Correll et al., [Value-Suppressing Uncertainty Palettes](https://idl.cs.washington.edu/files/2018-UncertaintyPalettes-CHI.pdf), CHI 2018.) 33 | ```{r message = FALSE} 34 | library(ggplot2) 35 | library(multiscales) 36 | 37 | colors <- scales::colour_ramp( 38 | colors = c(red = "#AC202F", purple = "#740280", blue = "#2265A3") 39 | )((0:7)/7) 40 | 41 | ggplot(US_polling) + 42 | geom_sf(aes(fill = zip(Clinton_lead, moe_normalized)), color = "gray30", size = 0.2) + 43 | coord_sf(datum = NA) + 44 | bivariate_scale("fill", 45 | pal_vsup(values = colors, max_desat = 0.8, pow_desat = 0.2, max_light = 0.7, pow_light = 1), 46 | name = c("Clinton lead", "uncertainty"), 47 | limits = list(c(-40, 40), c(0, 1)), 48 | breaks = list(c(-40, -20, 0, 20, 40), c(0, 0.25, 0.50, 0.75, 1.)), 49 | labels = list(waiver(), scales::percent), 50 | guide = "colourfan" 51 | ) + 52 | theme_void() + 53 | theme( 54 | legend.key.size = grid::unit(0.8, "cm"), 55 | legend.title.align = 0.5, 56 | plot.margin = margin(5.5, 20, 5.5, 5.5) 57 | ) 58 | ``` 59 | 60 | For comparison, the same plot with a univariate color scale. Not it appears that in every state we know who is in the lead. 61 | ```{r message = FALSE} 62 | ggplot(US_polling) + 63 | geom_sf(aes(fill = Clinton_lead), color = "gray30", size = 0.2) + 64 | coord_sf(datum = NA) + 65 | scale_fill_gradient2( 66 | low = "#AC202F", mid = "#740280", high = "#2265A3", 67 | name = c("Clinton lead", "uncertainty"), 68 | limits = c(-40, 40), 69 | breaks = c(-40, -20, 0, 20, 40), 70 | guide = guide_colorbar( 71 | direction = "horizontal", 72 | label.position = "bottom", 73 | title.position = "top", 74 | barwidth = grid::unit(4.0, "cm") 75 | ) 76 | ) + 77 | theme_void() + 78 | theme( 79 | legend.title.align = 0.5, 80 | legend.key.size = grid::unit(0.8, "cm"), 81 | plot.margin = margin(5.5, 20, 5.5, 5.5) 82 | ) 83 | ``` 84 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # multiscales 5 | 6 | Multivariate scales for ggplot2, written by Claus O. Wilke 7 | 8 | ## Installation 9 | 10 | This package can be installed from github. It requires the development 11 | version of the colorspace package. It also requires ggplot2 3.0.0, which 12 | was released on July 3, 13 | 2018. 14 | 15 | install.packages("colorspace", repos = "http://R-Forge.R-project.org") 16 | devtools::install_github("clauswilke/multiscales") 17 | 18 | This is an experimental package. Use at your own risk. API is not 19 | stable. No user support provided. 20 | 21 | ## Examples 22 | 23 | Visualizing the lead/lag of Clinton vs. Trump in the 2016 presidential 24 | election jointly with the uncertainty of the lead/lag estimates. This 25 | visualization shows that for many states the outcome was difficult to 26 | predict. (Example taken from Correll et al., [Value-Suppressing 27 | Uncertainty 28 | Palettes](https://idl.cs.washington.edu/files/2018-UncertaintyPalettes-CHI.pdf), 29 | CHI 2018.) 30 | 31 | ``` r 32 | library(ggplot2) 33 | library(multiscales) 34 | 35 | colors <- scales::colour_ramp( 36 | colors = c(red = "#AC202F", purple = "#740280", blue = "#2265A3") 37 | )((0:7)/7) 38 | 39 | ggplot(US_polling) + 40 | geom_sf(aes(fill = zip(Clinton_lead, moe_normalized)), color = "gray30", size = 0.2) + 41 | coord_sf(datum = NA) + 42 | bivariate_scale("fill", 43 | pal_vsup(values = colors, max_desat = 0.8, pow_desat = 0.2, max_light = 0.7, pow_light = 1), 44 | name = c("Clinton lead", "uncertainty"), 45 | limits = list(c(-40, 40), c(0, 1)), 46 | breaks = list(c(-40, -20, 0, 20, 40), c(0, 0.25, 0.50, 0.75, 1.)), 47 | labels = list(waiver(), scales::percent), 48 | guide = "colourfan" 49 | ) + 50 | theme_void() + 51 | theme( 52 | legend.key.size = grid::unit(0.8, "cm"), 53 | legend.title.align = 0.5, 54 | plot.margin = margin(5.5, 20, 5.5, 5.5) 55 | ) 56 | ``` 57 | 58 | ![](man/figures/README-unnamed-chunk-2-1.png) 59 | 60 | For comparison, the same plot with a univariate color scale. Not it 61 | appears that in every state we know who is in the lead. 62 | 63 | ``` r 64 | ggplot(US_polling) + 65 | geom_sf(aes(fill = Clinton_lead), color = "gray30", size = 0.2) + 66 | coord_sf(datum = NA) + 67 | scale_fill_gradient2( 68 | low = "#AC202F", mid = "#740280", high = "#2265A3", 69 | name = c("Clinton lead", "uncertainty"), 70 | limits = c(-40, 40), 71 | breaks = c(-40, -20, 0, 20, 40), 72 | guide = guide_colorbar( 73 | direction = "horizontal", 74 | label.position = "bottom", 75 | title.position = "top", 76 | barwidth = grid::unit(4.0, "cm") 77 | ) 78 | ) + 79 | theme_void() + 80 | theme( 81 | legend.title.align = 0.5, 82 | legend.key.size = grid::unit(0.8, "cm"), 83 | plot.margin = margin(5.5, 20, 5.5, 5.5) 84 | ) 85 | ``` 86 | 87 | ![](man/figures/README-unnamed-chunk-3-1.png) 88 | -------------------------------------------------------------------------------- /data-raw/FL-house-values.R: -------------------------------------------------------------------------------- 1 | library(tidycensus) 2 | library(tidyverse) 3 | 4 | options(tigris_use_cache = TRUE) 5 | 6 | # B25077_001: Median house value in the past 12 months (in 2015 Inflation-adjusted dollars) 7 | FL_house_values <- get_acs(state = "FL", geography = "county", year = 2015, variables = "B25077_001", geometry = TRUE) 8 | 9 | devtools::use_data(FL_house_values, overwrite = TRUE) 10 | -------------------------------------------------------------------------------- /data-raw/US_polling/US_polling.R: -------------------------------------------------------------------------------- 1 | # 2016 US polling data 2 | # taken from: 3 | # https://github.com/uwdata/papers-vsup/tree/master/examples 4 | # Value-Suppressing Uncertainty Palettes 5 | # Michael Correll, Dominik Moritz, Jeffrey Heer 6 | # ACM Human Factors in Computing Systems (CHI), 2018 7 | 8 | # Electoral Votes taken from: https://state.1keydata.com/state-electoral-votes.php 9 | 10 | library(sf) 11 | library(readr) 12 | library(dplyr) 13 | library(here) 14 | 15 | 16 | usa_albers <- sf::st_transform( 17 | albersusa::usa_sf(), 18 | "+proj=laea +lat_0=45 +lon_0=-100 +x_0=0 +y_0=0 +a=6370997 +b=6370997 +units=m +no_defs" 19 | ) 20 | 21 | polling <- read_csv(here("data-raw", "US_polling", "polling.csv")) %>% 22 | mutate( 23 | Clinton = as.numeric(sub("%", "", `Hillary Clinton`)), 24 | moe = as.numeric(sub("%", "", `Margin of error`)), 25 | Clinton_ahead = sign(Clinton - as.numeric(sub("%", "", `Donald Trump`))), 26 | lead = ifelse(Lead == "Tied", 0, as.numeric(Lead)), 27 | moe_normalized = ifelse(moe / lead >= 1, 1, moe / lead), 28 | Clinton_lead = Clinton_ahead * lead 29 | ) %>% 30 | select(State, Clinton_lead, moe_normalized) 31 | 32 | US_polling <- left_join(polling, rename(usa_albers, State = name)) 33 | 34 | ec_votes <- read_csv(here("data-raw", "US_polling", "electoral_votes.csv")) %>% 35 | rename(ec_votes = `Electoral Votes`) 36 | 37 | US_polling <- left_join(US_polling, ec_votes) 38 | 39 | # turn into sf data frame 40 | US_polling <- st_as_sf(US_polling) 41 | 42 | devtools::use_data(US_polling, overwrite = TRUE) 43 | 44 | 45 | # also make cartogram version 46 | library(cartogram) 47 | US_polling_cartogram <- cartogram_cont(US_polling, 'ec_votes') 48 | 49 | devtools::use_data(US_polling_cartogram, overwrite = TRUE) 50 | 51 | -------------------------------------------------------------------------------- /data-raw/US_polling/electoral_votes.csv: -------------------------------------------------------------------------------- 1 | State,Electoral Votes Alabama,9 Alaska,3 Arizona,11 Arkansas,6 California,55 Colorado,9 Connecticut,7 Delaware,3 Florida,29 Georgia,16 Hawaii,4 Idaho,4 Illinois,20 Indiana,11 Iowa,6 Kansas,6 Kentucky,8 Louisiana,8 Maine,4 Maryland,10 Massachusetts,11 Michigan,16 Minnesota,10 Mississippi,6 Missouri,10 Montana,3 Nebraska,5 Nevada,6 New Hampshire,4 New Jersey,14 New Mexico,5 New York,29 North Carolina,15 North Dakota,3 Ohio,18 Oklahoma,7 Oregon,7 Pennsylvania,20 Rhode Island,4 South Carolina,9 South Dakota,3 Tennessee,11 Texas,38 Utah,6 Vermont,3 Virginia,13 Washington,12 West Virginia,5 Wisconsin,10 Wyoming,3 -------------------------------------------------------------------------------- /data-raw/US_polling/polling.csv: -------------------------------------------------------------------------------- 1 | State,Date,Hillary Clinton,Donald Trump,Gary Johnson,Jill Stein,Evan McMullin,Margin of error,Lead,Clinton potential EVs,Trump potential EVs,Tied potential EVs,Result 2 | Alabama,"September 27, 2016",32%,48%,,,,2.0%,16,,9,,25.8 3 | Alaska,"October 21–26, 2016",47%,43%,7%,3%,,4.9%,4,,,3,14.7 4 | Arizona,"November 4–6, 2016",45%,47%,5%,2%,,4.9%,2,,,11,3.5 5 | Arkansas,"October 18–25, 2016",36%,59%,,,,4.1%,23,,6,,26.9 6 | California,"November 4–6, 2016",58%,35%,3%,2%,,4.9%,28,55,,,30.1 7 | Colorado,"November 3–4, 2016",48%,43%,4%,2%,1%,3.7%,5,,,9,4.9 8 | Connecticut,"September 2–5, 2016",50%,35%,9%,4%,,3.0%,15,7,,,13.6 9 | Delaware,"September 16–28, 2016",51%,30%,7%,2%,,4.1%,21,3,,,11.4 10 | Florida,"November 6, 2016",46%,50%,2%,1%,,3.3%,4,,,29,1.2 11 | Georgia,"November 6, 2016",45%,52%,2%,,,2.8%,7,,16,,5.1 12 | Hawaii,"September 6, 2016",51%,25%,7%,7%,,4%,26,,,, 13 | Idaho,"October 23–24, 2016",29%,48%,6%,,10%,4.0%,19,,4,,31.8 14 | Illinois,"October 27–30, 2016",53%,41%,2%,0%,,4.3%,12,20,,,17.1 15 | Indiana,"November 1–3, 2016",37%,48%,9%,,,4.0%,11,,11,,18.9 16 | Iowa,"November 1–4, 2016",39%,46%,6%,1%,,3.5%,7,,,6,9.4 17 | Kansas,"November 1–3, 2016",34%,58%,,,,5.5%,24,,6,,20.6 18 | Kentucky,"October 25–30, 2016",37%,54%,1%,1%,1%,4.0%,17,,8,,29.8 19 | Louisiana,"October 19–21, 2016",35%,50%,5%,,,4.4%,15,,8,,19.6 20 | Maine,"October 28–30, 2016",46%,42%,12%,2%,,3.5%,4,1,,3,3 21 | Maryland,"September 27–30, 2016",63%,27%,4%,2%,,4.0%,36,10,,,26.4 22 | Massachusetts,"October 23 – November 2, 2016",56%,26%,8%,3%,,5.0%,30,11,,,27.2 23 | Michigan,"November 6, 2016",47%,49%,3%,1%,,2.8%,2,,,16,0.2 24 | Minnesota,"October 22–26, 2016",49%,39%,5%,2%,1%,3.9%,10,10,,,1.5 25 | Missouri,"November 4–5, 2016",41%,47%,7%,2%,,3.5%,6,,,10,18.6 26 | Mississippi,"August 17, 2016",39%,54%,3%,,,2.9%,15,,,, 27 | Montana,"October 10–12, 2016",36%,46%,11%,,,3.2%,10,,3,,20.4 28 | Nebraska,"September 25–27, 2016",29%,56%,7%,1%,,3.6%,27,,4,1,25 29 | Nevada,"November 4–6, 2016",46%,46%,5%,1%,,4.9%,Tied,,,6,2.4 30 | New Hampshire,"November 3–6, 2016",49%,38%,6%,1%,,3.7%,11,4,,,0.4 31 | New Jersey,"October 27 – November 2, 2016",51%,40%,3%,1%,,3.8%,11,14,,,14.2 32 | New Mexico,"November 6, 2016",46%,44%,6%,1%,,1.8%,2,,,5,8.2 33 | New York,"November 3–4, 2016",51%,34%,5%,2%,,4.5%,17,29,,,22.5 34 | North Carolina,"November 4–6, 2016",44%,44%,3%,,,3.5%,Tied,,,15,3.6 35 | North Dakota,"September 12–17, 2016",32%,43%,8%,1%,,4.9%,11,,3,,35.7 36 | Ohio,"October 27 – November 5, 2016",39%,46%,7%,3%,,3.2%,7,,18,,8.1 37 | Oklahoma,"October 18–20, 2016",30%,60%,5%,,,4.3%,30,,7,,36.4 38 | Oregon,"October 24–29, 2016",41%,34%,4%,2%,,4.4%,7,,,7,11 39 | Pennsylvania,"November 3–6, 2016",46%,40%,7%,2%,,2.8%,6,20,,,0.7 40 | Rhode Island,"October 2–4, 2016",52%,32%,5%,5%,,3.4%,20,4,,,18.5 41 | South Carolina,"October 30–31, 2016",36%,47%,3%,1%,,4.4%,11,,9,,14.7 42 | South Dakota,"October 24–26, 2016",35%,49%,7%,,,4.0%,14,,3,,29.8 43 | Tennessee,"October 14–17, 2016",34%,44%,7%,2%,,4.4%,10,,11,,26 44 | Texas,"October 31 – November 1, 2016",35%,49%,5%,4%,,3.6%,14,,38,,9 45 | Utah,"November 3–5, 2016",30%,40%,4%,,25%,2.7%,10,,6,,18.1 46 | Vermont,"October 24–26, 2016",52%,26%,5%,2%,,3.0%,26,3,,,26.4 47 | Virginia,"November 1–6, 2016",48%,42%,3%,1%,2%,3.6%,6,,,13,5.3 48 | Washington,"November 4–6, 2016",55%,39%,,,,4.9%,16,12,,,16.2 49 | West Virginia,"September 13–17, 2016",28%,60%,,,,5.0%,32,,5,,42.2 50 | Wisconsin,"November 1–2, 2016",49%,41%,3%,,,1.9%,8,10,,,0.8 51 | Wyoming,"October 5–11, 2016",20%,58%,9%,2%,,3.6%,38,,3,,46.3 52 | -------------------------------------------------------------------------------- /data/FL_house_values.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clauswilke/multiscales/92abeb8db20d50839c476d880f0738cbb7c995de/data/FL_house_values.rda -------------------------------------------------------------------------------- /data/US_polling.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clauswilke/multiscales/92abeb8db20d50839c476d880f0738cbb7c995de/data/US_polling.rda -------------------------------------------------------------------------------- /data/US_polling_cartogram.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clauswilke/multiscales/92abeb8db20d50839c476d880f0738cbb7c995de/data/US_polling_cartogram.rda -------------------------------------------------------------------------------- /man/FL_house_values.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{FL_house_values} 5 | \alias{FL_house_values} 6 | \title{Median house values Florida counties} 7 | \format{An object of class \code{sf} (inherits from \code{data.frame}) with 67 rows and 6 columns.} 8 | \usage{ 9 | FL_house_values 10 | } 11 | \description{ 12 | Median house values in Florida counties, from the 2015 five-year American Community Survey. 13 | } 14 | \examples{ 15 | library(ggplot2) 16 | library(colorspace) 17 | 18 | # B25077_001: Median house value in the past 12 months (in 2015 Inflation-adjusted dollars) 19 | 20 | # univariate scale 21 | ggplot(FL_house_values, aes(fill = estimate)) + 22 | geom_sf(color = "gray30", size = 0.2) + 23 | coord_sf(xlim = c(-88, -79.8), ylim = c(24.1, 31.2), datum = NA) + 24 | scale_fill_continuous_carto( 25 | palette = "Sunset", rev = TRUE, 26 | name = "median house values", 27 | guide = guide_colorbar( 28 | direction = "horizontal", 29 | label.position = "bottom", 30 | title.position = "top", 31 | barwidth = grid::unit(2.0, "in") 32 | ) 33 | ) + 34 | theme_void() + 35 | theme( 36 | legend.title.align = 0.5, 37 | legend.text.align = 0.5, 38 | legend.justification = c(0, 0), 39 | legend.position = c(0.1, 0.3) 40 | ) 41 | 42 | # bivariate value-suppressing uncertainty scale 43 | ggplot(FL_house_values, aes(fill = zip(estimate, moe/estimate))) + 44 | geom_sf(color = "gray30", size = 0.2) + 45 | coord_sf(xlim = c(-88, -79.8), ylim = c(24.1, 31.2), datum = NA) + 46 | bivariate_scale( 47 | "fill", "bivariate_scale", 48 | pal_carto_vsup(palette = "Sunset", rev = TRUE), 49 | guide = "colourbox", 50 | name = c("median house values", "uncertainty") 51 | ) + 52 | theme_void() + 53 | theme( 54 | legend.title.align = 0.5, 55 | legend.text.align = 0.5, 56 | legend.justification = c(0, 0), 57 | legend.position = c(0.15, 0.2) 58 | ) 59 | 60 | } 61 | \keyword{datasets} 62 | -------------------------------------------------------------------------------- /man/US_polling.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{US_polling} 5 | \alias{US_polling} 6 | \alias{US_polling_cartogram} 7 | \title{Polling data from the 2016 US presidential election} 8 | \format{An object of class \code{sf} (inherits from \code{tbl_df}, \code{tbl}, \code{data.frame}) with 50 rows and 17 columns.} 9 | \source{ 10 | Michael Correll, Dominik Moritz, Jeffrey Heer (2018) Value-Suppressing Uncertainty Palettes. 11 | ACM Human Factors in Computing Systems (CHI) 12 | \url{https://github.com/uwdata/papers-vsup/tree/master/examples} 13 | } 14 | \usage{ 15 | US_polling 16 | 17 | US_polling_cartogram 18 | } 19 | \description{ 20 | Polling data from the 2016 US presidential election, combined with map of US states. Also provided is an 21 | alternative map in cartogram style where each state is scaled in proportion to the number of electoral 22 | college votes it has. 23 | } 24 | \keyword{datasets} 25 | -------------------------------------------------------------------------------- /man/bivariate_range.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/range_bivariate.R 3 | \docType{data} 4 | \name{RangeBivariate} 5 | \alias{RangeBivariate} 6 | \alias{bivariate_range} 7 | \title{Constructor for bivariate range object} 8 | \format{An object of class \code{RangeBivariate} (inherits from \code{Range}, \code{ggproto}, \code{gg}) of length 2.} 9 | \usage{ 10 | bivariate_range() 11 | } 12 | \description{ 13 | Constructor for bivariate range object 14 | } 15 | \keyword{datasets} 16 | -------------------------------------------------------------------------------- /man/bivariate_scale.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scale_bivariate.R 3 | \docType{data} 4 | \name{ScaleBivariate} 5 | \alias{ScaleBivariate} 6 | \alias{bivariate_scale} 7 | \title{Constructor for bivariate scale object} 8 | \format{An object of class \code{ScaleBivariate} (inherits from \code{Scale}, \code{ggproto}, \code{gg}) of length 16.} 9 | \usage{ 10 | bivariate_scale(aesthetics, palette, name = waiver(), breaks = waiver(), 11 | labels = waiver(), limits = NULL, rescaler = rescale, oob = censor, 12 | expand = waiver(), na.value = NA_real_, trans = "identity", 13 | guide = "none", super = ScaleBivariate, scale_name = "bivariate_scale") 14 | } 15 | \arguments{ 16 | \item{aesthetics}{The names of the aesthetics that this scale works with} 17 | 18 | \item{palette}{A palette function that when called with a single integer 19 | argument (the number of levels in the scale) returns the values that 20 | they should take} 21 | 22 | \item{name}{The name of the scale. Used as axis or legend title. If 23 | \code{waiver()}, the default, the name of the scale is taken from the first 24 | mapping used for that aesthetic. If \code{NULL}, the legend title will be 25 | omitted.} 26 | 27 | \item{breaks}{One of: 28 | \itemize{ 29 | \item \code{NULL} for no breaks 30 | \item \code{waiver()} for the default breaks computed by the 31 | transformation object 32 | \item A numeric vector of positions 33 | \item A function that takes the limits as input and returns breaks 34 | as output 35 | }} 36 | 37 | \item{labels}{One of: 38 | \itemize{ 39 | \item \code{NULL} for no labels 40 | \item \code{waiver()} for the default labels computed by the 41 | transformation object 42 | \item A character vector giving labels (must be same length as \code{breaks}) 43 | \item A function that takes the breaks as input and returns labels 44 | as output 45 | }} 46 | 47 | \item{limits}{Data frame with two columns of length two each defining the limits for the two data dimensions.} 48 | 49 | \item{rescaler}{Either one rescaling function applied to both data dimensions or list of two rescaling functions, 50 | one for each data dimension.} 51 | 52 | \item{oob}{Function that handles limits outside of the scale limits 53 | (out of bounds). The default replaces out of bounds values with NA.} 54 | 55 | \item{expand}{Vector of range expansion constants used to add some 56 | padding around the data, to ensure that they are placed some distance 57 | away from the axes. Use the convenience function \code{\link[=expand_scale]{expand_scale()}} 58 | to generate the values for the \code{expand} argument. The defaults are to 59 | expand the scale by 5\% on each side for continuous variables, and by 60 | 0.6 units on each side for discrete variables.} 61 | 62 | \item{na.value}{Missing values will be replaced with this value.} 63 | 64 | \item{trans}{Either one transformation applied to both data dimensions or list of two transformations, one 65 | for each data dimension. Transformations can be given as either the name of a transformation object 66 | or the object itself. See \code{\link[ggplot2:continuous_scale]{ggplot2::continuous_scale()}} for details.} 67 | 68 | \item{guide}{A function used to create a guide or its name. See 69 | \code{\link[=guides]{guides()}} for more info.} 70 | 71 | \item{super}{The super class to use for the constructed scale} 72 | 73 | \item{scale_name}{The name of the scale} 74 | } 75 | \description{ 76 | Constructor for bivariate scale object 77 | } 78 | \keyword{datasets} 79 | -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clauswilke/multiscales/92abeb8db20d50839c476d880f0738cbb7c995de/man/figures/README-unnamed-chunk-2-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-3-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clauswilke/multiscales/92abeb8db20d50839c476d880f0738cbb7c995de/man/figures/README-unnamed-chunk-3-1.png -------------------------------------------------------------------------------- /man/guide_colourbox.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/guide_colourbox.R 3 | \name{guide_colourbox} 4 | \alias{guide_colourbox} 5 | \alias{guide_colorbox} 6 | \title{Colourbox guide} 7 | \usage{ 8 | guide_colourbox(title = waiver(), title.x.position = "top", 9 | title.y.position = "right", title.theme = NULL, title.hjust = NULL, 10 | title.vjust = NULL, label = TRUE, label.theme = NULL, barwidth = NULL, 11 | barheight = NULL, nbin = 100, reverse = FALSE, order = 0, 12 | available_aes = c("colour", "color", "fill"), ...) 13 | 14 | guide_colorbox(title = waiver(), title.x.position = "top", 15 | title.y.position = "right", title.theme = NULL, title.hjust = NULL, 16 | title.vjust = NULL, label = TRUE, label.theme = NULL, barwidth = NULL, 17 | barheight = NULL, nbin = 100, reverse = FALSE, order = 0, 18 | available_aes = c("colour", "color", "fill"), ...) 19 | } 20 | \description{ 21 | Colourbox guide 22 | } 23 | -------------------------------------------------------------------------------- /man/guide_colourfan.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/guide_colourfan.R 3 | \name{guide_colourfan} 4 | \alias{guide_colourfan} 5 | \alias{guide_colorfan} 6 | \title{Colourfan guide} 7 | \usage{ 8 | guide_colourfan(title = waiver(), title.x.position = "top", 9 | title.y.position = "right", title.theme = NULL, title.hjust = NULL, 10 | title.vjust = NULL, label = TRUE, label.theme = NULL, barwidth = NULL, 11 | barheight = NULL, nbin = 32, reverse = FALSE, order = 0, 12 | available_aes = c("colour", "color", "fill"), ...) 13 | 14 | guide_colorfan(title = waiver(), title.x.position = "top", 15 | title.y.position = "right", title.theme = NULL, title.hjust = NULL, 16 | title.vjust = NULL, label = TRUE, label.theme = NULL, barwidth = NULL, 17 | barheight = NULL, nbin = 32, reverse = FALSE, order = 0, 18 | available_aes = c("colour", "color", "fill"), ...) 19 | } 20 | \description{ 21 | Colourfan guide 22 | } 23 | -------------------------------------------------------------------------------- /man/multiscales.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/multiscales.R 3 | \docType{package} 4 | \name{multiscales} 5 | \alias{multiscales} 6 | \alias{multiscales-package} 7 | \title{Multivariate scales for ggplot2} 8 | \description{ 9 | Multivariate scales for ggplot2 10 | } 11 | -------------------------------------------------------------------------------- /man/pal_bivariate_carto.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pal_bivariate.R 3 | \name{pal_bivariate_carto} 4 | \alias{pal_bivariate_carto} 5 | \title{Bivariate palette based on Carto colors} 6 | \usage{ 7 | pal_bivariate_carto(palette = "Earth", max_light = 0.9, max_desat = 0, 8 | pow_light = 0.5, pow_desat = 1, ...) 9 | } 10 | \arguments{ 11 | \item{palette}{Name of the palette} 12 | 13 | \item{max_light}{Maximum amount of lightening} 14 | 15 | \item{max_desat}{Maximum amount of desaturation} 16 | 17 | \item{pow_light}{Power exponent of lightening} 18 | 19 | \item{pow_desat}{Power exponent of desaturation} 20 | 21 | \item{...}{Other arguments to be given to \code{carto_hcl()}} 22 | } 23 | \description{ 24 | Returns a palette function that turns \code{v} (value) and \code{u} (uncertainty) (both between 0 and 1) into 25 | colors. 26 | } 27 | -------------------------------------------------------------------------------- /man/pal_hue_sat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pal_hue_sat.R 3 | \name{pal_hue_sat} 4 | \alias{pal_hue_sat} 5 | \title{Hue-saturation palette using HSV color space} 6 | \usage{ 7 | pal_hue_sat(h_range = c(0, 1), s_range = c(0, 1), v = 1) 8 | } 9 | \arguments{ 10 | \item{h_range}{The range of H values to be used.} 11 | 12 | \item{s_range}{The range of S values to be used.} 13 | 14 | \item{v}{The value (V) of the colors in HSV space.} 15 | } 16 | \description{ 17 | Returns a palette function that turns \code{h} and \code{s} values (both between 0 and 1) into 18 | colors. 19 | } 20 | -------------------------------------------------------------------------------- /man/pal_vsup.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pal_vsup.R 3 | \name{pal_vsup} 4 | \alias{pal_vsup} 5 | \title{Variance suppressing uncertainty palette} 6 | \usage{ 7 | pal_vsup(values, unc_levels = 4, max_light = 0.9, max_desat = 0, 8 | pow_light = 0.8, pow_desat = 1) 9 | } 10 | \arguments{ 11 | \item{values}{Color values to be used at minimum uncertainty. Needs to be a vector of 12 | length \code{2^unc_levels}.} 13 | 14 | \item{unc_levels}{Number of discrete uncertainty levels. The number of discrete colors 15 | at each level doubles.} 16 | 17 | \item{max_light}{Maximum amount of lightening} 18 | 19 | \item{max_desat}{Maximum amount of desaturation} 20 | 21 | \item{pow_light}{Power exponent of lightening} 22 | 23 | \item{pow_desat}{Power exponent of desaturation} 24 | } 25 | \description{ 26 | Returns a palette function that turns \code{v} (value) and \code{u} (uncertainty) (both between 0 and 1) into 27 | colors. 28 | } 29 | \seealso{ 30 | \code{\link[=pal_vsup_carto]{pal_vsup_carto()}}, \code{\link[=pal_vsup_viridis]{pal_vsup_viridis()}} 31 | } 32 | -------------------------------------------------------------------------------- /man/pal_vsup_carto.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pal_vsup.R 3 | \name{pal_vsup_carto} 4 | \alias{pal_vsup_carto} 5 | \title{Value-suppressing uncertainty palettes using carto colors} 6 | \usage{ 7 | pal_vsup_carto(palette = "Earth", max_light = 0.9, max_desat = 0, 8 | pow_light = 0.5, pow_desat = 1, unc_levels = 4, ...) 9 | } 10 | \arguments{ 11 | \item{palette}{Name of the palette} 12 | 13 | \item{max_light}{Maximum amount of lightening} 14 | 15 | \item{max_desat}{Maximum amount of desaturation} 16 | 17 | \item{pow_light}{Power exponent of lightening} 18 | 19 | \item{pow_desat}{Power exponent of desaturation} 20 | 21 | \item{unc_levels}{Number of discrete uncertainty levels. The number of discrete colors 22 | at each level doubles.} 23 | 24 | \item{...}{Other arguments to be given to \code{\link[=carto_hcl]{carto_hcl()}}.} 25 | } 26 | \description{ 27 | Value-suppressing uncertainty palettes using carto colors 28 | } 29 | \seealso{ 30 | \code{\link[=pal_vsup]{pal_vsup()}} 31 | } 32 | -------------------------------------------------------------------------------- /man/pal_vsup_viridis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pal_vsup.R 3 | \name{pal_vsup_viridis} 4 | \alias{pal_vsup_viridis} 5 | \title{Value-suppressing uncertainty palettes using viridis colors} 6 | \usage{ 7 | pal_vsup_viridis(unc_levels = 4, option = "E", begin = 0.1, end = 0.7, 8 | direction = 1, alpha = 1, ...) 9 | } 10 | \arguments{ 11 | \item{unc_levels}{Number of discrete uncertainty levels. The number of discrete colors 12 | at each level doubles.} 13 | 14 | \item{option}{Palette to be used, as in \code{\link[viridisLite:viridis]{viridisLite::viridis()}}.} 15 | 16 | \item{begin}{Hue in [0, 1] at which the colormap begins.} 17 | 18 | \item{end}{Hue in [0, 1] at which the colormap ends.} 19 | 20 | \item{direction}{If 1 (default), colors go from light to dark. If -1, colors 21 | go dark to light. (Note that this is reversed from standard viridis setup.)} 22 | 23 | \item{alpha}{Alpha transparency of the colors, specified as a number in [0, 1]. 24 | (0 means transparent and 1 means opaque)} 25 | 26 | \item{...}{Other arguments to be given to \code{\link[=pal_vsup]{pal_vsup()}}.} 27 | } 28 | \description{ 29 | Value-suppressing uncertainty palettes using viridis colors 30 | } 31 | \seealso{ 32 | \code{\link[=pal_vsup]{pal_vsup()}} 33 | } 34 | -------------------------------------------------------------------------------- /man/train_bivariate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/range_bivariate.R 3 | \name{train_bivariate} 4 | \alias{train_bivariate} 5 | \title{Train range for bivariate scale} 6 | \usage{ 7 | train_bivariate(new, existing = NULL) 8 | } 9 | \arguments{ 10 | \item{new}{New data on which to train.} 11 | 12 | \item{existing}{Existing range} 13 | } 14 | \description{ 15 | Train range for bivariate scale 16 | } 17 | -------------------------------------------------------------------------------- /man/zip.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/zip.R 3 | \name{zip} 4 | \alias{zip} 5 | \title{Zip two or more lists into a list of lists} 6 | \usage{ 7 | zip(...) 8 | } 9 | \arguments{ 10 | \item{...}{Lists to be zipped} 11 | } 12 | \description{ 13 | Zip two or more lists into a list of lists 14 | } 15 | -------------------------------------------------------------------------------- /multiscales.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | --------------------------------------------------------------------------------