Create a Sankey Diagram with tidy data in R

Question

I have 'tidied' my data in R using dplyr and tidyr functions and have created a data frame that looks as follows:

df <- data.frame(PROD = c("A","A","A","A"), REJECT = c("YES","YES","NO","NO"),ALT_PROD = c("A","B","C","D"), VALUE = c(100,50,400,500))

I wish to plot a 3 section sankey diagram based on the values above. Most examples I've found use a 2 section plot (from -> to) but I wish to include the middle section "REJECT". I have also found examples with multiple sections but I cannot follow the examples provided due to my inexperience in R.

There's an option to use the flipPlot package but I am having issues with installing packages from GitHub due to package update issues:

Error: Failed to install 'flipPlots' from GitHub:
  Failed to install 'flipTransformations' from GitHub:
  Failed to install 'flipFormat' from GitHub:
  (converted from warning) cannot remove prior installation of package ‘jsonlite’

I have previously used the networkD3 package to create a two section plot, I really wish to better understand how I can extend this to build a 3 section plot.

Did you try removing the package jsonlite manually from where it resides on your computer? — Samuel, Aug 04 '20 at 22:07

score 3 · Answer 1 · answered Aug 05 '20 at 00:18

You could try using the sankey_from_data_frame() function, defined in this Kaggle notebook. It requires dplyr, tidyr, purrr, tidygraph and networkD3.

I've had recent installation issues with flipPlots too, so perhaps avoid that for now.

library(dplyr)
library(tidyr)
library(purrr)
library(tidygraph)
library(networkD3)

## copy the code from the Kaggle notebook here
## sankey_from_data_frame <- ...

Then:

sankey_from_data_frame(data = df, val_col = VALUE)

Generates:

Note the "loop-back" edge, resulting from the same name in PROD and ALT_PROD. If you prefer the ALT_PROD value = A to be on the right, one solution is to rename the PROD value:

sankey_from_data_frame(data = mutate(df1, PROD = paste0("PROD ", PROD)), val_col = VALUE)

Result:

score 1 · Accepted Answer · answered Aug 06 '20 at 11:36

You need to build a links data frame that conforms to the style 'source', 'target', .... In your case, each successive column (other than the VALUE column) is the target of the previous column. You can reshape your data by by inferring the order of each step from the order of each column...

library(networkD3)
library(dplyr)
library(tidyr)


df <- data.frame(PROD = c("A","A","A","A"), 
                 REJECT = c("YES","YES","NO","NO"),
                 ALT_PROD = c("A","B","C","D"), 
                 VALUE = c(100,50,400,500))


links <-
  df %>% 
  as_tibble() %>% 
  mutate(row = row_number()) %>% 
  pivot_longer(cols = c(-row, -VALUE),
               names_to = 'column', values_to = 'source') %>% 
  mutate(column = match(column, names(df))) %>% 
  mutate(source = paste0(source, '__', column)) %>% 
  group_by(row) %>% 
  mutate(target = lead(source, order_by = column)) %>% 
  drop_na(target, source) %>% 
  group_by(source, target) %>% 
  summarise(value = sum(VALUE), .groups = 'drop')


nodes <- data.frame(name = unique(c(links$source, links$target)))

links$source <- match(links$source, nodes$name) - 1
links$target <- match(links$target, nodes$name) - 1

nodes$name <- sub('__[0-9]+$', '', nodes$name)


sankeyNetwork(Links = links, Nodes = nodes, Source = "source", 
              Target = "target", Value = "value", NodeID = "name")

to make the process more clear, here's what the links data frame you need to build looks like after each significant step in the process...

df %>% 
  as_tibble() %>% 
  mutate(row = row_number())
#> # A tibble: 4 x 5
#>   PROD  REJECT ALT_PROD VALUE   row
#>   <chr> <chr>  <chr>    <dbl> <int>
#> 1 A     YES    A          100     1
#> 2 A     YES    B           50     2
#> 3 A     NO     C          400     3
#> 4 A     NO     D          500     4


df %>% 
  as_tibble() %>% 
  mutate(row = row_number()) %>% 
  pivot_longer(cols = c(-row, -VALUE),
               names_to = 'column', values_to = 'source')
#> # A tibble: 12 x 4
#>    VALUE   row column   source
#>    <dbl> <int> <chr>    <chr> 
#>  1   100     1 PROD     A     
#>  2   100     1 REJECT   YES   
#>  3   100     1 ALT_PROD A     
#>  4    50     2 PROD     A     
#>  5    50     2 REJECT   YES   
#>  6    50     2 ALT_PROD B     
#>  7   400     3 PROD     A     
#>  8   400     3 REJECT   NO    
#>  9   400     3 ALT_PROD C     
#> 10   500     4 PROD     A     
#> 11   500     4 REJECT   NO    
#> 12   500     4 ALT_PROD D


df %>% 
  as_tibble() %>% 
  mutate(row = row_number()) %>% 
  pivot_longer(cols = c(-row, -VALUE),
               names_to = 'column', values_to = 'source') %>% 
  mutate(column = match(column, names(df))) %>% 
  mutate(source = paste0(source, '__', column))
#> # A tibble: 12 x 4
#>    VALUE   row column source
#>    <dbl> <int>  <int> <chr> 
#>  1   100     1      1 A__1  
#>  2   100     1      2 YES__2
#>  3   100     1      3 A__3  
#>  4    50     2      1 A__1  
#>  5    50     2      2 YES__2
#>  6    50     2      3 B__3  
#>  7   400     3      1 A__1  
#>  8   400     3      2 NO__2 
#>  9   400     3      3 C__3  
#> 10   500     4      1 A__1  
#> 11   500     4      2 NO__2 
#> 12   500     4      3 D__3


df %>% 
  as_tibble() %>% 
  mutate(row = row_number()) %>% 
  pivot_longer(cols = c(-row, -VALUE),
               names_to = 'column', values_to = 'source') %>% 
  mutate(column = match(column, names(df))) %>% 
  mutate(source = paste0(source, '__', column)) %>% 
  group_by(row) %>% 
  mutate(target = lead(source, order_by = column))
#> # A tibble: 12 x 5
#> # Groups:   row [4]
#>    VALUE   row column source target
#>    <dbl> <int>  <int> <chr>  <chr> 
#>  1   100     1      1 A__1   YES__2
#>  2   100     1      2 YES__2 A__3  
#>  3   100     1      3 A__3   <NA>  
#>  4    50     2      1 A__1   YES__2
#>  5    50     2      2 YES__2 B__3  
#>  6    50     2      3 B__3   <NA>  
#>  7   400     3      1 A__1   NO__2 
#>  8   400     3      2 NO__2  C__3  
#>  9   400     3      3 C__3   <NA>  
#> 10   500     4      1 A__1   NO__2 
#> 11   500     4      2 NO__2  D__3  
#> 12   500     4      3 D__3   <NA>


df %>% 
  as_tibble() %>% 
  mutate(row = row_number()) %>% 
  pivot_longer(cols = c(-row, -VALUE),
               names_to = 'column', values_to = 'source') %>% 
  mutate(column = match(column, names(df))) %>% 
  mutate(source = paste0(source, '__', column)) %>% 
  group_by(row) %>% 
  mutate(target = lead(source, order_by = column)) %>% 
  drop_na(target, source)
#> # A tibble: 8 x 5
#> # Groups:   row [4]
#>   VALUE   row column source target
#>   <dbl> <int>  <int> <chr>  <chr> 
#> 1   100     1      1 A__1   YES__2
#> 2   100     1      2 YES__2 A__3  
#> 3    50     2      1 A__1   YES__2
#> 4    50     2      2 YES__2 B__3  
#> 5   400     3      1 A__1   NO__2 
#> 6   400     3      2 NO__2  C__3  
#> 7   500     4      1 A__1   NO__2 
#> 8   500     4      2 NO__2  D__3


df %>% 
  as_tibble() %>% 
  mutate(row = row_number()) %>% 
  pivot_longer(cols = c(-row, -VALUE),
               names_to = 'column', values_to = 'source') %>% 
  mutate(column = match(column, names(df))) %>% 
  mutate(source = paste0(source, '__', column)) %>% 
  group_by(row) %>% 
  mutate(target = lead(source, order_by = column)) %>% 
  drop_na(target, source) %>% 
  group_by(source, target) %>% 
  summarise(value = sum(VALUE), .groups = 'drop')
#> # A tibble: 6 x 3
#>   source target value
#>   <chr>  <chr>  <dbl>
#> 1 A__1   NO__2    900
#> 2 A__1   YES__2   150
#> 3 NO__2  C__3     400
#> 4 NO__2  D__3     500
#> 5 YES__2 A__3     100
#> 6 YES__2 B__3      50

Create a Sankey Diagram with tidy data in R

2 Answers2