Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Error using enter/exit fade despite trying several group options #429

Open
saeeshm opened this issue Feb 15, 2021 · 2 comments
Open

Error using enter/exit fade despite trying several group options #429

saeeshm opened this issue Feb 15, 2021 · 2 comments

Comments

@saeeshm
Copy link

saeeshm commented Feb 15, 2021

I'm trying to create an animation that shows income on a chloropleth map, with each "state" referring to a different socio-economic category. The code I'm using the generate the animation is this

# Preparing data for plotting
p <- gama %>% 
  mutate(group = 1) %>% 
  dplyr::select(eacode, group, medlec, SES_cat_g2) %>% 
  # Turning income data to a factor to plot it using quantile bins (breaks defined previously)
  mutate(x = cut(medlec, breaks = breaks, ordered_result = T)) %>% 
  mutate(x = as_factor(x)) %>% 
  # Plotting
  ggplot() +
  geom_sf(aes(fill = x, group = group),
          colour = "white", size = 0.2) +
  scale_fill_brewer(palette = "RdYlGn") +
  labs(fill = "Median Income\n(Quantiles)") +
  # Custom theme that I've made, only edits layout variables like font panel grid, legend, etc.
  theme_soosh(font = "lmroman", tscale = 3) +
  ggtitle("Median Income: SES Category {closest_frame}",
           subtitle = "Greater Accra Metropolitan Area")

# Transition states (the SES cat variable is grouping factor that defines different socio-economic categories).
anim <- p + transition_states(SES_cat_g2, transition_length = 2, state_length = 5, wrap = T) + enter_fade() + exit_fade()
# Using a small number of frames to test whether it's working
animate(anim, nframes = 20)

Every time I run this though, I get the following error:

Error in tween_state(as.data.frame(full_set$from), as.data.frame(full_set$to),  : 
  identical(classes, col_classes(to)) is not TRUE

I've tried changing the "group" variable to many different options, based on reading other posts discussing this issue and it did nothing. If I remove enter/exit_fade(), the animation renders. However, I specifically want the fading behaviour because without it the transitions don't make a lot of visual sense.

I've also tried transitional_manual and that worked fine too. I'd be happy to use that except as far as I understand I can't add fades between different states in that mode.

Please let me know what I can do. Here is my session information:

R version 4.0.3 (2020-10-10)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19042)

Matrix products: default

locale:
[1] LC_COLLATE=English_Canada.1252  LC_CTYPE=English_Canada.1252    LC_MONETARY=English_Canada.1252 LC_NUMERIC=C                   
[5] LC_TIME=English_Canada.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] systemfonts_1.0.1.9000 transformr_0.1.2.9000  showtext_0.9-1         showtextdb_3.0         sysfonts_0.8.2         gganimate_1.0.7       
 [7] rgdal_1.5-23           raster_3.4-5           sp_1.4-4               sf_0.9-6               forcats_0.5.0          stringr_1.4.0         
[13] dplyr_1.0.2            purrr_0.3.4            readr_1.4.0            tidyr_1.1.2            tibble_3.0.4           ggplot2_3.3.2         
[19] tidyverse_1.3.0       

loaded via a namespace (and not attached):
 [1] fs_1.5.0           usethis_1.6.3      lubridate_1.7.9.2  devtools_2.3.2     RColorBrewer_1.1-2 progress_1.2.2     httr_1.4.2         rprojroot_1.3-2   
 [9] tools_4.0.3        backports_1.2.0    utf8_1.1.4         R6_2.5.0           KernSmooth_2.23-17 DBI_1.1.0          colorspace_2.0-0   withr_2.3.0       
[17] tidyselect_1.1.0   prettyunits_1.1.1  processx_3.4.5     curl_4.3           compiler_4.0.3     cli_2.2.0          rvest_0.3.6        xml2_1.3.2        
[25] desc_1.2.0         labeling_0.4.2     scales_1.1.1       classInt_0.4-3     callr_3.5.1        digest_0.6.27      pkgconfig_2.0.3    sessioninfo_1.1.1 
[33] dbplyr_2.0.0       rlang_0.4.10       readxl_1.3.1       rstudioapi_0.13    farver_2.0.3       generics_0.1.0     jsonlite_1.7.1     magrittr_2.0.1    
[41] Rcpp_1.0.5         munsell_0.5.0      fansi_0.4.1        lifecycle_0.2.0    stringi_1.5.3      pkgbuild_1.1.0     plyr_1.8.6         grid_4.0.3        
[49] crayon_1.3.4       lattice_0.20-41    haven_2.3.1        hms_0.5.3          ps_1.5.0           pillar_1.4.7       codetools_0.2-16   lpSolve_5.6.15    
[57] pkgload_1.1.0      reprex_0.3.0       glue_1.4.2         gifski_0.8.6       remotes_2.2.0      modelr_0.1.8       vctrs_0.3.6        tweenr_1.0.1      
[65] testthat_3.0.0     cellranger_1.1.0   gtable_0.3.0       assertthat_0.2.1   xfun_0.19          broom_0.7.2        e1071_1.7-4        class_7.3-17      
[73] tinytex_0.27       memoise_1.1.0      units_0.6-7        ellipsis_0.3.1    
@thomasp85
Copy link
Owner

Can I get you to post a reprex? If you are unfamiliar with the concept of reprex, please see this page https://reprex.tidyverse.org

@saeeshm
Copy link
Author

saeeshm commented Mar 19, 2021

Hello! Sorry for the delay. So I spent some time poking around with what I think happened and I may have found a workaround? Not sure if this is a solution, but it might help shed light on what is going on.

I noticed that mysf dataframe didn't have the same number of geometries in every "state" in the categorical variable (which represents percentiles by income, essentially).

Since the geometries being mapped are enumeration areas, some EAs simply don't have people from a certain income category. So the data looked something like this (This is a fictional example of the data, the actual data is proprietary so I cannot share it directly here):

rows <- vector('list', 6)
rows[[1]] <- list("SES_category" = 1, "eacode" = 1, "medlec" = 125, "geometry" = "<sf-geom for EA-code 1>")
rows[[2]] <- list("SES_category" = 1, "eacode" = 2, "medlec" = 13, "geometry" = "<sf-geom for EA-code 2>")
rows[[3]] <- list("SES_category" = 1, "eacode" = 3, "medlec" = 345, "geometry" = "<sf-geom for EA-code 3>")
rows[[4]] <- list("SES_category" = 2, "eacode" = 1, "medlec" = 5643, "geometry" = "<sf-geom for EA-code 1>")
rows[[5]] <- list("SES_category" = 2, "eacode" = 2, "medlec" = 234, "geometry" = "<sf-geom for EA-code 2>")
rows[[6]] <- list("SES_category" = 3, "eacode" = 1, "medlec" = 23, "geometry" = "<sf-geom for EA-code 1>")
rows[[7]] <- list("SES_category" = 3, "eacode" = 3, "medlec" = 2345, "geometry" = "<sf-geom for EA-code 3>")
dplyr::bind_rows(rows)
#> # A tibble: 7 x 4
#>   SES_category eacode medlec geometry               
#>          <dbl>  <dbl>   <dbl> <chr>                  
#> 1            1      1     125 <sf-geom for EA-code 1>
#> 2            1      2      13 <sf-geom for EA-code 2>
#> 3            1      3     345 <sf-geom for EA-code 3>
#> 4            2      1    5643 <sf-geom for EA-code 1>
#> 5            2      2     234 <sf-geom for EA-code 2>
#> 6            3      1      23 <sf-geom for EA-code 1>
#> 7            3      3    2345 <sf-geom for EA-code 3>

To try and "fix" this, I added rows to the dataframe that contained the geometry but just had missing values for the data, to reflect that they don't actually exist in that EA

rows <- vector('list', 9)
rows[[1]] <- list("SES_category" = 1, "eacode" = 1, "medlec" = 125, "geometry" = "<sf-geom for EA-code 1>")
rows[[2]] <- list("SES_category" = 1, "eacode" = 2, "medlec" = 13, "geometry" = "<sf-geom for EA-code 2>")
rows[[3]] <- list("SES_category" = 1, "eacode" = 3, "medlec" = 345, "geometry" = "<sf-geom for EA-code 3>")
rows[[4]] <- list("SES_category" = 2, "eacode" = 1, "medlec" = 5643, "geometry" = "<sf-geom for EA-code 1>")
rows[[5]] <- list("SES_category" = 2, "eacode" = 2, "medlec" = 234, "geometry" = "<sf-geom for EA-code 2>")
# This row was added
rows[[6]] <- list("SES_category" = 2, "eacode" = 3, "medlec" = NA_real_, "geometry" = "<sf-geom for EA-code 3>")
rows[[7]] <- list("SES_category" = 3, "eacode" = 1, "medlec" = 23, "geometry" = "<sf-geom for EA-code 1>")
# This row was added
rows[[8]] <- list("SES_category" = 3, "eacode" = 2, "medlec" = NA_real_, "geometry" = "<sf-geom for EA-code 2>")
rows[[9]] <- list("SES_category" = 3, "eacode" = 3, "medlec" = 2345, "geometry" = "<sf-geom for EA-code 1>")
dplyr::bind_rows(rows)
#> # A tibble: 9 x 4
#>   SES_category eacode medlec geometry               
#>          <dbl>  <dbl>   <dbl> <chr>                  
#> 1            1      1     125 <sf-geom for EA-code 1>
#> 2            1      2      13 <sf-geom for EA-code 2>
#> 3            1      3     345 <sf-geom for EA-code 3>
#> 4            2      1    5643 <sf-geom for EA-code 1>
#> 5            2      2     234 <sf-geom for EA-code 2>
#> 6            2      3      NA <sf-geom for EA-code 3>
#> 7            3      1      23 <sf-geom for EA-code 1>
#> 8            3      2      NA <sf-geom for EA-code 2>
#> 9            3      3    2345 <sf-geom for EA-code 1>

Now, since all the geometries were present across all states even if the data was missing (i.e no geometries were disappearing or re-appearing between states), the animation rendered.

I though gganimate handled geometries going missing between states, so I thought this wouldn't be a problem. Maybe this doesn't work as well for maps?

Also, my goal was only to try and have fade transitions between states. If that had been possible with transition_manual, I would have much preferred that. I wonder if there was any way to use the enter/exit_fade arguments with transition_manual?

Regardless, I hope this helps! I've also attached my previous issue as a reprex just to be clear (I hope I've done it correctly?)

# !usr/bin/env Rscript

# Author: Saeesh Mangwani
# Date: 2021-03-19

# Description: Animation issues for reprex

# ==== Loading libraries ====
library(tidyverse)
library(sf)
#> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1
library(reprex)
library(gganimate)
# Script where I define some helper functions for working with my data, including
# the custom theme function I use later (theme_accra)
source("C:/Users/saees/codeProjects/RProjects/accra/accra_viz.R")
#> 
#> Attaching package: 'rlang'
#> The following objects are masked from 'package:purrr':
#> 
#>     %@%, as_function, flatten, flatten_chr, flatten_dbl, flatten_int,
#>     flatten_lgl, flatten_raw, invoke, list_along, modify, prepend,
#>     splice
# Adding a showtext font 'lmroman
library(showtext)
#> Loading required package: sysfonts
#> Loading required package: showtextdb
font_paths(new = "C:/Users/saees/Appdata/Local/Microsoft/Windows/Fonts")
#> [1] "C:\\Users\\saees\\AppData\\Local\\Microsoft\\Windows\\Fonts"
#> [2] "C:\\Windows\\Fonts"
font_add(family = "lmroman", regular = "lmroman10-regular.otf")
showtext_auto()
# ==== Reading data ====

# Reading the census and the shapefile, ensuring only relevant variables are selected
census <- read_csv("C:/Users/saees/codeProjects/RProjects/accra/data/gama/20210216_GAMA_g3_inequality_EA.csv")
#> 
#> -- Column specification --------------------------------------------------------
#> cols(
#>   .default = col_double()
#> )
#> i Use `spec()` for the full column specifications.
accra <- read_sf("C:/Users/saees/codeProjects/RProjects/accra/data/shp/GAMA_20200420.shp", query = "SELECT ea_code9ch FROM GAMA_20200420")

# Turning the eacode variable in the census dataset to a string to make joining with the shapefile easier
census <- census %>% 
  mutate(ea_code9ch = str_pad(ea_code9ch, width = 9, side = 'left', pad = '0'))

# Joining data to shapefile
gama <- census %>% 
  inner_join(accra, by = c("ea_code9ch" = "ea_code9ch")) %>% 
  st_as_sf()

# Removing the extra dataset to only keep gama
rm(list = c('census', 'accra'))


# ==== Issue with missing geometries between states ====
p <- gama %>% 
  mutate(group = 1L) %>% 
  # Enumeration area code, group, median logged income, socio-economic category
  dplyr::select(ea_code9ch, group, medlec, SES_cat_g3) %>% 
  # Turning income data to a factor to plot it using quintile breaks
  mutate(medlec = cut(medlec, breaks = quantile(gama$medlec, probs = seq(0,1,0.2), na.rm = T), ordered_result = T)) %>% 
  # Ensuring it is a factor
  mutate(medlec = as_factor(medlec)) %>% 
  # Plotting
  ggplot() +
  geom_sf(aes(fill = medlec, group = group), colour = "white", size = 0.2) +
  scale_fill_brewer(palette = "RdYlGn") +
  labs(title = "Median Income: SES Category {closest_frame}",
       subtitle = "Greater Accra Metropolitan Area",
       fill = "Median Income\n(Quantiles)",
       x = NULL,
       y = NULL) +
  # Custom theme that I've made, only edits layout variables like font panel grid, legend, etc.
  theme_accra(theme_font = "lmroman", tscale = 3)

# Transition states (the SES cat variable is grouping factor that defines different socio-economic categories).
anim <- p + transition_states(SES_cat_g3, transition_length = 2, state_length = 5, wrap = T) + enter_fade() + exit_fade()
# Using a small number of frames to test whether it's working
animate(anim, nframes = 20)
#> Error in tween_state(as.data.frame(full_set$from), as.data.frame(full_set$to), : identical(classes, col_classes(to)) is not TRUE

Created on 2021-03-19 by the reprex package (v1.0.0)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

2 participants