initial commit/quick hack

5 years ago · ba5b40ce66
13 changed files with 502 additions and 15 deletions
--- a/16
+++ b/16
@ -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
--- a/40
+++ b/40
@ -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)
--- a/R/geom_wtg.R
+++ b/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
+
+)
--- a/R/sysdata.rda
+++ b/R/sysdata.rda
--- a/R/utils.R
+++ b/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
--- a/R/worldtilegrid-package.R
+++ b/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
--- a/README.Rmd
+++ b/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")
+```
--- a/README.md
+++ b/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)<!-- -->
--- a/README_files/figure-gfm/unnamed-chunk-4-1.png
+++ b/README_files/figure-gfm/unnamed-chunk-4-1.png
--- a/data/wtg.rda
+++ b/data/wtg.rda
--- a/man/geom_wtg.Rd
+++ b/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}
--- a/man/worldtilegrid.Rd
+++ b/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
 }
--- a/man/wtg.Rd
+++ b/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
+}