Sample data

suppressPackageStartupMessages( require(easyalluvial) )
suppressPackageStartupMessages( require(tidyverse) )
data_wide = as_tibble(mtcars)
categoricals = c('cyl', 'vs', 'am', 'gear', 'carb')
numericals = c('mpg', 'cyl', 'disp', 'hp', 'drat', 'wt', 'qsec')

data_wide = data_wide %>%
  mutate_at( vars(categoricals), as.factor ) %>%
  mutate( car_id = row_number() )

knitr::kable( head(data_wide) )

alluvial_wide()

alluvial_wide(data_wide
              , bins = 5 # Default
              , bin_labels = c('LL','ML','M','MH','HH') # Default
              , fill_by = 'all_flows'
              )

plot_condensation(data_wide, first = mpg)

alluvial_wide( select(data_wide, mpg, cyl, vs, am), fill_by = 'first_variable' )

alluvial_wide( select(data_wide, mpg, cyl, vs, am)
               , fill_by = 'first_variable'
               , order_levels = c('8','6','4') )

p_unordered = alluvial_wide( select(data_wide, mpg, disp, hp)
                              , fill_by = 'first_variable' ) +
  labs( title = 'Unordered', caption = '\n\n' )

bin_labels = c('mpg_LL','mpg_LM','mpg_M','mpg_MH','mpg_HH')

p_ordered = data_wide %>%
  mutate( mpg = manip_bin_numerics(mpg, bin_labels = bin_labels)
          , mpg = fct_rev(mpg) ) %>%
  select( mpg, disp, hp) %>%
  alluvial_wide() +
  labs( title = 'Ordered')

gridExtra::grid.arrange( p_unordered, p_ordered, nrow = 1 )

Sample Data

monthly_flights = nycflights13::flights %>%
  group_by(month, tailnum, origin, dest, carrier) %>%
  summarise() %>%
  group_by( tailnum, origin, dest, carrier) %>%
  count() %>%
  filter( n == 12 ) %>%
  select( - n ) %>%
  left_join( nycflights13::flights ) %>%
  .[complete.cases(.), ] %>%
  ungroup() %>%
  mutate( flight_id = pmap_chr(list(tailnum, origin, dest, carrier), paste )
          , qu = cut(month, 4)) %>%
  group_by(flight_id, carrier, origin, dest, qu ) %>%
  summarise( mean_arr_delay = mean(arr_delay) ) %>%
  ungroup() %>%
  mutate( mean_arr_delay = ifelse( mean_arr_delay < 10, 'on_time', 'late' ) )
## Joining, by = c("tailnum", "origin", "dest", "carrier")
  levels(monthly_flights$qu) = c('Q1', 'Q2', 'Q3', 'Q4')

  data_long = monthly_flights

  
knitr::kable( head( data_long) )

alluvial_long()

In long format we only need the column that contains the keys (timepoints, Q1, Q2, Q3, Q4) and the values (late, ontime), but we also need a column for the ID (flight_id) because in long format data for one flight is spread over 4 rows and the function needs to know which IDs to group to put into a flow. If ther is implicitly missing data so one flight_id has less than in this case four rows of data (one for each timepoint) it will be made explicit and labelled 'NA'.

col_vector = c('tomato', 'green3')

alluvial_long(data_long
              , key = qu
              , value = mean_arr_delay
              , id = flight_id 
              , fill_by = 'value'
              , col_vector_flow = col_vector
              , col_vector_value = col_vector
              )

We might be more interested which airline carrier had the most late flights, we can add it as an additional variable to the plot and use it for coloring. We can place this variable either on the left or on the right.

p_right = alluvial_long(data_long
              , key = qu
              , value = mean_arr_delay
              , id = flight_id 
              , fill = carrier
              , fill_by = 'last_variable'
              , fill_right = T # Default
              ) +
  labs(title = 'Color fill variable placed to the right')


p_left = alluvial_long(data_long
              , key = qu
              , value = mean_arr_delay
              , id = flight_id 
              , fill = carrier
              , fill_by = 'last_variable'
              , fill_right = F
              ) +
  labs(title = 'Color fill variable placed to the left'
       , caption = '\n\n')


gridExtra::grid.arrange( p_left, p_right, nrow = 1)

carriers_ordered_by_count = data_long %>%
  group_by(carrier) %>%
  count() %>%
  arrange( n ) %>%
  .[['carrier']]

alluvial_long(data_long
              , key = qu
              , value = mean_arr_delay
              , id = flight_id 
              , fill = carrier
              , fill_by = 'last_variable'
              , order_levels_fill = carriers_ordered_by_count
              , fill_right = F
              ) +
  labs(title = 'Carriers ordered by number of flights')

Missing Data

Explicitly and implicitly missing data will automaticall be labeled as 'NA' and added as a level. The order of that level can be changed like any other. We will automatically generate implicitly missing data if we sample only a fraction of our long format dataframe, because then not every flight_id will have a value (late, on_time) assigned for each time point (Q1, Q2, Q3, Q4). We can replace 'NA' with any other string.

col_vector = c( 'tomato', 'grey', 'green3')

data_na = data_long %>%
  select(flight_id, qu, mean_arr_delay) %>%
  sample_frac(0.9)

alluvial_long(data_na
              , key = qu
              , value = mean_arr_delay
              , id = flight_id
              , fill_by = 'value'
              , NA_label = 'None'
              , col_vector_value = col_vector
              , col_vector_flow = col_vector
              ) +
  labs(title = 'Implicit NA values')

Colors

alluvial_wide() and alluvial_long take any sequence of either HEX code or string color values. easyalluvial offers some convenience functions around constructing qualitative color pallettes for distinct values.

palette_qualitative() %>%
  palette_filter(greys = F) %>%
  palette_plot_rgp()

Connect Flows to observations in original data

We might recognise interesting patterns in the alluvial plot that we want to follow up upon. For example which cars With medium-low mpg and 8 cyl and 0 vs has an am value of 1. Note that we are passing the car_id variable.

p = alluvial_wide( select(data_wide, mpg, cyl, vs, am, car_id)
                   , id = car_id
                   , fill_by = 'first_variable'
                   , order_levels = c('8','6','4') )

p

The plot objects returned by both functions have an attribute called data_key which is an x-y table arranged like the alluvial plot one column containing the original ID. We can use the car_id variable to rejoin the original dataframe.

p$data_key %>%
  filter( mpg == 'ML'
          , cyl == 8
          , vs == 0 
          , am == 1 ) %>%
  # in order to convert factors to integers we have to convert them
  # to character first. Converting from factor returns the order of
  # the factor instead.
  mutate( car_id = as.character(car_id)
          , car_id = as.integer(car_id) ) %>%
  left_join(data_wide, by = 'car_id') %>%
  knitr::kable()

ggplot2 manipulations

thanks to ggalluvial the alluvial plots that easyalluvial returns can be manipulated using ggplot2 synthax

p + 
  coord_flip() +
  theme_minimal() +
  ggtitle('look at my minimal flip')