Browse Source

initial commit/quick hack

master
boB Rudis 6 years ago
parent
commit
ba5b40ce66
No known key found for this signature in database GPG Key ID: 1D7529BE14E2BBA9
  1. 16
      DESCRIPTION
  2. 40
      NAMESPACE
  3. 153
      R/geom_wtg.R
  4. BIN
      R/sysdata.rda
  5. 56
      R/utils.R
  6. 28
      R/worldtilegrid-package.R
  7. 49
      README.Rmd
  8. 75
      README.md
  9. BIN
      README_files/figure-gfm/unnamed-chunk-4-1.png
  10. BIN
      data/wtg.rda
  11. 83
      man/geom_wtg.Rd
  12. 8
      man/worldtilegrid.Rd
  13. 9
      man/wtg.Rd

16
DESCRIPTION

@ -1,24 +1,30 @@
Package: worldtilegrid
Type: Package
Title: worldtilegrid title goes here otherwise CRAN checks fail
Title: A ggplot2 Geom for World Tile Grids
Version: 0.1.0
Date: 2018-08-25
Authors@R: c(
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>
Description: A good description goes here otherwise CRAN checks fail.
Description: A ggplot2 Geom for World Tile Grids
URL: https://gitlab.com/hrbrmstr/worldtilegrid
BugReports: https://gitlab.com/hrbrmstr/worldtilegrid/issues
Encoding: UTF-8
License: AGPL
Suggests:
testthat,
viridis,
RColorBrewer,
covr
Depends:
R (>= 3.2.0)
Imports:
httr,
jsonlite
ggplot2,
grid,
scales
RoxygenNote: 6.0.1.9000

40
NAMESPACE

@ -1,4 +1,40 @@
# Generated by roxygen2: do not edit by hand
import(httr)
importFrom(jsonlite,fromJSON)
export(GeomWtg)
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)

153
R/geom_wtg.R

@ -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
)

BIN
R/sysdata.rda

Binary file not shown.

56
R/utils.R

@ -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

28
R/worldtilegrid-package.R

@ -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>
#' - BugReports: <https://gitlab.com/hrbrmstr/worldtilegrid/issues>
#'
#'
#' @md
#' @name worldtilegrid
#' @docType package
#' @author Bob Rudis (bob@@rud.is)
#' @import httr
#' @importFrom jsonlite fromJSON
#' @author Maarten Lambrechts
#' @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
#' @title World Tile Grid Basemap Data
#' @docType data
#' @name wtg
#' @export
NULL

49
README.Rmd

@ -2,14 +2,25 @@
output: rmarkdown::github_document
---
# 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 eval=FALSE}
@ -30,3 +41,39 @@ packageVersion("worldtilegrid")
```
### Example
```{r message=FALSE, warning=FALSE, error=FALSE, fig.width=10, fig.height=6}
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")
```

75
README.md

@ -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)<!-- -->

BIN
README_files/figure-gfm/unnamed-chunk-4-1.png

Binary file not shown.

After

Width:  |  Height:  |  Size: 44 KiB

BIN
data/wtg.rda

Binary file not shown.

83
man/geom_wtg.Rd

@ -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}

8
man/worldtilegrid.Rd

@ -4,13 +4,19 @@
\name{worldtilegrid}
\alias{worldtilegrid}
\alias{worldtilegrid-package}
\title{...}
\title{A ggplot2 Geom for World Tile Grids}
\description{
\itemize{
\item Ref: \url{https://policyviz.com/2017/10/12/the-world-tile-grid-map/}
\item Ref: \url{http://www.maartenlambrechts.com/2017/10/22/tutorial-a-worldtilegrid-with-ggplot2.html}
\item URL: \url{https://gitlab.com/hrbrmstr/worldtilegrid}
\item BugReports: \url{https://gitlab.com/hrbrmstr/worldtilegrid/issues}
}
}
\author{
Bob Rudis (bob@rud.is)
Maarten Lambrechts
Jon Schwabish
}

9
man/wtg.Rd

@ -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…
Cancel
Save