使用 "combn" 和 "outer" 函数的组合提高操作速度
Increase speed for operations using a combination of "combn" and "outer" functions
我有一个数据框 df,它有两个变量,如下所示。使用下面的代码,我想得到矩阵“mat”。
此代码非常适合 unique(df$V1)= 3,但对于 unique(df$V1) 为 1000 的操作需要花费大量时间(>10 小时)。
数据框
V1 V2
1 60
1 30
1 38
1 46
2 29
2 35
2 13
2 82
3 100
3 72
3 63
3 45
代码:
#Unique V1 values
vec <- unique(df$V1)
#Count <= valies
val <- combn(vec, 2, function(x)
sum(outer(df$V2[df$V1 == x[1]], df$V2[df$V1 == x[2]], `<=`)))
val
#[1] 5 14 13
#Create an empty matrix
mat <- matrix(0,length(vec), length(vec))
#Fill the lower triangle of the matrix.
mat[lower.tri(mat)] <- val
mat
基本上,对于 V1=1,我们想要将 V2 的所有值与 V1=2 和 3 的 V2 的所有值进行比较。对 V1=2 和 V1=3 重复相同的操作。换句话说,对于给定的 V1 值,我们想要查看 V2 中的值是否小于 V2 中的值,因为 V1 中的其余值。例如,我们比较 V2 中 V1=1 和 V1=2 的值。如果 V2 中 V1=1 的值小于 V2 中 V1=2 的值,则 return 值为 1,否则为 0。例如:
For V1=1->
( 60 > 29 : returns 0,
60 > 35 : returns 0,
60 > 13 : returns 0,
60 < 82 : returns 1,
30 > 29 : returns 0,
30 < 35 : returns 1,
30 > 13 : returns 0,
30 < 82 : returns 1,
38 > 29 : returns 0,
38 > 35 : returns 0,
38 > 13 : returns 0,
38 < 82 : returns 1,
46 > 29 : returns 0,
46 > 35 : returns 0,
46 > 13 : returns 0,
30 < 82 : returns 1)=Sum is 5 (i.e. mat[1,2])
我无法确切地弄清楚你想要什么,因为我认为你的矩阵不应该是对称的。
也许 data.table::CJ
这个选项就是您要找的:
library(data.table)
setDT(df)
result <- df[,CJ(A = V1, B = V1,unique=TRUE)][
,.(sum(sapply(df[V1==A,V2],function(x)x <= df[V1==B,V2]))),by = c("A","B")]
result
A B V1
1: 1 1 10
2: 1 2 5
3: 1 3 14
4: 2 1 11
5: 2 2 10
6: 2 3 13
7: 3 1 2
8: 3 2 3
9: 3 3 10
mat <- matrix(result$V1, ncol = length(unique(df$V1)), nrow = length(unique(df$V1)))
diag(mat) <- 0
mat
[,1] [,2] [,3]
[1,] 0 11 2
[2,] 5 0 3
[3,] 14 13 0
set.seed(3)
df2 <- data.table(V1 = sample(1:100,1000,TRUE), V2 = sample(10:100,1000,TRUE))
system.time(df2[,CJ(A = V1, B = V1,unique=TRUE)][
,.(sum(sapply(df2[V1==A,V2],function(x)x <= df2[V1==B,V2]))),by = c("A","B")])
user system elapsed
118.817 1.081 119.949
这是一种避免 outer
.
的方法
sapply(combn(split(df$V2, df$V1), 2, simplify = FALSE), function(x){
sum(sapply(x[[1]], function(a) sum(a <= x[[2]])))
})
# [1] 5 14 13
或者
sapply(vec, function(x) sapply(vec, function(y){
if (x == y) {
0
} else {
d1 = df$V2[df$V1 == x]
d2 = df$V2[df$V1 == y]
sum(sapply(d1, function(a) sum(a <= d2)))
}
}))
# [,1] [,2] [,3]
#[1,] 0 11 2
#[2,] 5 0 3
#[3,] 14 13 0
对于这个问题,这应该快如闪电,并且不会使用过多的内存。
library(data.table)
setDT(df)
numvec <- max(df[,V1])
dl <- lapply(1:numvec, function(i) df[V1 == i, sort(V2)])
dmat <- CJ(x=1:numvec, y=1:numvec)[, .(z = sum(findInterval(dl[[y]],dl[[x]]))), .(x,y)]
mat <- as.matrix(dcast(dmat, x~y, value.var = 'z')[, -'x'])
我有一个数据框 df,它有两个变量,如下所示。使用下面的代码,我想得到矩阵“mat”。
此代码非常适合 unique(df$V1)= 3,但对于 unique(df$V1) 为 1000 的操作需要花费大量时间(>10 小时)。
数据框
V1 V2
1 60
1 30
1 38
1 46
2 29
2 35
2 13
2 82
3 100
3 72
3 63
3 45
代码:
#Unique V1 values
vec <- unique(df$V1)
#Count <= valies
val <- combn(vec, 2, function(x)
sum(outer(df$V2[df$V1 == x[1]], df$V2[df$V1 == x[2]], `<=`)))
val
#[1] 5 14 13
#Create an empty matrix
mat <- matrix(0,length(vec), length(vec))
#Fill the lower triangle of the matrix.
mat[lower.tri(mat)] <- val
mat
基本上,对于 V1=1,我们想要将 V2 的所有值与 V1=2 和 3 的 V2 的所有值进行比较。对 V1=2 和 V1=3 重复相同的操作。换句话说,对于给定的 V1 值,我们想要查看 V2 中的值是否小于 V2 中的值,因为 V1 中的其余值。例如,我们比较 V2 中 V1=1 和 V1=2 的值。如果 V2 中 V1=1 的值小于 V2 中 V1=2 的值,则 return 值为 1,否则为 0。例如:
For V1=1->
( 60 > 29 : returns 0,
60 > 35 : returns 0,
60 > 13 : returns 0,
60 < 82 : returns 1,
30 > 29 : returns 0,
30 < 35 : returns 1,
30 > 13 : returns 0,
30 < 82 : returns 1,
38 > 29 : returns 0,
38 > 35 : returns 0,
38 > 13 : returns 0,
38 < 82 : returns 1,
46 > 29 : returns 0,
46 > 35 : returns 0,
46 > 13 : returns 0,
30 < 82 : returns 1)=Sum is 5 (i.e. mat[1,2])
我无法确切地弄清楚你想要什么,因为我认为你的矩阵不应该是对称的。
也许 data.table::CJ
这个选项就是您要找的:
library(data.table)
setDT(df)
result <- df[,CJ(A = V1, B = V1,unique=TRUE)][
,.(sum(sapply(df[V1==A,V2],function(x)x <= df[V1==B,V2]))),by = c("A","B")]
result
A B V1
1: 1 1 10
2: 1 2 5
3: 1 3 14
4: 2 1 11
5: 2 2 10
6: 2 3 13
7: 3 1 2
8: 3 2 3
9: 3 3 10
mat <- matrix(result$V1, ncol = length(unique(df$V1)), nrow = length(unique(df$V1)))
diag(mat) <- 0
mat
[,1] [,2] [,3]
[1,] 0 11 2
[2,] 5 0 3
[3,] 14 13 0
set.seed(3)
df2 <- data.table(V1 = sample(1:100,1000,TRUE), V2 = sample(10:100,1000,TRUE))
system.time(df2[,CJ(A = V1, B = V1,unique=TRUE)][
,.(sum(sapply(df2[V1==A,V2],function(x)x <= df2[V1==B,V2]))),by = c("A","B")])
user system elapsed
118.817 1.081 119.949
这是一种避免 outer
.
sapply(combn(split(df$V2, df$V1), 2, simplify = FALSE), function(x){
sum(sapply(x[[1]], function(a) sum(a <= x[[2]])))
})
# [1] 5 14 13
或者
sapply(vec, function(x) sapply(vec, function(y){
if (x == y) {
0
} else {
d1 = df$V2[df$V1 == x]
d2 = df$V2[df$V1 == y]
sum(sapply(d1, function(a) sum(a <= d2)))
}
}))
# [,1] [,2] [,3]
#[1,] 0 11 2
#[2,] 5 0 3
#[3,] 14 13 0
对于这个问题,这应该快如闪电,并且不会使用过多的内存。
library(data.table)
setDT(df)
numvec <- max(df[,V1])
dl <- lapply(1:numvec, function(i) df[V1 == i, sort(V2)])
dmat <- CJ(x=1:numvec, y=1:numvec)[, .(z = sum(findInterval(dl[[y]],dl[[x]]))), .(x,y)]
mat <- as.matrix(dcast(dmat, x~y, value.var = 'z')[, -'x'])