我有2个带有文本数据的数据集。 dataset1：clusters11和dataset2：transactns11。我在代码中使用For循环，处理数据需要更多时间。所以任何人都可以建议我如何减少所花费的时间。请仔细阅读以下示例数据集和我正在使用的代码。
dataset1: clusters11
cluster_id clusters
1 A,B,C
2 A,B
3 B,C
4 C,D,E
5 B,C,D
6 D,E,F
7 A,D,F
8 B,G,H
9 B,C,F
10 G,H,M
11 A,H,N
12 B,C,M
dataset2: transactns11
unique_id skills
221 A,B,C
223 A,B
224 B,C
225 C,D,E,F
226 B,C,D,M
227 D,E,F,A
228 A,D,F
229 B,G,H
230 B,C,F,A
231 G,H,M
232 A,H,N
233 B,C,M
234 A,B,C
235 A,B
236 B,C
237 C,D,E
238 B,C,D
239 D,E,F
我希望得到我的输出：out_df就是这样（在cluster11文件中的任何集群与transactns11中的技能匹配100％应该以cluster_id的逗号分隔，并且输出中的列名为matching_values。
unique_id skills matching_values
221 A,B,C 1,2,3
223 A,B 2
224 B,C 3
225 C,D,E,F 4,6
226 B,C,D,M 3,5,12
227 D,E,F,A 6,7
228 A,D,F 7
229 B,G,H 8
230 B,C,F,A 1,2,3,9
231 G,H,M 10
232 A,H,N 11
233 B,C,M 3,12
234 A,B,C 1,2,3
235 A,B 2
236 B,C 3
237 C,D,E 4
238 B,C,D 3,5
239 D,E,F 6
为此，我有代码，它与我合作
out_df <- data.frame(matrix(0, ncol = 3, nrow = nrow(transactns11)))
colnames(out_df) <- c("unique_id", "skills", "matching_values")
transactns11$skills=as.character(transactns11$skills)
clusters11$clusters=as.character(clusters11$clusters)
for(n in 1:nrow(transactns11)) {
trans1 <- strsplit(transactns11$skills[n], ",")
trans1
transvect <- unlist(trans1)
transvect
matching_clusters <- c("")
out_df$unique_id[n] <- as.character(transactns11$unique_id[n])
out_df$skills[n] <- transactns11$skills[n]
for(i in 1:nrow(clusters11)) {
cluster1 <- strsplit(clusters11$clusters[i],",")
cluster1
clustervect <- unlist(cluster1)
clustervect
if(length(intersect(transvect,clustervect)) == length(clustervect)) {
matching_clusters <- paste(matching_clusters, clusters11$cluster_id[i], sep = ",")
}
}
matching_clusters <- substring(matching_clusters,2)
out_df$matching_values[n] <- matching_clusters
}
问题在于，当2个文件的recods更像10000或20000（时间为15到20小时）时，代码需要更多时间。 任何人都可以建议我如何避免这种循环或我可以遵循的任何其他方法来改进代码并减少处理所需的大量时间。 提前致谢。 问候， 哈利
答案 0 :(得分：1)
我不知道这会有多快，但让我们试试：
首先，将群集名称存储在codes
codes<-LETTERS[1:14]
然后对clusters1$clusters和transactns1$skills
clusters2<-sapply(codes,grepl,x=clusters1$clusters)
transactns2<-sapply(codes,grepl,x=transactns1$skills)
编写一个函数，测试给定的簇是否适合给定的transactn：
is_ok<-function(clus, tran) !any(!(tran) & clus)
e.g。
is_ok(clusters2[1,], transactns2[2,])
[1] FALSE
这告诉您群集1不适合第二次交易。
然后编写一个函数来检查给定transactn的所有集群。我使用magrittr包来访问%>%运算符。
library(magrittr)
matching_values<-function(tran) apply(clusters2,1,is_ok,tran=tran) %>% which
%>% paste(collapse=',')
快速检查：
matching_values(transactns2[5,])
[1] "3,5,12"
最后，将最后一个函数应用于所有transactns：
apply(transactns2,1,matching_values)
[1] "1,2,3" "2" "3" "4,6" "3,5,12" "6,7" "7" "8" "1,2,3,9"
[10] "10" "11" "3,12" "1,2,3" "2" "3" "4" "3,5" "6"
答案 1 :(得分：0)
此解决方案使用dplyr，tidyr和purrr中的函数。所以我为所有这些函数加载了tidyverse包。 dt_final将是最终输出。
# Load package
library(tidyverse)
# Separate the skills and cluster letters
dt1_update <- clusters11 %>%
mutate(Group = strsplit(clusters, split = ",")) %>%
unnest(Group) %>%
select(-clusters)
dt2_update <- transactns11 %>%
mutate(Group = strsplit(skills, split = ",")) %>%
unnest(Group) %>%
select(-skills)
# Split the data frame
dt1_list <- split(dt1_update, f = dt1_update$cluster_id)
dt2_list <- split(dt2_update, f = dt2_update$unique_id)
# Design a function to determine if the Group elements matched
# df1 is data frame from dt1_list, df2 is data frame from dt2_list
is.match <- function(df1, df2){
if (all(df1$Group %in% df2$Group)){
return(TRUE)
} else {
return(FALSE)
}
}
# Design a function to return the ID
id.return <- function(df2, df1_list){
answer <- map(df1_list, .f = is.match, df2 = df2)
answer <- names(which(unlist(answer)))
return(paste(answer, collapse = ","))
}
# Design a function to apply all the id.return function to all combination
id.check <- function(df2_list, df1_list){
return(map_chr(df2_list, .f = id.return, df1_list = df1_list))
}
# Apply the id.check function
dt_final <- transactns11 %>%
mutate(matching_values = id.check(dt2_list, dt1_list))
# Create example data frame 1
clusters11 <- read.table(text = "cluster_id clusters
1 A,B,C
2 A,B
3 B,C
4 C,D,E
5 B,C,D
6 D,E,F
7 A,D,F
8 B,G,H
9 B,C,F
10 G,H,M
11 A,H,N
12 B,C,M",
header = TRUE, stringsAsFactors = FALSE)
# Create example data frame 2
transactns11 <- read.table(text = "unique_id skills
221 A,B,C
223 A,B
224 B,C
225 C,D,E,F
226 B,C,D,M
227 D,E,F,A
228 A,D,F
229 B,G,H
230 B,C,F,A
231 G,H,M
232 A,H,N
233 B,C,M
234 A,B,C
235 A,B
236 B,C
237 C,D,E
238 B,C,D
239 D,E,F",
header = TRUE, stringsAsFactors = FALSE)
以上代码可以解决OP的原始问题。但是，根据OP的评论，真实数据集具有随机cluster_id和unique_id。所以我决定更新我的答案，以便能够概括使用这种方法。
基本上，如果cluster_id函数可以返回正确的ID，则随机id.return应该不是问题。处理随机unique_id的关键是在应用函数之前按unique_id对数据框进行排序。以下是更新后的代码。
这部分是一样的。但是，为了模拟OP的真实世界数据，我将transactns11数据帧随机化并创建sorting_id以在应用函数后恢复数据帧的顺序。
# Load package
library(tidyverse)
# Create example data frame 1
clusters11 <- read.table(text = "cluster_id clusters
1 A,B,C
2 A,B
3 B,C
4 C,D,E
5 B,C,D
6 D,E,F
7 A,D,F
8 B,G,H
9 B,C,F
10 G,H,M
11 A,H,N
12 B,C,M",
header = TRUE, stringsAsFactors = FALSE)
# Create example data frame 2
transactns11 <- read.table(text = "unique_id skills
221 A,B,C
223 A,B
224 B,C
225 C,D,E,F
226 B,C,D,M
227 D,E,F,A
228 A,D,F
229 B,G,H
230 B,C,F,A
231 G,H,M
232 A,H,N
233 B,C,M
234 A,B,C
235 A,B
236 B,C
237 C,D,E
238 B,C,D
239 D,E,F",
header = TRUE, stringsAsFactors = FALSE)
根据OP的更新，随机化行以模拟实际情况
# Set seed for reproducibility
set.seed(123)
transactns11 <- transactns11 %>%
# Ransomize the rows
sample_n(size = nrow(.))
现在transactns11看起来像这样。
unique_id skills
6 227 D,E,F,A
14 235 A,B
7 228 A,D,F
17 238 B,C,D
15 236 B,C
1 221 A,B,C
16 237 C,D,E
10 231 G,H,M
18 239 D,E,F
5 226 B,C,D,M
8 229 B,G,H
4 225 C,D,E,F
9 230 B,C,F,A
3 224 B,C
13 234 A,B,C
11 232 A,H,N
12 233 B,C,M
2 223 A,B
创建sorting_id
transactns11 <- transactns11 %>%
# Create a sorting ID
mutate(sorting_id = 1:n())
transactns11现在看起来像这样。
unique_id skills sorting_id
1 227 D,E,F,A 1
2 235 A,B 2
3 228 A,D,F 3
4 238 B,C,D 4
5 236 B,C 5
6 221 A,B,C 6
7 237 C,D,E 7
8 231 G,H,M 8
9 239 D,E,F 9
10 226 B,C,D,M 10
11 229 B,G,H 11
12 225 C,D,E,F 12
13 230 B,C,F,A 13
14 224 B,C 14
15 234 A,B,C 15
16 232 A,H,N 16
17 233 B,C,M 17
18 223 A,B 18
现在运行以下代码。此处唯一重要的更新是在创建transactns11
unique_id排序dt2_update
# Separate the skills and cluster letters
dt1_update <- clusters11 %>%
mutate(Group = strsplit(clusters, split = ",")) %>%
unnest(Group) %>%
select(-clusters)
dt2_update <- transactns11 %>%
# Sort the data frame by unique_id
arrange(unique_id) %>%
mutate(Group = strsplit(skills, split = ",")) %>%
unnest(Group) %>%
select(-skills)
# Split the data frame
dt1_list <- split(dt1_update, f = dt1_update$cluster_id)
dt2_list <- split(dt2_update, f = dt2_update$unique_id)
# Design a function to determine if the Group elements matched
# df1 is data frame from dt1_list, df2 is data frame from dt2_list
is.match <- function(df1, df2){
if (all(df1$Group %in% df2$Group)){
return(TRUE)
} else {
return(FALSE)
}
}
# Design a function to return the ID
id.return <- function(df2, df1_list){
answer <- map(df1_list, .f = is.match, df2 = df2)
answer <- names(which(unlist(answer)))
return(paste(answer, collapse = ","))
}
# Design a function to apply all the id.return function to all combination
id.check <- function(df2_list, df1_list){
return(map_chr(df2_list, .f = id.return, df1_list = df1_list))
}
现在应用id.check功能。请注意，在执行此操作之前，必须按unique_id对数据框进行排序。完成匹配后，按sorting_id对数据框进行排序以恢复原始订单。
# Apply the id.check function
dt_final <- transactns11 %>%
# Sort the data frame by unique_id
arrange(unique_id) %>%
mutate(matching_values = id.check(dt2_list, dt1_list)) %>%
# Sort the data frame by sorting_id
arrange(sorting_id) %>%
select(-sorting_id)
这是最终输出。
unique_id skills matching_values
1 227 D,E,F,A 6,7
2 235 A,B 2
3 228 A,D,F 7
4 238 B,C,D 3,5
5 236 B,C 3
6 221 A,B,C 1,2,3
7 237 C,D,E 4
8 231 G,H,M 10
9 239 D,E,F 6
10 226 B,C,D,M 3,5,12
11 229 B,G,H 8
12 225 C,D,E,F 4,6
13 230 B,C,F,A 1,2,3,9
14 224 B,C 3
15 234 A,B,C 1,2,3
16 232 A,H,N 11
17 233 B,C,M 3,12
18 223 A,B 2
答案 2 :(得分：0)
这种新方法可将数据转换为入射矩阵，从而可以轻松地将事务与群集进行比较。
library(arules)
transactions1 <- read.table(text = "unique_id skills
221 A,B,C
223 A,B
224 B,C
225 C,D,E,F
226 B,C,D,M
227 D,E,F,A
228 A,D,F
229 B,G,H
230 B,C,F,A
231 G,H,M
232 A,H,N
233 B,C,M
234 A,B,C
235 A,B
236 B,C
237 C,D,E
238 B,C,D
239 D,E,F", header=T, stringsAsFactors=F)
clusters <- read.table(text="cluster_id clusters
1 A,B,C
2 A,B
3 B,C
4 C,D,E
5 B,C,D
6 D,E,F
7 A,D,F
8 B,G,H
9 B,C,F
10 G,H,M
11 A,H,N
12 B,C,M", header=T, stringsAsFactors=F)
transactions2 <- sapply(split(transactions1$skills, 1:nrow(transactions1)), strsplit, split = ",")
names(transactions2) <- transactions1$unique_id
clusters2 <- sapply(split(clusters$clusters, 1:nrow(clusters)), strsplit, split=",")
names(clusters2) <- clusters$cluster_id
transactions2 <- +(as(as(transactions2, "transactions"), "matrix"))
clusters2 <- +(as(as(clusters2, "transactions"), "matrix"))
coInc <- transactions2 %*% t(clusters2)
coInc <- t(+(t(coInc) == rowSums(clusters2)))
res <- as(coInc, "transactions")
res <- as(res, "list")
res <- as.data.frame(sapply(res, paste, collapse=","))
res$skills <- transactions1$skills[match(rownames(res), transactions1$unique_id)]
res$id <- rownames(res)
colnames(res) <- c("clusters","skills","id")
res <- res[, c(3,2,1)]
# id skills clusters
#221 221 A,B,C 1,2,3
#223 223 A,B 2
#224 224 B,C 3
#225 225 C,D,E,F 4,6
#226 226 B,C,D,M 3,5,12
#227 227 D,E,F,A 6,7
#228 228 A,D,F 7
#229 229 B,G,H 8
#230 230 B,C,F,A 1,2,3,9
#231 231 G,H,M 10
#232 232 A,H,N 11
#233 233 B,C,M 3,12
#234 234 A,B,C 1,2,3
#235 235 A,B 2
#236 236 B,C 3
#237 237 C,D,E 4
#238 238 B,C,D 3,5
#239 239 D,E,F 6
答案 3 :(得分：0)
我会使用apply系列函数，因为它是基础R：
clusters11 <- data.frame(cluster_id = seq(1:12),
clusters = c('A,B,C','A,B','B,C','C,D,E','B,C,D','D,E,F','A,D,F',
'B,G,H','B,C,F','G,H,M','A,H,N','B,C,M'))
transactions11 <- data.frame(unique_id = c(221, seq(223,239, by = 1)),
skills = c('A,B,C', 'A,B', 'B,C', 'C,D,E,F', 'B,C,D,M',
'D,E,F,A', 'A,D,F', 'B,G,H', 'B,C,F,A', 'G,H,M',
'A,H,N', 'B,C,M', 'A,B,C', 'A,B', 'B,C', 'C,D,E',
'B,C,D', 'D,E,F'))
s <- apply(sapply(as.character(clusters11$clusters), grepl,
as.character(transactions11$skills)), 1, which)
d.list <- sapply(as.character(clusters11$clusters), strsplit, "\\,")
tf.tab <- lapply(d.list, function(x) apply(sapply(x, function(x)
grepl(x, transactions11$skills)), 1, all, TRUE))
d.matrix <- do.call(cbind, tf.tab)
transactions11 <- data.frame(transactions11,
matching_values = apply(d.matrix, 1, function(x) paste(which(x == TRUE),
collapse = ",")))
> transactions11
unique_id skills matching_values
1 221 A,B,C 1,2,3
2 223 A,B 2
3 224 B,C 3
4 225 C,D,E,F 4,6
5 226 B,C,D,M 3,5,12
6 227 D,E,F,A 6,7
7 228 A,D,F 7
8 229 B,G,H 8
9 230 B,C,F,A 1,2,3,9
10 231 G,H,M 10
11 232 A,H,N 11
12 233 B,C,M 3,12
13 234 A,B,C 1,2,3
14 235 A,B 2
15 236 B,C 3
16 237 C,D,E 4
17 238 B,C,D 3,5
18 239 D,E,F 6
这应该比循环更快。