Есть ли более быстрый способ объединения фреймов данных и повторения комбинаций?

У меня есть два фрейма данных:

dfA содержит 10 наблюдений в строке.
dfB имеет соответствующую цену на все отдельные наблюдения.

Моя задача состоит в том, чтобы просмотреть любые 2 строки в dfA, выяснить, какие элементы находятся в обеих строках, просуммировать цену совпадающих элементов и сохранить результаты в новом фрейме данных, 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]  

        }
}

Curt D 13.04.2020 источник

Ответы (2)

arrow_upward
3
arrow_downward

Работая с такими строками, быстрее превратить dfA в матрицу, иначе вы многократно подмножаете все векторы, составляющие фрейм данных.

matA <- as.matrix(dfA)

Далее давайте воспользуемся 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

Если вы хотите изменить его форму, чтобы воссоздать квадратную матрицу, например 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…

alistaire 13.04.2020

arrow_upward
2
arrow_downward

Использование outer может ускорить

f1 <- function(i, j) {
       x <- intersect(t(dfA[i, ]),  t(dfA[j, ]))
       sum(dfB$Price[match(x, dfB$ID)])/1000
    }
out <-  outer(seq_len(n), seq_len(n), FUN = Vectorize(f1))
diag(out) <- 1
all.equal(dfC, as.data.frame(out), check.attributes = FALSE)
#[1] TRUE

akrun 13.04.2020

Есть ли более быстрый способ объединения фреймов данных и повторения комбинаций?

Ответы (2)

Похожие вопросы