让我们假设我们在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:
- A$Col3 将包含来自数据帧"B"的 Col1 的值的序列号列表。
- b$col1 的那些值将被选择 a$col1 位于每行的 b$col2 和 b$col3 值之间。
- 此外,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
(dplyr
、stringr
和 purrr
(你可以做这样的事情......
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$col2
和 b$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