R - 比较 R 中 2 个数据帧之间的数据



让我们假设我们在R中有2个数据帧。

a = data.frame(col1 = round(runif(6,1,20)),col2 = c("a b c","b e z","a c q","a b","w","u o p l"), stringsAsFactors = F)
b = data.frame(col1 = 1:10, col2 = round(runif(10,1,10)), col3 = round(runif(10,10,20)), col4 = c(paste(letters[1:15], collapse=" "),paste(letters[10:25], collapse=" "),paste(letters[1:15], collapse=" "),paste(letters[1:19], collapse=" "),paste(letters[10:15], collapse=" "),paste(letters[1:15], collapse=" "),paste(letters[20:25], collapse=" "),paste(letters[1:15], collapse=" "),paste(letters[3:26], collapse=" "),paste(letters[1:2], collapse=" ")),stringsAsFactors = F)

数据集是:

a
 col1    col2
   15   a b c
    8   b e z
   11   a c q
   15     a b
    5       w
   12 u o p l
b
col1 col2  col3                                           col4
1     1     10                   a b c d e f g h i j k l m n o
2     2     12                 j k l m n o p q r s t u v w x y
3     4     12                   a b c d e f g h i j k l m n o
4     4     16           a b c d e f g h i j k l m n o p q r s
5     2     13                                     j k l m n o
6     3     15                   a b c d e f g h i j k l m n o
7     1     12                                     t u v w x y
8     2     18                   a b c d e f g h i j k l m n o
9     4     16 c d e f g h i j k l m n o p q r s t u v w x y z
10    3     12                                             a b

我想根据以下几点在数据帧"a"中创建第 3 列 col3:

  1. A$Col3 将包含来自数据帧"B"的 Col1 的值的序列号列表。
  2. b$col1 的那些值将被选择 a$col1 位于每行的 b$col2 和 b$col3 值之间。
  3. 此外,a$col2 中的字母应该存在于 b$col4 中。(不需要订购。"a s"等同于"s a"。

最终所需的数据集。

a
 col1    col2     col3
   15   a b c    4 6 8
    8   b e z   
   11   a c q      4 9
   15     a b    4 6 8
    5       w    2 7 9
   12 u o p l      2 9

提醒一句——For-loops解决方案不起作用,因为我使用的数据帧很大。(有数百万行(。任何其他方法将不胜感激。

提前谢谢。

使用tidyverse(dplyrstringrpurrr (你可以做这样的事情......

 a2 <- b %>% mutate(col5=map2(col2,col3,~seq(.x,.y,1))) %>% #expand b to include all values between col2 and col3
  unnest() %>% 
  inner_join(a,by=c("col5"="col1")) %>% #match these against a col1
  filter(map2_lgl(col2.y,col4,~all(str_detect(.y,unlist(strsplit(.x," ")))))) %>% #filter by string matches
  group_by(col5,col2.y) %>% #group by original a columns
  summarize(col3=paste(sort(col1),collapse=" ")) %>% #collapse matching b col1 values
  right_join(a,by=c("col5"="col1","col2.y"="col2")) %>% #merge back into a
  rename(col1=col5,col2=col2.y) #restore column names

由于您的随机化过程,我得到了不同的数据帧(顺便说一句,sample()可能是比round(runif())更好的方法(,但这是我最终得到的......

> a
  col1    col2
1    7   a b c
2    5   b e z
3   10   a c q
4   14     a b
5    4       w
6    2 u o p l
> b
   col1 col2 col3                                            col4
1     1    4   11                   a b c d e f g h i j k l m n o
2     2   10   15                 j k l m n o p q r s t u v w x y
3     3    4   19                   a b c d e f g h i j k l m n o
4     4    8   13           a b c d e f g h i j k l m n o p q r s
5     5    7   13                                     j k l m n o
6     6    2   14                   a b c d e f g h i j k l m n o
7     7    8   11                                     t u v w x y
8     8    8   19                   a b c d e f g h i j k l m n o
9     9   10   19 c d e f g h i j k l m n o p q r s t u v w x y z
10   10    8   16                                             a b
> a2
# A tibble: 6 x 3
# Groups:   col1 [6]
   col1 col2    col3    
  <dbl> <chr>   <chr>   
1    7. a b c   1 3 6   
2    5. b e z   NA      
3   10. a c q   4       
4   14. a b     3 6 8 10
5    4. w       NA      
6    2. u o p l NA

这是一个可能的解决方案。对我来说,运行代码生成 a 和 b 后,数据集如下。

一个

col1 col2
5    a b c
4    b e z
2    a c q
17   a b
8    w
17   u o p l

col1 col2 col3 col4
1    5    13   a b c d e f g h i j k l m n o
2    6    20   j k l m n o p q r s t u v w x y
3    8    17   a b c d e f g h i j k l m n o
4    3    17   a b c d e f g h i j k l m n o p q r s
5    7    12   j k l m n o
6    4    13   a b c d e f g h i j k l m n o
7    2    18   t u v w x y
8    7    14   a b c d e f g h i j k l m n o
9    4    18   c d e f g h i j k l m n o p q r s t u v w x y z
10   8    18   a b

首先,我们使用 fuzzjoin 包来确保 a$col1 的值介于 b$col2 和 b$col3(含(之间。

library(fuzzyjoin)
c <- fuzzy_inner_join(a, b,
                      by = c("col1" = "col2", "col1" = "col3"),
                      match_fun = list(`>=`, `<=`))

接下来,由于这个答案,我们使用

compare <- function(s1, s2) {
  c1 <- unique(strsplit(s1, "")[[1]])
  c2 <- unique(strsplit(s2, "")[[1]])
  length(intersect(c1,c2))/length(c1)
}
vcomp <- Vectorize(compare)
c <- transform(c, comp = vcomp(col2.x, col4))

我们得到了 A$Col2 中出现在 B$Col4 中的字符百分比的估计值。

最后,我们限制为 100% 字符匹配的记录,并将 b$col1 折叠成由空格分隔的字符串。这是使用 dplyr 包完成的。

library(dplyr)
d <- c %>%
  filter(comp >= 1) %>%
  select(col1.x, col2.x, col1.y) %>%
  group_by(col1.x, col2.x) %>%
  summarise(col3 = paste(col1.y, collapse = " "))
colnames(d) <- c("col1", "col2", "col3")

最终结果见表d。

col1 col2    col3
5    a b c   1 4 6
8    w       2 7 9
17   a b     3 4 10
17   u o p l 2 9

示例数据具有随机性 - 使用set.seed进行重现总是一个好主意。所以这是另一个数据集:

set.seed(1)
a = data.frame(col1 = round(runif(6,1,20)),col2 = c("a b c","b e z","a c q","a b","w","u o p l"), stringsAsFactors = F)
b = data.frame(col1 = 1:10, col2 = round(runif(10,1,10)), col3 = round(runif(10,10,20)), col4 = c(paste(letters[1:15], collapse=" "),paste(letters[10:25], collapse=" "),paste(letters[1:15], collapse=" "),paste(letters[1:19], collapse=" "),paste(letters[10:15], collapse=" "),paste(letters[1:15], collapse=" "),paste(letters[20:25], collapse=" "),paste(letters[1:15], collapse=" "),paste(letters[3:26], collapse=" "),paste(letters[1:2], collapse=" ")),stringsAsFactors = F)
> a
  col1    col2
1    6   a b c
2    8   b e z
3   12   a c q
4   18     a b
5    5       w
6   18 u o p l
> b
   col1 col2 col3                                            col4
1     1   10   17                   a b c d e f g h i j k l m n o
2     2    7   20                 j k l m n o p q r s t u v w x y
3     3    7   14                   a b c d e f g h i j k l m n o
4     4    2   18           a b c d e f g h i j k l m n o p q r s
5     5    3   19                                     j k l m n o
6     6    3   12                   a b c d e f g h i j k l m n o
7     7    7   17                                     t u v w x y
8     8    4   11                   a b c d e f g h i j k l m n o
9     9    8   13 c d e f g h i j k l m n o p q r s t u v w x y z
10   10    5   14                                             a b

首先将字符串转换为向量:

a$col2_vec <- strsplit(a$col2, " ")
b$col4_vec <- strsplit(b$col4, " ")

查找满足" a$col1介于 b$col2b$col3 之间 "的所有行。

btwn <- lapply(a$col1, function(x) which(b$col2 <= x & x <= b$col3))

查找所有满足"a$col2字母在b$col4中"的行

ltr_in <- lapply(a$col2_vec, 
                 function(y) which(sapply(b$col4_vec, 
                                          function(x) all(y %in% x))
                                  )
                )  

找到行的交集并将它们粘贴到字符串中。

a$col3 <- sapply(lapply(seq_along(btwn), 
                        function(i) intersect(btwn[[i]], ltr_in[[i]])), 
                 paste0, collapse=" ")

结果:

a$col2_vec <- NULL
> a
  col1    col2  col3
1    6   a b c 4 6 8
2    8   b e z      
3   12   a c q     4
4   18     a b     4
5    5       w      
6   18 u o p l     2

如果一个人关心一个非常大的数据集,这似乎比另一个答案更快,这对于学习purrr东西来说仍然非常好。(编辑:添加了第三个答案。

Unit: milliseconds
           expr       min        lq      mean   median       uq       max neval
           @ngm  1.300393  1.412308  1.625972  1.45799  1.49936  14.94079   100
 @Andrew Gustar 18.630475 19.208137 19.825766 19.47883 20.09018  23.84303   100
      @radmuzon 57.647023 58.555243 64.455069 60.30342 62.77680 286.40073   100

相关内容

  • 没有找到相关文章

最新更新