geofacet-grid.R

library(ggplot2)
library(geofacet)
## the spatial layout for geofacet is a regular grid of row/col
ggplot(geofacet::us_state_grid1, aes(col, max(row) - row + 1, label = label))  + geom_label()

## using raster tricks (and mdsumner/tabularaster) we can take arbitrary spatial data
## into this grid form

library(maptools)

## Loading required package: sp

## Checking rgeos availability: TRUE

data(wrld_simpl)
library(raster)
library(tabularaster)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:raster':
## 
##     intersect, select, union

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

## choose a background grid
rgrid <- raster(extent(-180, 180, -90, 90), crs = projection(wrld_simpl), res = 5)

## identify the coordinate of the input in the background grid, 
## and obtain the row, col, and label
## (remember to flip the row)
wrld_grid <- cellnumbers(rgrid, coordinates(wrld_simpl)) %>% 
  inner_join(wrld_simpl@data %>% select(ISO3) %>% mutate(object_ = row_number())) %>% 
  mutate(row = nrow(rgrid) - rowFromCell(rgrid, cell_) + 1, col = colFromCell(rgrid, cell_)) %>% 
  select(-object_, -cell_) %>% 
  rename(label = ISO3)

## Warning: projections not the same 
##     x: +proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs +towgs84=0,0,0
## query: NA

## Joining, by = "object_"

ggplot(wrld_grid, aes(col, row, label = label))  + geom_label()

## try with a different data set from sf

library(sf)

## Linking to GEOS 3.5.0, GDAL 2.1.0, proj.4 4.8.0

ncarolina <- read_sf(system.file("shape/nc.shp", package="sf"))
ncraster <- raster(spex::spex(ncarolina), res = 0.1)

## Warning in if (class(x) == "character") {: the condition has length > 1 and
## only the first element will be used

## Warning in if (class(x) != "CRS") {: the condition has length > 1 and only
## the first element will be used

nc_grid <- cellnumbers(ncraster, do.call(rbind, lapply(st_centroid(ncarolina)$geometry, unclass))) %>% 
  inner_join(ncarolina %>% select(NAME) %>% mutate(object_ = row_number())) %>% 
  mutate(row = nrow(ncraster) - rowFromCell(ncraster, cell_) + 1, col = colFromCell(ncraster, cell_)) %>% 
  select(-object_, -cell_) %>% 
  rename(label = NAME)

## Warning in st_centroid.sfc(st_geometry(x)): st_centroid does not give
## correct centroids for longitude/latitude data

## Warning: projections not the same 
##     x: NA
## query: NA

## Joining, by = "object_"

ggplot(nc_grid, aes(col, row, label = label))  + geom_label()