boB Rudis
6 years ago
13 changed files with 502 additions and 15 deletions
@ -1,24 +1,30 @@ |
|||||
Package: worldtilegrid |
Package: worldtilegrid |
||||
Type: Package |
Type: Package |
||||
Title: worldtilegrid title goes here otherwise CRAN checks fail |
Title: A ggplot2 Geom for World Tile Grids |
||||
Version: 0.1.0 |
Version: 0.1.0 |
||||
Date: 2018-08-25 |
Date: 2018-08-25 |
||||
Authors@R: c( |
Authors@R: c( |
||||
person("Bob", "Rudis", email = "bob@rud.is", role = c("aut", "cre"), |
person("Bob", "Rudis", email = "bob@rud.is", role = c("aut", "cre"), |
||||
comment = c(ORCID = "0000-0001-5670-2640")) |
comment = c(ORCID = "0000-0001-5670-2640")), |
||||
|
person("Maarten", "Lambrechts", role = "aut", |
||||
|
comment = "R WTG Data Creator"), |
||||
|
person("Jon", "Schwabish", role = "aut", comment = "Concept Originatior") |
||||
) |
) |
||||
Maintainer: Bob Rudis <bob@rud.is> |
Maintainer: Bob Rudis <bob@rud.is> |
||||
Description: A good description goes here otherwise CRAN checks fail. |
Description: A ggplot2 Geom for World Tile Grids |
||||
URL: https://gitlab.com/hrbrmstr/worldtilegrid |
URL: https://gitlab.com/hrbrmstr/worldtilegrid |
||||
BugReports: https://gitlab.com/hrbrmstr/worldtilegrid/issues |
BugReports: https://gitlab.com/hrbrmstr/worldtilegrid/issues |
||||
Encoding: UTF-8 |
Encoding: UTF-8 |
||||
License: AGPL |
License: AGPL |
||||
Suggests: |
Suggests: |
||||
testthat, |
testthat, |
||||
|
viridis, |
||||
|
RColorBrewer, |
||||
covr |
covr |
||||
Depends: |
Depends: |
||||
R (>= 3.2.0) |
R (>= 3.2.0) |
||||
Imports: |
Imports: |
||||
httr, |
ggplot2, |
||||
jsonlite |
grid, |
||||
|
scales |
||||
RoxygenNote: 6.0.1.9000 |
RoxygenNote: 6.0.1.9000 |
||||
|
@ -1,4 +1,40 @@ |
|||||
# Generated by roxygen2: do not edit by hand |
# Generated by roxygen2: do not edit by hand |
||||
|
|
||||
import(httr) |
export(GeomWtg) |
||||
importFrom(jsonlite,fromJSON) |
export(geom_wtg) |
||||
|
export(wtg) |
||||
|
importFrom(ggplot2,"%+replace%") |
||||
|
importFrom(ggplot2,Geom) |
||||
|
importFrom(ggplot2,GeomRect) |
||||
|
importFrom(ggplot2,Stat) |
||||
|
importFrom(ggplot2,aes) |
||||
|
importFrom(ggplot2,aes_) |
||||
|
importFrom(ggplot2,aes_string) |
||||
|
importFrom(ggplot2,coord_equal) |
||||
|
importFrom(ggplot2,draw_key_polygon) |
||||
|
importFrom(ggplot2,element_blank) |
||||
|
importFrom(ggplot2,element_rect) |
||||
|
importFrom(ggplot2,element_text) |
||||
|
importFrom(ggplot2,geom_point) |
||||
|
importFrom(ggplot2,geom_text) |
||||
|
importFrom(ggplot2,geom_tile) |
||||
|
importFrom(ggplot2,ggplot) |
||||
|
importFrom(ggplot2,ggplotGrob) |
||||
|
importFrom(ggplot2,ggproto) |
||||
|
importFrom(ggplot2,ggtitle) |
||||
|
importFrom(ggplot2,guides) |
||||
|
importFrom(ggplot2,labs) |
||||
|
importFrom(ggplot2,layer) |
||||
|
importFrom(ggplot2,margin) |
||||
|
importFrom(ggplot2,rel) |
||||
|
importFrom(ggplot2,resolution) |
||||
|
importFrom(ggplot2,scale_color_manual) |
||||
|
importFrom(ggplot2,scale_fill_brewer) |
||||
|
importFrom(ggplot2,scale_fill_manual) |
||||
|
importFrom(ggplot2,scale_x_continuous) |
||||
|
importFrom(ggplot2,scale_y_continuous) |
||||
|
importFrom(ggplot2,scale_y_reverse) |
||||
|
importFrom(ggplot2,theme) |
||||
|
importFrom(ggplot2,theme_bw) |
||||
|
importFrom(grid,unit) |
||||
|
importFrom(scales,alpha) |
||||
|
@ -0,0 +1,153 @@ |
|||||
|
stat_wtg <- ggplot2::stat_identity |
||||
|
StatWtg <- ggplot2::StatIdentity |
||||
|
|
||||
|
#' World Tile Grid Geom |
||||
|
#' |
||||
|
#' Pass in a data frame of countries (iso2c, i23c, name) and a value column and |
||||
|
#' get back a world tile grid. |
||||
|
#' |
||||
|
#' **IMPORTANT** : For now, you need to pass in a _complete_ set of countries |
||||
|
#' (the values can be `NA`). When I get time I'll work on this limitation but |
||||
|
#' there's a [wtg] data frame exported from the package that you can use |
||||
|
#' to merge with your data to ensure you've got all the tiles. |
||||
|
#' |
||||
|
#' **ALSO** : Labeling world tile grids is a tricky business and no labeling |
||||
|
#' parameters are planned for this since you should think very carefully about |
||||
|
#' the tradeoffs of tiny text/numbers vs readability. These charts are really |
||||
|
#' only good for overviews in single-chart form or highlighting stark differences |
||||
|
#' in panel-form. |
||||
|
#' |
||||
|
#' \cr |
||||
|
#' There are two special/critical `aes()` mappings:\cr |
||||
|
#' \cr |
||||
|
#' - `country` (so the geom knows which column to map the country names/abbrevs to) |
||||
|
#' - `fill` (which column you're mapping the filling for the squares with) |
||||
|
#' |
||||
|
#' @md |
||||
|
#' @param mapping Set of aesthetic mappings created by `aes()` or |
||||
|
#' `aes_()`. If specified and `inherit.aes = TRUE` (the |
||||
|
#' default), it is combined with the default mapping at the top level of the |
||||
|
#' plot. You must supply `mapping` if there is no plot mapping. |
||||
|
#' @param data The data to be displayed in this layer. There are three |
||||
|
#' options: |
||||
|
#' |
||||
|
#' If `NULL`, the default, the data is inherited from the plot |
||||
|
#' data as specified in the call to `ggplot()`. |
||||
|
#' |
||||
|
#' A `data.frame`, or other object, will override the plot |
||||
|
#' data. All objects will be fortified to produce a data frame. See |
||||
|
#' `fortify()` for which variables will be created. |
||||
|
#' |
||||
|
#' A `function` will be called with a single argument, |
||||
|
#' the plot data. The return value must be a `data.frame.`, and |
||||
|
#' will be used as the layer data. |
||||
|
#' @param border_col border color of the state squares, default "`white`" |
||||
|
#' @param border_size thickness of the square state borders |
||||
|
#' @param na.rm If `FALSE`, the default, missing values are removed with |
||||
|
#' a warning. If `TRUE`, missing values are silently removed. |
||||
|
#' @param ... other arguments passed on to `layer()`. These are |
||||
|
#' often aesthetics, used to set an aesthetic to a fixed value, like |
||||
|
#' `color = "red"` or `size = 3`. They may also be parameters |
||||
|
#' to the paired geom/stat. |
||||
|
#' @param show.legend logical. Should this layer be included in the legends? |
||||
|
#' `NA`, the default, includes if any aesthetics are mapped. |
||||
|
#' `FALSE` never includes, and `TRUE` always includes. |
||||
|
#' It can also be a named logical vector to finely select the aesthetics to |
||||
|
#' display. |
||||
|
#' @param inherit.aes If `FALSE`, overrides the default aesthetics, |
||||
|
#' rather than combining with them. This is most useful for helper functions |
||||
|
#' that define both data and aesthetics and shouldn't inherit behaviour from |
||||
|
#' the default plot specification, e.g. `borders()`. |
||||
|
#' @export |
||||
|
geom_wtg <- function( |
||||
|
mapping = NULL, data = NULL, |
||||
|
border_col = "white", border_size = 0.125, |
||||
|
..., |
||||
|
na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) { |
||||
|
|
||||
|
ggplot2::layer( |
||||
|
data = data, |
||||
|
mapping = mapping, |
||||
|
stat = "wtg", |
||||
|
geom = GeomWtg, |
||||
|
position = "identity", |
||||
|
show.legend = show.legend, |
||||
|
inherit.aes = inherit.aes, |
||||
|
params = list( |
||||
|
border_col = border_col, |
||||
|
border_size = border_size, |
||||
|
na.rm = na.rm, |
||||
|
... |
||||
|
) |
||||
|
) |
||||
|
|
||||
|
} |
||||
|
|
||||
|
#' @rdname geom_wtg |
||||
|
#' @export |
||||
|
GeomWtg <- ggplot2::ggproto( |
||||
|
`_class` = "GeomWtg", |
||||
|
`_inherit` = ggplot2::Geom, |
||||
|
|
||||
|
default_aes = ggplot2::aes( |
||||
|
country = "country", |
||||
|
fill = NA, colour = NA, alpha = NA, |
||||
|
size = 0.1, linetype = 1, width = NA, height = NA |
||||
|
), |
||||
|
|
||||
|
required_aes = c("country", "fill"), |
||||
|
|
||||
|
extra_params = c("na.rm", "width", "height"), |
||||
|
|
||||
|
setup_data = function(data, params) { |
||||
|
|
||||
|
country_data <- data.frame(data, stringsAsFactors=FALSE) |
||||
|
|
||||
|
if (max(nchar(country_data[["country"]])) == 3) { |
||||
|
merge.x <- "alpha.3" |
||||
|
} else if (max(nchar(country_data[["country"]])) == 2) { |
||||
|
merge.x <- "alpha.2" |
||||
|
} else { |
||||
|
merge.x <- "name" |
||||
|
} |
||||
|
|
||||
|
country_data <- validate_countries(country_data, "country", merge.x, ignore_dups=TRUE) |
||||
|
|
||||
|
merge( |
||||
|
wtg, country_data, by.x=merge.x, by.y="country", all.x=TRUE, sort=TRUE |
||||
|
) -> wtg.dat |
||||
|
|
||||
|
wtg.dat$country <- wtg.dat[[merge.x]] |
||||
|
|
||||
|
wtg.dat$width <- wtg.dat$width %||% params$width %||% ggplot2::resolution(wtg.dat$x, FALSE) |
||||
|
wtg.dat$height <- wtg.dat$height %||% params$height %||% ggplot2::resolution(wtg.dat$y, FALSE) |
||||
|
|
||||
|
transform(wtg.dat, |
||||
|
xmin = x - width / 2, xmax = x + width / 2, width = NULL, |
||||
|
ymin = y - height / 2, ymax = y + height / 2, height = NULL |
||||
|
) -> xdat |
||||
|
|
||||
|
xdat |
||||
|
|
||||
|
}, |
||||
|
|
||||
|
draw_panel = function(self, data, panel_params, coord, |
||||
|
border_col = "white", border_size = 0.125) { |
||||
|
|
||||
|
tile_data <- data |
||||
|
tile_data$size <- border_size |
||||
|
tile_data$colour <- border_col |
||||
|
|
||||
|
coord <- ggplot2::coord_equal() |
||||
|
|
||||
|
grid::gList( |
||||
|
GeomTile$draw_panel(tile_data, panel_params, coord) |
||||
|
) -> grobs |
||||
|
|
||||
|
ggname("geom_wtg", grid::grobTree(children = grobs)) |
||||
|
|
||||
|
}, |
||||
|
|
||||
|
draw_key = ggplot2::draw_key_polygon |
||||
|
|
||||
|
) |
Binary file not shown.
@ -0,0 +1,56 @@ |
|||||
|
# Name ggplot grid object |
||||
|
# Convenience function to name grid objects |
||||
|
# |
||||
|
# @keyword internal |
||||
|
ggname <- function(prefix, grob) { |
||||
|
grob$name <- grid::grobName(grob, prefix) |
||||
|
grob |
||||
|
} |
||||
|
|
||||
|
|
||||
|
.sb_invert <- function(hex_color, dark_color="black", light_color="white", |
||||
|
na_color="white") { |
||||
|
|
||||
|
hex_color <- gsub("#", "", hex_color) |
||||
|
|
||||
|
R <- suppressWarnings(as.integer(paste("0x", substr(hex_color,1,2), sep=""))) |
||||
|
G <- suppressWarnings(as.integer(paste("0x", substr(hex_color,3,4), sep=""))) |
||||
|
B <- suppressWarnings(as.integer(paste("0x", substr(hex_color,5,6), sep=""))) |
||||
|
|
||||
|
YIQ <- ((R*299) + (G*587) + (B*114)) / 1000 |
||||
|
|
||||
|
return( |
||||
|
ifelse(is.na(YIQ), na_color, |
||||
|
ifelse( |
||||
|
YIQ >= 128, dark_color, light_color) |
||||
|
) |
||||
|
) |
||||
|
} |
||||
|
|
||||
|
# sanity checks for country values |
||||
|
validate_countries <- function(country_data, country_col, merge.x, ignore_dups=FALSE) { |
||||
|
|
||||
|
good_ccs <- country_data[[country_col]] %in% wtg[[merge.x]] |
||||
|
|
||||
|
if (any(!good_ccs)) { |
||||
|
invalid <- country_data[[country_col]][which(!good_ccs)] |
||||
|
country_data <- country_data[which(good_ccs),] |
||||
|
warning(sprintf("Found invalid country values: %s", paste0(invalid, collapse=", "))) |
||||
|
} |
||||
|
|
||||
|
if (!ignore_dups) { |
||||
|
dups <- duplicated(country_data[,country_col]) |
||||
|
if (any(dups)) { |
||||
|
country_data <- country_data[which(!dups),] |
||||
|
warning("Removing duplicate country rows") |
||||
|
} |
||||
|
} |
||||
|
|
||||
|
return(country_data) |
||||
|
|
||||
|
} |
||||
|
|
||||
|
|
||||
|
"%||%" <- function(a, b) { if (!is.null(a)) a else b } |
||||
|
|
||||
|
.pt <- 2.84527559055118 |
@ -1,12 +1,30 @@ |
|||||
#' ... |
#' A ggplot2 Geom for World Tile Grids |
||||
#' |
#' |
||||
|
#' - Ref: <https://policyviz.com/2017/10/12/the-world-tile-grid-map/> |
||||
|
#' - Ref: <http://www.maartenlambrechts.com/2017/10/22/tutorial-a-worldtilegrid-with-ggplot2.html> |
||||
|
# |
||||
#' - URL: <https://gitlab.com/hrbrmstr/worldtilegrid> |
#' - URL: <https://gitlab.com/hrbrmstr/worldtilegrid> |
||||
#' - BugReports: <https://gitlab.com/hrbrmstr/worldtilegrid/issues> |
#' - BugReports: <https://gitlab.com/hrbrmstr/worldtilegrid/issues> |
||||
#' |
#' |
||||
#' @md |
#' @md |
||||
#' @name worldtilegrid |
#' @name worldtilegrid |
||||
#' @docType package |
#' @docType package |
||||
#' @author Bob Rudis (bob@@rud.is) |
#' @author Bob Rudis (bob@@rud.is) |
||||
#' @import httr |
#' @author Maarten Lambrechts |
||||
#' @importFrom jsonlite fromJSON |
#' @author Jon Schwabish |
||||
|
#' @importFrom grid unit |
||||
|
#' @importFrom scales alpha |
||||
|
#' @importFrom ggplot2 ggplot geom_tile scale_fill_manual guides geom_tile ggplotGrob |
||||
|
#' @importFrom ggplot2 geom_point geom_text scale_color_manual guides theme labs |
||||
|
#' @importFrom ggplot2 scale_x_continuous scale_y_continuous coord_equal theme_bw |
||||
|
#' @importFrom ggplot2 aes element_rect element_blank element_text resolution |
||||
|
#' @importFrom ggplot2 aes_string aes_ scale_y_reverse layer GeomRect margin %+replace% |
||||
|
#' @importFrom ggplot2 scale_fill_brewer ggtitle rel ggproto draw_key_polygon Geom Stat |
||||
NULL |
NULL |
||||
|
|
||||
|
|
||||
|
#' @title World Tile Grid Basemap Data |
||||
|
#' @docType data |
||||
|
#' @name wtg |
||||
|
#' @export |
||||
|
NULL |
@ -1,2 +1,75 @@ |
|||||
# worldtilegrid |
|
||||
|
|
||||
|
# worldtilegrid \[WIP\] |
||||
|
|
||||
|
A ggplot2 Geom for World Tile Grids |
||||
|
|
||||
|
## Description |
||||
|
|
||||
|
- Ref: <https://policyviz.com/2017/10/12/the-world-tile-grid-map/> |
||||
|
- Ref: |
||||
|
<http://www.maartenlambrechts.com/2017/10/22/tutorial-a-worldtilegrid-with-ggplot2.html> |
||||
|
|
||||
|
## What’s Inside The Tin |
||||
|
|
||||
|
The following functions are implemented: |
||||
|
|
||||
|
- `geom_wtg`: World Tile Grid Geom |
||||
|
|
||||
|
The following *data* is included/exported: |
||||
|
|
||||
|
`wtg`: World Tile Grid Basemap Data |
||||
|
|
||||
|
## Installation |
||||
|
|
||||
|
``` r |
||||
|
devtools::install_github("hrbrmstr/worldtilegrid") |
||||
|
``` |
||||
|
|
||||
|
## Usage |
||||
|
|
||||
|
``` r |
||||
|
library(worldtilegrid) |
||||
|
|
||||
|
# current verison |
||||
|
packageVersion("worldtilegrid") |
||||
|
``` |
||||
|
|
||||
|
## [1] '0.1.0' |
||||
|
|
||||
|
### Example |
||||
|
|
||||
|
``` r |
||||
|
library(worldtilegrid) |
||||
|
library(tidyverse) |
||||
|
|
||||
|
set.seed(1) |
||||
|
data_frame( |
||||
|
ctry = worldtilegrid::wtg$alpha.3, |
||||
|
`Thing Val` = sample(1000, length(ctry)), |
||||
|
grp = 'Thing One' |
||||
|
) -> xdf1 |
||||
|
|
||||
|
data_frame( |
||||
|
ctry = worldtilegrid::wtg$alpha.3, |
||||
|
`Thing Val` = sample(1000, length(ctry)), |
||||
|
grp = 'Thing Two' |
||||
|
) -> xdf2 |
||||
|
|
||||
|
bind_rows( |
||||
|
xdf1, |
||||
|
xdf2 |
||||
|
) -> xdf |
||||
|
|
||||
|
ggplot(xdf, aes(country = ctry, fill = `Thing Val`)) + |
||||
|
geom_wtg() + |
||||
|
coord_equal() + |
||||
|
facet_wrap(~grp) + |
||||
|
viridis::scale_fill_viridis() + |
||||
|
labs(title = "World Tile Grid Facets") + |
||||
|
hrbrthemes::theme_ft_rc(grid="") + |
||||
|
theme(panel.border = element_rect(color=hrbrthemes::ft_cols$white, fill="#00000000")) + |
||||
|
theme(axis.text = element_blank()) + |
||||
|
theme(legend.position = "bottom") |
||||
|
``` |
||||
|
|
||||
|
![](README_files/figure-gfm/unnamed-chunk-4-1.png)<!-- --> |
||||
|
After Width: | Height: | Size: 44 KiB |
Binary file not shown.
@ -0,0 +1,83 @@ |
|||||
|
% Generated by roxygen2: do not edit by hand |
||||
|
% Please edit documentation in R/geom_wtg.R |
||||
|
\docType{data} |
||||
|
\name{geom_wtg} |
||||
|
\alias{geom_wtg} |
||||
|
\alias{GeomWtg} |
||||
|
\title{World Tile Grid Geom} |
||||
|
\format{An object of class \code{GeomWtg} (inherits from \code{Geom}, \code{ggproto}, \code{gg}) of length 7.} |
||||
|
\usage{ |
||||
|
geom_wtg(mapping = NULL, data = NULL, border_col = "white", |
||||
|
border_size = 0.125, ..., na.rm = FALSE, show.legend = NA, |
||||
|
inherit.aes = TRUE) |
||||
|
|
||||
|
GeomWtg |
||||
|
} |
||||
|
\arguments{ |
||||
|
\item{mapping}{Set of aesthetic mappings created by \code{aes()} or |
||||
|
\code{aes_()}. If specified and \code{inherit.aes = TRUE} (the |
||||
|
default), it is combined with the default mapping at the top level of the |
||||
|
plot. You must supply \code{mapping} if there is no plot mapping.} |
||||
|
|
||||
|
\item{data}{The data to be displayed in this layer. There are three |
||||
|
options: |
||||
|
|
||||
|
If \code{NULL}, the default, the data is inherited from the plot |
||||
|
data as specified in the call to \code{ggplot()}. |
||||
|
|
||||
|
A \code{data.frame}, or other object, will override the plot |
||||
|
data. All objects will be fortified to produce a data frame. See |
||||
|
\code{fortify()} for which variables will be created. |
||||
|
|
||||
|
A \code{function} will be called with a single argument, |
||||
|
the plot data. The return value must be a \code{data.frame.}, and |
||||
|
will be used as the layer data.} |
||||
|
|
||||
|
\item{border_col}{border color of the state squares, default "\code{white}"} |
||||
|
|
||||
|
\item{border_size}{thickness of the square state borders} |
||||
|
|
||||
|
\item{...}{other arguments passed on to \code{layer()}. These are |
||||
|
often aesthetics, used to set an aesthetic to a fixed value, like |
||||
|
\code{color = "red"} or \code{size = 3}. They may also be parameters |
||||
|
to the paired geom/stat.} |
||||
|
|
||||
|
\item{na.rm}{If \code{FALSE}, the default, missing values are removed with |
||||
|
a warning. If \code{TRUE}, missing values are silently removed.} |
||||
|
|
||||
|
\item{show.legend}{logical. Should this layer be included in the legends? |
||||
|
\code{NA}, the default, includes if any aesthetics are mapped. |
||||
|
\code{FALSE} never includes, and \code{TRUE} always includes. |
||||
|
It can also be a named logical vector to finely select the aesthetics to |
||||
|
display.} |
||||
|
|
||||
|
\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, |
||||
|
rather than combining with them. This is most useful for helper functions |
||||
|
that define both data and aesthetics and shouldn't inherit behaviour from |
||||
|
the default plot specification, e.g. \code{borders()}.} |
||||
|
} |
||||
|
\description{ |
||||
|
Pass in a data frame of countries (iso2c, i23c, name) and a value column and |
||||
|
get back a world tile grid. |
||||
|
} |
||||
|
\details{ |
||||
|
\strong{IMPORTANT} : For now, you need to pass in a \emph{complete} set of countries |
||||
|
(the values can be \code{NA}). When I get time I'll work on this limitation but |
||||
|
there's a \link{wtg} data frame exported from the package that you can use |
||||
|
to merge with your data to ensure you've got all the tiles. |
||||
|
|
||||
|
\strong{ALSO} : Labeling world tile grids is a tricky business and no labeling |
||||
|
parameters are planned for this since you should think very carefully about |
||||
|
the tradeoffs of tiny text/numbers vs readability. These charts are really |
||||
|
only good for overviews in single-chart form or highlighting stark differences |
||||
|
in panel-form. |
||||
|
|
||||
|
\cr |
||||
|
There are two special/critical \code{aes()} mappings:\cr |
||||
|
\cr |
||||
|
\itemize{ |
||||
|
\item \code{country} (so the geom knows which column to map the country names/abbrevs to) |
||||
|
\item \code{fill} (which column you're mapping the filling for the squares with) |
||||
|
} |
||||
|
} |
||||
|
\keyword{datasets} |
@ -0,0 +1,9 @@ |
|||||
|
% Generated by roxygen2: do not edit by hand |
||||
|
% Please edit documentation in R/worldtilegrid-package.R |
||||
|
\docType{data} |
||||
|
\name{wtg} |
||||
|
\alias{wtg} |
||||
|
\title{World Tile Grid Basemap Data} |
||||
|
\description{ |
||||
|
World Tile Grid Basemap Data |
||||
|
} |
Loading…
Reference in new issue