Ecosyste.ms: Awesome

An open API service indexing awesome lists of open source software.

Awesome Lists | Featured Topics | Projects

https://github.com/statnmap/waffler

wafflerize points data
https://github.com/statnmap/waffler

Last synced: about 2 months ago
JSON representation

wafflerize points data

Awesome Lists containing this project

README

        

---
output: github_document
---

```{r setup, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.path = "man/figures/README-",
out.width = "50%",
fig.align = "center"
)
```
# waffler

The goal of waffler is to generate the world largest waffles as interactive spatial grid.

```{r}
knitr::include_graphics("img/gaufre-au-caramel-beurre-sale.jpg")
```

> See the related SatRdays Paris presentation to understand the origin:

## Installation

You can install the released version of waffler from github with:

``` r
# install.packages("remotes")
remotes::install_github("ThinkR-open/waffler")
```

## Example

### Rasters are polygons (waffles too...)

**How to render interactive grid quickly?**

- Build a heart polygon waffle with {sf}
+ Create regular grid from polygon: `st_sample`
+ Generate more or less chocolate
+ Create polygon grid with correct `crs` to avoid deformation on leaflet

```{r}
library(waffler)
library(dplyr)
library(sf)
library(leaflet)
library(leafgl)
library(ggplot2)
library(scales)

# Construct heart (code from @dmarcelinobr)
xhrt <- function(t) 16 * sin(t)^3
yhrt <- function(t) 13 * cos(t) - 5 * cos(2 * t) - 2 * cos(3 * t) - cos(4 * t)

# create heart as polygon
heart_sf <- tibble(t = seq(0, 2 * pi, by = .1)) %>%
mutate(y = yhrt(t),
x = xhrt(t)) %>%
bind_rows(., head(., 1)) %>%
select(x, y) %>%
as.matrix() %>%
list() %>% st_polygon() %>%
st_sfc(crs = 2154)

g1 <- ggplot(heart_sf) +
geom_sf(fill = "#cb181d") +
coord_sf(crs = 2154, datum = 2154) +
ggtitle("Heart sf polygon")

# create grid
heart_grid <- st_sample(heart_sf, size = 500, type = "regular") %>%
cbind(as.data.frame(st_coordinates(.))) %>%
rename(x = X, y = Y) %>%
st_sf() %>%
mutate(z = cos(2*x) - cos(x) + sin(y),
z_text = as.character(round(z)))

g2 <- ggplot(heart_grid) +
geom_sf(colour = "#cb181d") +
coord_sf(crs = 2154, datum = 2154) +
ggtitle("Heart as regular point grid")

g3 <- ggplot(heart_grid) +
geom_sf(aes(colour = z), size = 2) +
scale_colour_distiller(palette = "YlOrBr", type = "seq", direction = 1) +
theme(panel.background = element_rect(fill = "#000000")) +
coord_sf(crs = 2154, datum = 2154) +
guides(colour = FALSE) +
ggtitle("Chocolate quantity for each point")
```

- Generate a grid polygon from points with `wafflerize`

```{r, out.width = "100%", fig.width=14, fig.height=5}
heart_polygon <- wafflerize(heart_grid, fact = 1000)

g4 <- ggplot(heart_polygon) +
geom_sf(aes(fill = z), colour = NA) +
scale_fill_distiller(palette = "YlOrBr", type = "seq", direction = 1) +
theme(panel.background = element_rect(fill = "#000000")) +
coord_sf(crs = 4326, datum = 4326) +
guides(fill = FALSE) +
ggtitle("Chocolate quantity in each cell")

cowplot::plot_grid(g1, g2, g3, g4, ncol = 4)

```

- Quick print with {leafgl} (*prev. {leaflet.glify}*): `addGlPolygons`

```{r}
# Define colors for `addGlPolygons`
cols <- brewer_pal(palette = "YlOrBr", type = "seq")(7)
colours <- gradient_n_pal(cols)(rescale(heart_polygon$z))
colours_rgb <- (t(col2rgb(colours, alpha = FALSE))/255) %>% as.data.frame()

# Render as leaflet
m <- leaflet() %>%
addGlPolygons(data = heart_polygon,
color = colours_rgb,
popup = "z_text",
opacity = 1) %>%
setView(lng = mean(st_bbox(heart_polygon)[c(1,3)]),
lat = mean(st_bbox(heart_polygon)[c(2,4)]), zoom = 10)

# m
```

*High resolution leaflet polygons*
```{r satrday-paris-27}
knitr::include_graphics("img/leaflet_heart_big.png")
```