Nothing
## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
## ----setup, message=FALSE-----------------------------------------------------
library(tilemaps)
library(sf)
library(dplyr)
library(ggplot2)
## ----fig.height=3,fig.width=4,fig.align='center'------------------------------
governors <- governors %>%
mutate(tile_map = generate_map(geometry, square = FALSE, flat_topped = TRUE))
ggplot(governors) +
geom_sf(aes(geometry = tile_map)) +
geom_sf_text(aes(geometry = tile_map, label = abbreviation),
fun.geometry = function(x) st_centroid(x)) +
theme_void()
## ----fig.height=3,fig.width=4,fig.align='center'------------------------------
all_states <- governors %>%
add_row(abbreviation = "AK", party = "Republican",
tile_map = create_island(governors$tile_map, "lower left")) %>%
add_row(abbreviation = "HI", party = "Democrat",
tile_map = create_island(governors$tile_map, c(-12050000, 3008338)))
ggplot(all_states) +
geom_sf(aes(geometry = tile_map)) +
geom_sf_text(aes(geometry = tile_map, label = abbreviation),
fun.geometry = function(x) st_centroid(x)) +
theme_void()
## ----echo=FALSE---------------------------------------------------------------
all_states <- all_states %>%
mutate(party = factor(party, c("Republican", "Democrat")))
## ----fig.height=4.5, fig.width=5.5, fig.align='center'------------------------
ggplot(all_states) +
geom_sf(aes(geometry = tile_map, fill = party)) +
geom_sf_text(aes(geometry = tile_map, label = abbreviation),
fun.geometry = function(x) st_centroid(x)) +
scale_fill_brewer(palette = "Set1") +
ggtitle("Party Affiliation of United States Governors (2020)") +
theme_void()
## ----eval=FALSE---------------------------------------------------------------
# st_write(governors$tile_map, "us_tilemap.shp")
## ----fig.height=6, fig.width=7, fig.align='center'----------------------------
us_maps <- many_maps(governors$geometry, governors$abbreviation,
prop = c(0, 0.1), interpolate = c(0.5, 1),
smoothness = c(0, 20), shift = list(c(0,0), c(0,0.5)))
## ----fig.height=3, fig.width=4, fig.align='center'----------------------------
governors <- governors %>%
mutate(square_map = us_maps$map[[1]])
ggplot(governors) +
geom_sf(aes(geometry = square_map)) +
geom_sf_text(aes(geometry = square_map, label = abbreviation)) +
theme_void()
## ----eval=FALSE---------------------------------------------------------------
# plot_many_maps(us_maps$map, governors$abbreviation)
## ----echo=FALSE, fig.height=5, fig.width=6, fig.align='center'----------------
neighbors <- st_touches(governors$geometry)
crs <- st_crs(governors$geometry)
R <- length(governors$geometry)
A <- sum(st_area(governors$geometry))
s <- as.numeric(sqrt(A/R))
centroids <- tilemaps:::transform_centroids(governors$geometry, neighbors, crs, s, prop = 0.1)
interpolated_centroids <- tilemaps:::interpolate_centroids(centroids$noisy_centroids,
centroids$transformed_centroids,
crs, interpolate = 0.75)
centroids_df <- data.frame(st_coordinates(c(centroids$noisy_centroids,
centroids$transformed_centroids,
interpolated_centroids)))
centroids_df <- centroids_df %>%
mutate(centroids = c(rep("noisy", nrow(governors)),
rep("fully-transformed", nrow(governors)),
rep("interpolated", nrow(governors))),
region = rep(governors$abbreviation, 3))
centroids_df$centroids <- factor(centroids_df$centroids, c("noisy", "interpolated",
"fully-transformed"))
ggplot(governors) +
geom_sf(aes(geometry = geometry)) +
geom_point(data = centroids_df, aes(X, Y, color = centroids)) +
geom_line(data = centroids_df, aes(X,Y, group = region)) +
scale_color_brewer(palette = "YlGnBu") +
theme_void()
## ----echo=FALSE, fig.height=3, fig.width=6, fig.align='center'----------------
transformed_boundary <- tilemaps:::transform_boundary(governors$geometry, centroids$noisy_centroids,
interpolated_centroids)
smoothed_boundary <- smoothr::smooth(transformed_boundary, method = "ksmooth",
smoothness = 20)
transformed_coords <- data.frame(st_coordinates(st_boundary(transformed_boundary)))
smoothed_coords <- data.frame(st_coordinates(st_boundary(smoothed_boundary)))
original_coords <- data.frame(st_coordinates(st_boundary(st_union(governors$geometry))))
legend_order <- c("original", "transformed", "smoothed")
ggplot() +
geom_path(data = original_coords, aes(X,Y, group = L1, color = "original")) +
geom_path(data = transformed_coords, aes(X,Y, group = L1, color = "transformed")) +
geom_path(data = smoothed_coords, aes(X,Y, group = L1, color = "smoothed")) +
theme_void() +
scale_color_discrete(name = "boundary", breaks = legend_order)
## ----echo=FALSE---------------------------------------------------------------
tiles <- tilemaps:::fit_tiles(smoothed_boundary, nrow(governors),
s, shift = c(0.5,0.5))
## ----echo=FALSE, fig.height=3, fig.width=4, fig.align='center'----------------
permutation <- tilemaps:::assign_regions(interpolated_centroids, sf::st_centroid(tiles))
final_map <- tiles[order(permutation)]
governors <- governors %>%
mutate(map = final_map)
ggplot(governors) +
geom_sf(aes(geometry = map)) +
geom_sf_text(aes(geometry = map, label = abbreviation)) +
theme_void()
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.