Подсчитать количество новых и потерянных друзей между двумя фреймами данных в R - PullRequest
Новая
       31

Подсчитать количество новых и потерянных друзей между двумя фреймами данных в R

0 голосов
/ 01 ноября 2019

У меня есть два фрейма данных одного и того же респондента, один из времени 1, а другой из времени 2. В каждой волне они выдвигали своих друзей, и я хочу знать:

1) сколько друзейноминировано во время 2, но не во время 1 (новые друзья)

2) сколько друзей назначено во время 1, но не во времени 2 (потерянные друзья)

Пример данных: 

Time 1 DF

ID  friend_1  friend_2  friend_3  
1          4        12         7       
2          8         6         7   
3          9        NA        NA     
4         15         7         2    
5          2        20         7   
6         19        13         9       
7         12        20         8    
8          3        17        10 
9          1        15        19     
10         2        16        11  


Time 2 DF

ID  friend_1  friend_2  friend_3  
1          4        12         3    
2          8         6        14       
3          9        NA        NA      
4         15         7         2      
5          1        17         9
6          9        19        NA
7         NA        NA        NA     
8          7         1        16  
9         NA        10        12   
10         7        11         9

Таким образом, требуемый DF будет включать эти столбцы (EDIT заполняется в столбцах): 

ID  num_newfriends  num_lostfriends  
1               1                 1      
2               1                 1   
3               0                 0      
4               0                 0        
5               3                 3          
6               0                 1  
7               0                 3   
8               3                 3
9               2                 3
10              2                 1

EDIT2:

Я пытался сделать анти-объединение 

df3 <- anti_join(df1, df2)

Но этот метод не учитывает номера идентификаторов друзей, которые могут появиться в другом столбце во времени 2 (например, респондент № 6, друг 9 и 19, находятся в T1 и T2, но в разных столбцах каждый раз)

Ответы [ 3 ]

2 голосов
/ 01 ноября 2019

Другой вариант: 

library(tidyverse)

left_join(
  gather(df1, key, x, -ID),
  gather(df2, key, y, -ID),
  by = c("ID", "key")
) %>%
  group_by(ID) %>%
  summarise(
    num_newfriends = sum(!y[!is.na(y)] %in% x[!is.na(x)]),
    num_lostfriends = sum(!x[!is.na(x)] %in% y[!is.na(y)])
  )

Вывод: 

# A tibble: 10 x 3
      ID num_newfriends num_lostfriends
   <int>          <int>           <int>
 1     1              1               1
 2     2              1               1
 3     3              0               0
 4     4              0               0
 5     5              3               3
 6     6              0               1
 7     7              0               3
 8     8              3               3
 9     9              2               3
10    10              2               2
1 голос
/ 01 ноября 2019

Вы можете заставить anti_join работать, сначала развернув «длинный» фрейм данных. 

df1 <- df1 %>%
  pivot_longer(starts_with("friend_"), values_to = "friend") %>%
  drop_na()
df2 <- df2 %>%
  pivot_longer(starts_with("friend_"), values_to = "friend") %>%
  drop_na()

head(df1)
#> # A tibble: 6 x 3
#>      ID name     friend
#>   <int> <chr>     <int>
#> 1     1 friend_1      4
#> 2     1 friend_2     12
#> 3     1 friend_3      7
#> 4     2 friend_1      8
#> 5     2 friend_2      6
#> 6     2 friend_3      7

lost_friends <- anti_join(df1, df2, by = c("ID", "friend"))
new_fiends <- anti_join(df2, df1, by = c("ID", "friend"))

respondents <- distinct(df1, ID)

respondents %>%
  full_join(
    count(lost_friends, ID, name = "num_lost_friends")
  ) %>%
  full_join(
    count(new_fiends, ID, name = "num_new_friends")
  ) %>%
  mutate_at(vars(starts_with("num_")), replace_na, 0)
#> Joining, by = "ID"
#> Joining, by = "ID"
#> # A tibble: 10 x 3
#>       ID num_lost_friends num_new_friends
#>    <int>            <dbl>           <dbl>
#>  1     1                1               1
#>  2     2                1               1
#>  3     3                0               0
#>  4     4                0               0
#>  5     5                3               3
#>  6     6                1               0
#>  7     7                3               0
#>  8     8                3               3
#>  9     9                3               2
#> 10    10                2               2

Создано в 2019-11-01 пакетом Представить (v0.3.0)

1 голос
/ 01 ноября 2019

Простое сравнение будет вариант 

library(tidyverse)
na_sums_old <- rowSums(is.na(time1))
na_sums_new <- rowSums(is.na(time2))
kept_friends <- map_dbl(seq(nrow(time1)), ~ sum(time1[.x, -1] %in% time2[.x, -1]))
kept_friends <- kept_friends - na_sums_old * (na_sums_new >= 1)

new_friends  <- 3 - na_sums_new - kept_friends
lost_friends <- 3 - na_sums_old - kept_friends

tibble(ID = time1$ID, new_friends = new_friends, lost_friends = lost_friends)


# A tibble: 10 x 3
      ID new_friends lost_friends
   <int>       <dbl>        <dbl>
 1     1           1            1
 2     2           1            1
 3     3           0            0
 4     4           0            0
 5     5           3            3
 6     6           0            1
 7     7           0            3
 8     8           3            3
 9     9           2            3
10    10           2            2
...