Создайте диаграмму Санки с аккуратными данными в R

Question

Я «привел в порядок» свои данные в R с помощью функций dplyr и 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))

I wi sh для построения 3-х секционной диаграммы Санки на основе на значениях выше. В большинстве примеров, которые я нашел, используется двухсекционный график (от -> до), но я использую sh, чтобы включить средний раздел «REJECT». Я также нашел примеров с несколькими разделами, но я не могу следовать приведенным примерам из-за моей неопытности в R.

Есть возможность использовать пакет flipPlot , но я у меня возникают проблемы с установкой пакетов из GitHub из-за проблем с обновлением пакетов:

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’ 

Я ранее использовал пакет networkD3 для создания двухсекционного графика, я действительно хочу sh, чтобы лучше понять, как я могу расширить это для построения 3-х секционного участка.

Answer 1

Вам необходимо создать фрейм данных ссылок, соответствующий стилю 'source', 'target', .... В вашем случае каждый последующий столбец (кроме столбца VALUE) является целью предыдущего столбца. Вы можете изменить форму своих данных, определив порядок каждого шага из порядка каждого столбца ...

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")

, чтобы сделать процесс более понятным, вот какой фрейм данных links вам нужно построить выглядит так, как будто после каждого значимого шага в процессе ...

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

Answer 2

Вы можете попробовать использовать функцию sankey_from_data_frame(), определенную в этом блокноте Kaggle . Для этого требуются dplyr, tidyr, purrr, tidygraph и networkD3.

У меня тоже были недавние проблемы с установкой flipPlots, так что, возможно, пока этого избегайте.

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

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

Затем:

sankey_from_data_frame(data = df, val_col = VALUE)

Создает:

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:

введите описание изображения здесь