Ecosyste.ms: Awesome
An open API service indexing awesome lists of open source software.
https://github.com/statnmap/waffler
wafflerize points data
https://github.com/statnmap/waffler
Last synced: about 2 months ago
JSON representation
wafflerize points data
- Host: GitHub
- URL: https://github.com/statnmap/waffler
- Owner: statnmap
- License: other
- Created: 2019-02-23T22:01:55.000Z (over 5 years ago)
- Default Branch: master
- Last Pushed: 2019-04-02T12:16:02.000Z (over 5 years ago)
- Last Synced: 2024-04-10T06:11:52.345Z (6 months ago)
- Language: R
- Size: 501 KB
- Stars: 7
- Watchers: 6
- Forks: 0
- Open Issues: 0
-
Metadata Files:
- Readme: README.Rmd
- License: LICENSE
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"
)
```
# wafflerThe 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")
```