Существует ли более быстрый способ объединения фреймов данных и циклических комбинаций? - PullRequest
Новая
       31

Существует ли более быстрый способ объединения фреймов данных и циклических комбинаций?

2 голосов
/ 13 апреля 2020

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

  1. dfA имеет 10 наблюдений в строке.
  2. 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].

Следующий код делает то, что мне нужно, но он неэффективен, так как п становится большим. Фактический 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]  

        }
}

Ответы [ 2 ]

3 голосов
/ 13 апреля 2020

Работая со строками, подобными этой, быстрее превратить 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…

benchmarking plot

2 голосов
/ 13 апреля 2020

Использование 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
...