Last active
October 14, 2021 19:57
-
-
Save seyhunsaral/9001b09c37eba9fe0b87233e926f9bab to your computer and use it in GitHub Desktop.
Density dot ggplot
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ## Replication of https://archive.org/details/ost-geography-completegeograph00sauluoft/page/n574/mode/1up | |
| # Inspired by @PaoloCrosetto's question and @geokaramanis's implementation | |
| # https://twitter.com/PaoloCrosetto/status/1448594997251657731 | |
| # https://twitter.com/geokaramanis/status/1447913599712825349 | |
| library(tidyverse) | |
| countries <- c("Belgium", "England", "Japan", "Italy", "China", "Germany", "France", "India", "Spain", "Phil. Is'ds", "Russia", "Cuba", "U. States", "Mexico", "Hawaii", "C.Colony", "Brazil", "Argentina", "Canada", "Australia") | |
| densities <- c(563,500,284,280,270,250,186,184,89,72,54,36,20,16,16,5,4.5,3,2,1.23) | |
| df <- tibble(country=factor(countries, levels=countries), # Trick to keep the order | |
| density=densities) | |
| #### JITTERED PLOT | |
| # Jittered plot - without styling | |
| plot_jittered <- df %>% | |
| uncount(round(density)) %>% | |
| ggplot(aes(x=0,y=0)) + | |
| geom_jitter() + | |
| facet_wrap(~country) | |
| plot_jittered | |
| # Jittered plot - with styling | |
| plot_jittered + | |
| theme_bw() + | |
| theme(axis.title=element_blank(), | |
| axis.text=element_blank(), | |
| axis.ticks=element_blank()) + | |
| theme(panel.grid.major = element_blank(), | |
| panel.grid.minor = element_blank()) + | |
| theme(plot.background = element_rect(fill = "#EDDCBB"), | |
| panel.background = element_rect(fill = "#EDDCBB")) + | |
| theme(strip.background =element_rect(fill="#EDDCBB")) | |
| # Plot with the density on facet labels | |
| df %>% | |
| mutate(facetlabel=paste(country,density, sep=" ")) %>% | |
| mutate(facetlabel=fct_reorder(facetlabel, order(country))) %>% | |
| uncount(round(density)) %>% | |
| ggplot(aes(x=0,y=0)) + | |
| geom_jitter() + | |
| facet_wrap(~facetlabel, strip.position = "bottom") + | |
| theme_bw() + | |
| theme(axis.title=element_blank(), | |
| axis.text=element_blank(), | |
| axis.ticks=element_blank()) + | |
| theme(panel.grid.major = element_blank(), | |
| panel.grid.minor = element_blank()) + | |
| theme(plot.background = element_rect(fill = "#EDDCBB"), | |
| panel.background = element_rect(fill = "#EDDCBB")) + | |
| theme(strip.background =element_rect(fill="#EDDCBB")) | |
| #### GRID PLOT | |
| plot_grid <- df %>% | |
| mutate(densityround = floor(density)) %>% | |
| mutate(num_x=floor(0.5 +sqrt(density))) %>% | |
| mutate(num_y=ceiling(sqrt(density))) %>% | |
| # Math trick of creating the minimal greater surface from: | |
| # Will Jagy https://math.stackexchange.com/q/714598 | |
| mutate(missing_points = floor(density - num_x * num_y) ) %>% | |
| rowwise() %>% | |
| mutate(x=list(seq(from=-1 ,to=1, length.out=num_x)), | |
| y=list(seq(from=-1 ,to=1, length.out=num_y))) %>% | |
| unnest(x) %>% | |
| unnest(y) %>% | |
| arrange(x,-y) %>% | |
| mutate(x=if_else(num_x < 3, x*0.5,x), # if there are few points make them closer | |
| y=if_else(num_y < 3, y*0.5,y)) %>% # to center | |
| group_by(country) %>% | |
| slice(1:densityround) %>% | |
| ggplot(aes(x=x,y=y)) + | |
| geom_point() + | |
| facet_wrap(~country) | |
| plot_grid | |
| # Grid plot with styles and numbers on facet labels | |
| df %>% | |
| mutate(facetlabel=paste(country,density, sep=" ")) %>% | |
| mutate(facetlabel=fct_reorder(facetlabel, order(country))) %>% | |
| mutate(densityround = floor(density)) %>% | |
| mutate(num_x=floor(0.5 +sqrt(density))) %>% # number of "rows" | |
| mutate(num_y=ceiling(sqrt(density))) %>% # number of "columns" | |
| # Math trick of creating the minimal greater square-like surface from: | |
| # Will Jagy https://math.stackexchange.com/q/714598 | |
| rowwise() %>% | |
| mutate(x=list(seq(from=-1 ,to=1, length.out=num_x)), | |
| y=list(seq(from=-1 ,to=1, length.out=num_y))) %>% | |
| unnest(x) %>% | |
| unnest(y) %>% | |
| arrange(x,-y) %>% # To cut from bottom right. | |
| mutate(x=if_else(num_x < 3, x*0.5,x), # if there are few points make them closer | |
| y=if_else(num_y < 3, y*0.5,y)) %>% # to center | |
| group_by(country) %>% | |
| slice(1:densityround) %>% # take the first n points (slice off the extras) | |
| ggplot(aes(x=x,y=y)) + | |
| geom_point() + | |
| facet_wrap(~country) + | |
| facet_wrap(~facetlabel, strip.position = "bottom") + | |
| theme_bw() + | |
| theme(axis.title=element_blank(), | |
| axis.text=element_blank(), | |
| axis.ticks=element_blank()) + | |
| theme(panel.grid.major = element_blank(), | |
| panel.grid.minor = element_blank()) + | |
| theme(plot.background = element_rect(fill = "#EDDCBB"), | |
| panel.background = element_rect(fill = "#EDDCBB")) + | |
| theme(strip.background =element_rect(fill="#EDDCBB")) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment