首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >结合使用"combn“和"outer”函数来提高运算速度

结合使用"combn“和"outer”函数来提高运算速度
EN

Stack Overflow用户
提问于 2020-12-20 00:50:06
回答 3查看 122关注 0票数 1

我有一个dataframe,df,有两个变量,如下所示。使用下面的代码,我想得到矩阵"mat“。

此代码适用于unique(df$V1)= 3,但对于unique(df$V1)为1000秒的操作,它需要大量时间(>10小时)。

数据帧

代码语言:javascript
复制
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

代码:

代码语言:javascript
复制
#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中的rest值。例如,我们比较V1=1和V1=2的V2中的值,如果V1=1的V2中的值小于V1=2的V2中的值,则返回值为1或0。例如:

代码语言:javascript
复制
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])
EN

回答 3

Stack Overflow用户

回答已采纳

发布于 2020-12-20 02:43:15

对于这个问题,这应该是闪电般的速度,并且不会使用过多的内存。

代码语言:javascript
复制
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'])
票数 7
EN

Stack Overflow用户

发布于 2020-12-20 01:27:17

我很难弄清楚你到底想要什么,因为我不认为你的矩阵应该是对称的。

也许data.table::CJ的这个选项就是您想要的:

代码语言:javascript
复制
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
代码语言:javascript
复制
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 
票数 2
EN

Stack Overflow用户

发布于 2020-12-20 02:10:53

这里有一种避免outer的方法。

代码语言:javascript
复制
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

代码语言:javascript
复制
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
票数 1
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/65372170

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档