## ---- 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()