Подсчитайте, сколько раз два значения совпадают в группе в R

Я искал ответы на этот вопрос и нашел похожие (Подсчитать количество строк внутри каждой группы, подсчитывать уникальные комбинации значений переменных в столбце кадра данных R, R подсчитывает количество вхождений элемента по группам), но ни один из них не решает мою конкретную проблему.

У меня есть фрейм данных с переменными year, ID и code. Каждый человек имеет ID и может иметь несколько значений code в течение (потенциально) нескольких years.

df = data.frame(ID   = c(1,1,1,1, 2,2,2, 3, 4,4,4,4,4,4,4,4, 5,5,5),
                year = c(2018, 2018, 2020, 2020,
                         2020, 2020, 2020,
                         2011,
                         2019, 2019, 2019, 2019, 2020, 2020, 2020, 2020,
                         2018, 2019, 2020),
                code = c("A", "B", "C", "D",
                         "A", "B", "Q",
                         "G",
                         "A", "B", "Q", "G", "C", "D", "T", "S",
                         "S", "Z", "F")

)

df
   ID year code
1   1 2018    A
2   1 2018    B
3   1 2020    C
4   1 2020    D
5   2 2020    A
6   2 2020    B
7   2 2020    Q
8   3 2011    G
9   4 2019    A
10  4 2019    B
11  4 2019    Q
12  4 2019    G
13  4 2020    C
14  4 2020    D
15  4 2020    T
16  4 2020    S
17  5 2018    S
18  5 2019    Z
19  5 2020    F

Я хотел бы получить еще один кадр данных, дающий количество раз, когда два разных значения code встречались одновременно в группах ID и year (в этом примере A и B совпадали 3 раза, а A и C совпадали 0 раз ), который я затем буду использовать для анализа сети.

Пока у меня такой синтаксис:

1: Сделать широкую версию данных

library(tidyverse)
wide = df %>% 
        group_by(year, ID) %>% 
        mutate(row = row_number()) %>% 
        ungroup() %>% 
        pivot_wider(
            id_cols = c(ID, year),
            names_from = row, 
            names_prefix = "code_", 
            values_from = code
        )

2: Составьте список узлов

nodes = distinct(df, code) %>% rowid_to_column("id")

3: Составьте список краев

#edge list needs to be three vars: source, dest, and weight
# source and dest are simply code names that (potentially) co-occur in the same year for an ID
# weight is the number of times the codes co-occurred in the same year for each ID.

#all combinations of two codes
edges = combn(x = nodes$code, m = 2 ) %>% 
    t() %>% 
    as.data.frame()

colnames(edges) = c("source", "dest")
edges$weight = NA_integer_


#oh, no! a for() loop! a coder's last ditch effort to make something work
for(i in 1:nrow(edges)){
    
    source = edges$source[i]
    dest = edges$dest[i]
    

    #get the cases with the first code of interest
    temp = df %>% 
        filter( code == source ) %>% 
        select(ID, year)
    
    #get the other codes that occurred for that ID in that year
    temp = left_join(temp, 
                     wide, 
                     by = c("ID", "year"))
    
    
    #convert to a logical showing if the other codes are the one I want
    temp = temp %>% mutate_at(vars(starts_with("code_")),
                            function(x){ x == dest }
    ) 
    
    #sum the number of times `source` and `dest` co-occurred
    temp$dest = temp %>% select(starts_with("code_")) %>% rowSums(., na.rm=TRUE)
    edges$weight[i] = sum(temp$dest, na.rm = TRUE)
    
}

Изменить, чтобы добавить результат:

Результат:

edges
   source dest weight
1       A    B      3
2       A    C      0
3       A    D      0
4       A    Q      2
5       A    G      1
6       A    T      0
7       A    S      0
8       A    Z      0
9       A    F      0
10      B    C      0
11      B    D      0
12      B    Q      2
13      B    G      1
14      B    T      0
15      B    S      0
16      B    Z      0
17      B    F      0
18      C    D      2
19      C    Q      0
20      C    G      0
21      C    T      1
22      C    S      1
23      C    Z      0
24      C    F      0
25      D    Q      0
26      D    G      0
27      D    T      1
28      D    S      1
29      D    Z      0
30      D    F      0
31      Q    G      1
32      Q    T      0
33      Q    S      0
34      Q    Z      0
35      Q    F      0
36      G    T      0
37      G    S      0
38      G    Z      0
39      G    F      0
40      T    S      1
41      T    Z      0
42      T    F      0
43      S    Z      0
44      S    F      0
45      Z    F      0

Это дает мне то, что я хочу (кадр данных, показывающий, что A и B совпадали 3 раза, A и C совпадали 0 раз, A и D совпадали 0 раз, A и G совпадали 1 раз, A и Q сосуществовали - произошло 2 раза и т. д.). Так что это работает, но даже для этого небольшого примера требуется секунда или две. Мой реальный набор данных составляет ~ 3 000 000 наблюдений. Я дал ему поработать какое-то время, но остановил его только для того, чтобы обнаружить, что он был завершен примерно на 1%.

Есть ли лучший/быстрый способ сделать это?


person JRF1111    schedule 23.09.2020    source источник
comment
можете ли вы показать ожидаемый результат   -  person akrun    schedule 23.09.2020
comment
Может ли один и тот же code появляться несколько раз для определенной комбинации id и year?   -  person pseudospin    schedule 23.09.2020


Ответы (2)


Вот альтернатива, которая вместо этого просто выполняет соединение и, вероятно, очень быстро работает с большими данными.

library(data.table)
setDT(df)
df[df, on = c('ID','year'), allow.cartesian = TRUE][
  code<i.code, .N, .(pair = paste0(code, i.code))]

#>     pair N
#>  1:   AB 3
#>  2:   CD 2
#>  3:   AQ 2
#>  4:   BQ 2
#>  5:   GQ 1
#>  6:   AG 1
#>  7:   BG 1
#>  8:   CT 1
#>  9:   DT 1
#> 10:   ST 1
#> 11:   CS 1
#> 12:   DS 1
person pseudospin    schedule 23.09.2020
comment
Это замечательно! Я собираюсь изменить его, чтобы я мог разделить переменную pair и получить два кода как свои собственные переменные. edges = df[df, on = c('ID','year'), allow.cartesian = TRUE][code<i.code, .N, .(pair = paste(code, i.code, sep = "{@}"))]; edges[, tstrsplit(edges$pair, "{@}", fixed=T)] - person JRF1111; 24.09.2020

Это должно работать. Вы получите только одну запись для каждой пары из-за sort.

library(data.table)
setDT(df)
all_pairs <- function(x) {
  if (length(x) > 1) {
    sapply(combn(sort(x), 2, simplify = FALSE), paste, collapse = '')
  } else {
    c()
  }
}
df[,.(pairs = all_pairs(code)), .(ID, year)][,.N, .(pairs)]

#>     pairs N
#>  1:    AB 3
#>  2:    CD 2
#>  3:    AQ 2
#>  4:    BQ 2
#>  5:    AG 1
#>  6:    BG 1
#>  7:    GQ 1
#>  8:    CS 1
#>  9:    CT 1
#> 10:    DS 1
#> 11:    DT 1
#> 12:    ST 1
person pseudospin    schedule 23.09.2020