Создание ребер для речного участка

Я надеюсь использовать пакет riverplot для создания блок-схемы. Этот пакет нуждается в "ребрах", которые являются потоками между уровнями. Я хочу создать структуру данных ребер из фрейма данных. В качестве примера здесь приведен код для создания моих входных данных.

rp.df<-structure(list(ID = 1:20, X1 = structure(c(1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = "A1", class = "factor"), 
X2 = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("A2", 
"B2"), class = "factor"), X3 = structure(c(1L, 1L, 2L, 2L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 
3L), .Label = c("A3", "B3", "C3"), class = "factor")), class = "data.frame", row.names = c(NA, 
-20L))
table(rp.df$X1,rp.df$X2)
table(rp.df$X2,rp.df$X3)

с этим выводом

> table(rp.df$X1,rp.df$X2)

     A2 B2
  A1 12  8
> table(rp.df$X2,rp.df$X3)

     A3 B3 C3
  A2  2  2  8
  B2  5  2  1

что мне нужно, это датафрейм с потоками, указанными в таблицах, например:

N1 N2 Value
A1 A2    12
A1 B2     8
A2 A3     2
A2 B3     2
A2 C3     8
B2 A3     5
B2 B3     2
B2 C3     1

На самом деле у меня есть 10 столбцов ребер и 16k в потоках. Я пытался использовать Reshape2, чтобы сделать это, но изо всех сил.

3 ответа

Решение

Вот базовое решение R, обобщенное для любого количества столбцов.

out <- lapply(2:(ncol(rp.df) - 1), function(i) {
  as.data.frame(table(rp.df[, i], rp.df[, i + 1]))
  }
)
setNames(do.call(rbind, out), c("N1", "N2", "Value"))
#   N1 N2 Value
# 1 A1 A2    12
# 2 A1 B2     8
# 3 A2 A3     2
# 4 B2 A3     5
# 5 A2 B3     2
# 6 B2 B3     2
# 7 A2 C3     8
# 8 B2 C3     1

Для полноты картины, вот два data.table решения.

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

Связать данные узла, затем агрегировать

library(data.table)
library(magrittr)
setDT(rp.df)
edges <- lapply(3:ncol(rp.df), 
       function(i) rp.df[, .SD, .SDcols = (i-1L):i]) %>% 
  rbindlist() %>% 
  .[, .(Value = .N), by = .(N1 = X1, N2 = X2 )]
edges
   N1 N2 Value
1: A1 A2    12
2: A1 B2     8
3: A2 A3     2
4: A2 B3     2
5: A2 C3     8
6: B2 A3     5
7: B2 B3     2
8: B2 C3     1

Агрегировать данные узла затем связать

nm <- names(rp.df) %>% stringr::str_subset("^X")
edges <- lapply(2:length(nm), 
                function(i) rp.df[, .N, by = c(nm[i-1], nm[i])]) %>%
  rbindlist() 
setnames(edges, c("N1", "N2", "Value"))
edges
   N1 N2 Value
1: A1 A2    12
2: A1 B2     8
3: A2 A3     2
4: A2 B3     2
5: A2 C3     8
6: B2 A3     5
7: B2 B3     2
8: B2 C3     1

Предостережение

Обратите внимание, что оба подхода не полностью эквивалентны, если некоторые ребра появляются несколько раз. (Они эквивалентны для данного образца набора данных).

Давайте примем край (A1, A2) появляется в X1 а также X2 а также в X2 а также X3, Первый подход суммирует это в одной выходной строке, тогда как второй подход создаст две выходные строки. Таким образом, для второго подхода потребуется дополнительный этап агрегирования, чтобы получить тот же результат, что и в первом подходе.

Какой подход подходит, должно быть решено ФП.

Если это необходимо, также можно записать этап или уровень, на котором происходит ребро:

nm <- names(rp.df) %>% stringr::str_subset("^X")
edges <- lapply(2:length(nm), 
                function(i) rp.df[, .N, by = c(nm[i-1], nm[i])]) %>%
  rbindlist(idcol = TRUE) 
setnames(edges, c("Level", "N1", "N2", "Value"))
edges

   Level N1 N2 Value
1:     1 A1 A2    12
2:     1 A1 B2     8
3:     2 A2 A3     2
4:     2 A2 B3     2
5:     2 A2 C3     8
6:     2 B2 A3     5
7:     2 B2 B3     2
8:     2 B2 C3     1

Вот tidyverse решение. select(rp.df, X1:X2) для первого X столбец к предыдущему X колонка. select(rp.df, X2:X3) для второго X столбец до последнего X колонка. Делая это, вы можете убедиться, что каждая комбинация столбцов адресована. dat это окончательный результат.

library(tidyverse)

dat <- map2_dfr(select(rp.df, X1:X2), 
                select(rp.df, X2:X3),
                ~as_data_frame(table(.x, .y))) %>%
  set_names(c("N1", "N2", "Value"))
dat
# # A tibble: 8 x 3
#   N1    N2    Value
#   <chr> <chr> <int>
# 1 A1    A2       12
# 2 A1    B2        8
# 3 A2    A3        2
# 4 B2    A3        5
# 5 A2    B3        2
# 6 B2    B3        2
# 7 A2    C3        8
# 8 B2    C3        1
Другие вопросы по тегам