r - 是否有更快的方法来合并数据帧并循环组合？

Question

我有两个数据框:

1. dfA每行有 10 个观察值。
2. dfB对所有单独的观察结果都有相应的价格。

我的任务是查看 dfA 中的任意 2 行，找出两行中都有哪些元素，总结匹配商品的价格，并将结果存储在新数据帧 dfC 中.

例如，假设我们有 dfA :

row 1: A, B, C, X, X, X, X, X, X, X  
row 2: Z, Z, A, Z, C, Z, Z, B, Z, Z

以及dfB :

A, 63  
B, 22  
C, 99  
...

第 1 行和第 2 行的重叠部分是 A、B 和 C，所以我想要 (63 + 22 + 99) / 1000在dfC[1, 2]和dfC[2, 1] .

下面的代码做了我需要它做的事情，但是随着 n 变大，它的效率不高。我的实际dfA有超过 1000 行，运行可能需要大约 10 分钟，所以我正在寻找更有效地编写它的方法。

set.seed(42)
n <- 10
dfA <- data.frame(replicate(10 ,sample(LETTERS,n,rep=TRUE)), stringsAsFactors = F)
dfB <- data.frame(ID = LETTERS, Price = as.numeric(sample(1:100, 26, replace=FALSE)), stringsAsFactors = F)

overlapPrice <- function (A, B) {
        if (A == B) {
                return(1)
        } else {
                x <- intersect(t(dfA[A, ]), t(dfA[B, ]))     
                return(sum(dfB$Price[match(x, dfB$ID)])/1000)  
        }
}

dfC <- data.frame(matrix(vector(), n, n))    
for (i in (1:n)) {
        for (j in (i:n)) {
                dfC[i, j]  <-   overlapPrice(i, j)  
                dfC[j, i]  <-   dfC[i, j]  

        }
} 

Answer 1

像这样跨行工作，将 dfA 转换为矩阵会更快，否则您将从构成数据框的所有向量中重复进行子集化。

matA <- as.matrix(dfA)

接下来，让我们使用 combn，它只会创建每个配对一次，因此您不会对每个组合计算两次。 combn() 可以采用一个函数在每个组合上运行，其中该函数采用combn 原本输出的向量，例如

str(combn(seq(3), 2, simplify = FALSE))
#> List of 3
#>  $ : int [1:2] 1 2
#>  $ : int [1:2] 1 3
#>  $ : int [1:2] 2 3
str(combn(seq(3), 2, function(x) rev(x), simplify = FALSE))
#> List of 3
#>  $ : int [1:2] 2 1
#>  $ : int [1:2] 3 1
#>  $ : int [1:2] 3 2

我们可以使用此函数对 matA 进行子集化并对每个组合进行计算。

vecC <- combn(nrow(matA), 2, function(x) {
    row1 <- matA[x[1], ]
    row2 <- matA[x[2], ]
    sum(dfB$Price[match(intersect(row1, row2), dfB$ID)]) / 1000
})

vecC
#>  [1] 0.329 0.103 0.119 0.204 0.204 0.255 0.262 0.196 0.146 0.160 0.071 0.204
#> [13] 0.370 0.109 0.260 0.181 0.000 0.066 0.018 0.019 0.018 0.039 0.081 0.000
#> [25] 0.105 0.018 0.108 0.000 0.133 0.113 0.233 0.141 0.148 0.184 0.112 0.190
#> [37] 0.178 0.181 0.000 0.192 0.157 0.273 0.194 0.145 0.169

这个结果相当于dfC的下三角形:

all(vecC == dfC[lower.tri(dfC)])
#> [1] TRUE

但是很难看出什么与什么相关，所以让我们将其转换为索引和值的数据框:

dfCi <- as.data.frame(t(combn(nrow(matA), 2)))
names(dfCi) <- c('i1', 'i2')
dfCi$value <- vecC

str(dfCi)
#> 'data.frame':    45 obs. of  3 variables:
#>  $ i1   : int  1 1 1 1 1 1 1 1 1 2 ...
#>  $ i2   : int  2 3 4 5 6 7 8 9 10 3 ...
#>  $ value: num [1:45(1d)] 0.329 0.103 0.119 0.204 0.204 0.255 0.262 0.196 0.146 0.16 ...

head(dfCi)
#>   i1 i2 value
#> 1  1  2 0.329
#> 2  1  3 0.103
#> 3  1  4 0.119
#> 4  1  5 0.204
#> 5  1  6 0.204
#> 6  1  7 0.255

如果您想 reshape 它以重新创建像 dfC 这样的方阵，您可以:

# reverse indices to get points for opposite triangle
dfCiRev <- dfCi
dfCiRev[1:2] <- dfCi[2:1]
names(dfCiRev) <- names(dfCi)

# reshape to wide form (use `pivot_wider` or `reshape` or `dcast` or whatever you prefer)
matC <- as.matrix(tidyr::spread(rbind(dfCi, dfCiRev), i2, value, fill = 1)[-1])
dimnames(matC) <- rep(list(colnames(matA)), 2)

matC
#>        X1    X2    X3    X4    X5    X6    X7    X8    X9   X10
#> X1  1.000 0.329 0.103 0.119 0.204 0.204 0.255 0.262 0.196 0.146
#> X2  0.329 1.000 0.160 0.071 0.204 0.370 0.109 0.260 0.181 0.000
#> X3  0.103 0.160 1.000 0.066 0.018 0.019 0.018 0.039 0.081 0.000
#> X4  0.119 0.071 0.066 1.000 0.105 0.018 0.108 0.000 0.133 0.113
#> X5  0.204 0.204 0.018 0.105 1.000 0.233 0.141 0.148 0.184 0.112
#> X6  0.204 0.370 0.019 0.018 0.233 1.000 0.190 0.178 0.181 0.000
#> X7  0.255 0.109 0.018 0.108 0.141 0.190 1.000 0.192 0.157 0.273
#> X8  0.262 0.260 0.039 0.000 0.148 0.178 0.192 1.000 0.194 0.145
#> X9  0.196 0.181 0.081 0.133 0.184 0.181 0.157 0.194 1.000 0.169
#> X10 0.146 0.000 0.000 0.113 0.112 0.000 0.273 0.145 0.169 1.000

all(matC == as.matrix(dfC))
#> [1] TRUE

最好的部分是计算 vecC 比 dfC 快很多:

# A tibble: 3 x 13
  expression     min  median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory time  gc   
  <bch:expr> <bch:t> <bch:t>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list> <list> <lis> <lis>
1 original   36.14ms 37.85ms      24.4      63KB     2.03    12     1      493ms <NULL> <df[,… <bch… <tib…
2 outer      53.33ms 56.67ms      15.1      86KB     2.15     7     1      465ms <NULL> <df[,… <bch… <tib…
3 combn       1.69ms  1.81ms     531.     58.6KB     4.33   245     2      461ms <NULL> <df[,… <bch… <tib…