Geofacet plot vingette

Today I am going to try to make a geofacet graph using the GAI (Global Acceptability Index) data. My goal is to show trends in LGBT acceptance in Europe between the years 2003 and 2017.

Sources and tools

library("geofacet")
library("tidyverse")

Data

raw_data <- read_csv("gai.csv")

I did some quick data wrangling in Excel before loading the file. Since the data publication emphasized ranking the countries, the data currently looks like this:

head(raw_data)
## # A tibble: 6 x 8
##   country     gai2003 country_1   gai2008 country_2   gai2013 country_3  gai2017
##   <chr>       <chr>   <chr>       <chr>   <chr>       <chr>   <chr>      <chr>  
## 1 Netherlands 6.8     Netherlands 7.2     Iceland     8.4     Iceland    8.9    
## 2 Sweden      6.7     Sweden      7.1     Netherlands 7.9     Netherlan~ 8.6    
## 3 Denmark     6.7     Iceland     7.1     Spain       7.4     Norway     8.2    
## 4 Iceland     6.3     Uruguay     6.6     Canada      7.4     Canada     8.2    
## 5 Switzerland 6.2     Canada      6.5     Sweden      7.4     Spain      8.1    
## 6 Norway      6.2     Denmark     6.5     Norway      7.3     Belgium    7.9

I wish to have more tidy data. My desired format is

  • input: year
  • output: GAI
  • group: country
# focus on one year at a time
df2003 <- raw_data %>% select(country, gai2003) %>% mutate(year = 2003)
df2008 <- raw_data %>% select(country_1, gai2008) %>% mutate(year = 2008)
df2013 <- raw_data %>% select(country_2, gai2013) %>% mutate(year = 2013)
df2017 <- raw_data %>% select(country_3, gai2017) %>% mutate(year = 2017) 

# use same column names (to prepare to row-bind)
colnames(df2003) <- c("country", "gai", "year")
colnames(df2008) <- c("country", "gai", "year")
colnames(df2013) <- c("country", "gai", "year")
colnames(df2017) <- c("country", "gai", "year")

# row bind the data frames into one data frame
all_data <- rbind(df2003, df2008, df2013, df2017)

# convert column from character to numeric type
all_data$gai <- as.numeric(all_data$gai)
## Warning: NAs introduced by coercion
# take a look at what we have at the moment
head(all_data)
## # A tibble: 6 x 3
##   country       gai  year
##   <chr>       <dbl> <dbl>
## 1 Netherlands   6.8  2003
## 2 Sweden        6.7  2003
## 3 Denmark       6.7  2003
## 4 Iceland       6.3  2003
## 5 Switzerland   6.2  2003
## 6 Norway        6.2  2003

Map

Before we try out the geofacet tech, let us make sure that this data is amenable to ggplot in the first place

all_data %>%
  ggplot(aes(x = year, y = gai, color = country, group = country)) +
  geom_line() +
  labs(title = "Acceptance of LGBT People",
       subtitle = "by country",
       caption = "Data Source: Williams Institute at UCLA",
       x = "Year",
       y = "Global Acceptability Index") +
  theme(legend.position = "none")

As you can imagine, keeping track of and labeling 176 countries is quite cumbersome.


Europe

Instead, today we will focus on the European nations and use the geofacet package to clearly label the countries (with an implied geography map!)

European_nations_text <- "Russia,Germany,France,United Kingdom,Italy,Spain,Ukraine,Poland,Romania,Netherlands,Belgium,Greece,Portugal,Czech Republic,Hungary,Sweden,Belarus,Austria,Switzerland,Bulgaria,Serbia,Denmark,Finland,Slovakia,Norway,Ireland,Croatia,Bosnia and Herzegovina,Moldova,Lithuania,Albania,Macedonia,Slovenia,Latvia,Kosovo,Estonia,Montenegro,Luxembourg,Malta,Iceland,Jersey (UK),Isle of Man (UK),Andorra,Guernsey (UK),Faroe Islands (Denmark),Liechtenstein,Monaco,San Marino,Gibraltar (UK),Aland Islands (Finland),Svalbard and Jan Mayen (Norway),Vatican City"
European_nations_list <- str_split(European_nations_text,",")[[1]]

# an unfortunate 'hack'
all_data$country[all_data$country == "Great Britain"] <- "United Kingdom"

# main plot
all_data %>%
  filter(country %in% European_nations_list) %>%
  ggplot(aes(x = year, y = gai, color = country, group = country)) +
  geom_line() +
  geom_point(size = 2) +
  facet_geo(~ country, grid = "eu_grid1") +
  labs(title = "Social Acceptance of LGBT People in Europe",
       subtitle = "Global Acceptance Index",
       caption = "Data Source: UCLA Williams Institute",
       x = "",
       y = "") +
  scale_x_continuous(breaks = c(2003, 2008, 2013, 2017),
                   labels = c("2003", "2008", "2013", "2017")) +
  scale_y_continuous(breaks = c(0, 2, 4, 6, 8, 10),
                   labels = c("0", "2", "4", "6", "8", "10")) +
  theme(axis.text.x = element_text(angle = 90),
        legend.position = "none",
        panel.background = element_rect(fill = "white"),
        panel.border = element_rect(color = "black", fill = NA))

all_data %>%
  filter(country %in% European_nations_list) %>%
  ggplot(aes(x = year, y = gai, color = country, group = country)) +
  geom_line() +
  geom_point(size = 4) +
  facet_geo(~ country, grid = "eu_grid1") +
  labs(title = "Social Acceptance of LGBT People in Europe",
       subtitle = "Global Acceptance Index",
       caption = "Data Source: UCLA Williams Institute",
       x = "",
       y = "") +
  scale_x_continuous(breaks = c(2003, 2008, 2013, 2017),
                   labels = c("2003", "2008", "2013", "2017")) +
  scale_y_continuous(breaks = c(0, 2, 4, 6, 8, 10),
                   labels = c("0", "2", "4", "6", "8", "10")) +
  theme(axis.text.x = element_text(angle = 90),
        legend.position = "none",
        panel.background = element_rect(fill = "white"),
        panel.border = element_rect(color = "black", fill = NA),
        panel.grid = element_line(color = "gray80"))
## Some values in the specified facet_geo column 'country' do not match
##   the 'name' column of the specified grid and will be removed: Iceland,
##   Switzerland, Norway, Andorra, Serbia, Macedonia, Russia, Belarus,
##   Ukraine, Montenegro, Moldova, Albania, Kosovo

sessionInfo()
## R version 4.0.0 (2020-04-24)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 18362)
## 
## Matrix products: default
## 
## locale:
## [1] LC_COLLATE=English_United States.1252 
## [2] LC_CTYPE=English_United States.1252   
## [3] LC_MONETARY=English_United States.1252
## [4] LC_NUMERIC=C                          
## [5] LC_TIME=English_United States.1252    
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] forcats_0.5.0   stringr_1.4.0   dplyr_0.8.5     purrr_0.3.4    
##  [5] readr_1.3.1     tidyr_1.0.2     tibble_3.0.1    ggplot2_3.3.0  
##  [9] tidyverse_1.3.0 geofacet_0.2.0 
## 
## loaded via a namespace (and not attached):
##  [1] ggrepel_0.8.2       Rcpp_1.0.4.6        rnaturalearth_0.1.0
##  [4] lubridate_1.7.8     lattice_0.20-41     png_0.1-7          
##  [7] class_7.3-16        utf8_1.1.4          assertthat_0.2.1   
## [10] digest_0.6.25       R6_2.4.1            cellranger_1.1.0   
## [13] backports_1.1.6     reprex_0.3.0        evaluate_0.14      
## [16] e1071_1.7-3         httr_1.4.1          blogdown_0.18      
## [19] pillar_1.4.4        rlang_0.4.5         geogrid_0.1.1      
## [22] readxl_1.3.1        rstudioapi_0.11     rmarkdown_2.1      
## [25] labeling_0.3        munsell_0.5.0       broom_0.5.6        
## [28] compiler_4.0.0      modelr_0.1.7        xfun_0.13          
## [31] pkgconfig_2.0.3     imguR_1.0.3         rgeos_0.5-3        
## [34] htmltools_0.4.0     tidyselect_1.0.0    gridExtra_2.3      
## [37] bookdown_0.18       fansi_0.4.1         withr_2.2.0        
## [40] crayon_1.3.4        dbplyr_1.4.3        sf_0.9-3           
## [43] grid_4.0.0          nlme_3.1-147        jsonlite_1.6.1     
## [46] gtable_0.3.0        lifecycle_0.2.0     DBI_1.1.0          
## [49] magrittr_1.5        units_0.6-6         scales_1.1.0       
## [52] KernSmooth_2.23-16  cli_2.0.2           stringi_1.4.6      
## [55] farver_2.0.3        fs_1.4.1            sp_1.4-1           
## [58] xml2_1.3.2          ellipsis_0.3.0      generics_0.0.2     
## [61] vctrs_0.2.4         tools_4.0.0         glue_1.4.0         
## [64] hms_0.5.3           jpeg_0.1-8.1        yaml_2.2.1         
## [67] colorspace_1.4-1    rvest_0.3.5         classInt_0.4-3     
## [70] knitr_1.28          haven_2.2.0

Related