計算 R 中數據幀中每對分類單元之間的差異

Question

從列聯matrix ，我們可以計算每對行之間的差異，然后將輸出轉換為data.frame 。

例如，使用 Bray-Curtis 距離，我們可以有：

# Generate matrix -------------------------------------------------------------
set.seed(1)
ex <- matrix(data = round(runif(100000), 1), nrow = 1000, ncol = 100)
rownames(ex) <- paste0("row", 1:nrow(ex))
colnames(ex) <- paste0("col", 1:ncol(ex))
ex[1:5, 1:5]
     col1 col2 col3 col4 col5
row1  0.3  0.5  0.9  0.8  0.2
row2  0.4  0.7  1.0  0.5  0.5
row3  0.6  0.4  0.9  0.2  0.0
row4  0.9  1.0  0.4  0.4  0.5
row5  0.2  0.1  0.2  0.8  0.9

# Dissimilarity ---------------------------------------------------------------
# Example of Bray-Curtis
library(ecodist)
bray <- bcdist(ex, rmzero = FALSE)
bray <- as.matrix(bray)
bray[upper.tri(bray)] <- NA
diag(bray) <- NA

# Convert distance matrix into data.frame
bray <- reshape2::melt(bray, varnames = c("id1", "id2"))
# Remove NAs
bray <- bray[complete.cases(bray), ]

head(bray)
   id1  id2     value
2 row2 row1 0.2767599
3 row3 row1 0.3541247
4 row4 row1 0.3588235
5 row5 row1 0.3935618
6 row6 row1 0.2948328
7 row7 row1 0.4045643

現在，我想知道是否有可能得到相同的輸出bray （即一個data frame有3列）從長格式data frame作為輸入。 例如，如果我們將上面提供的示例matrix轉換為：

# From a data.frame -----------------------------------------------------------
ex_df <- reshape2::melt(ex)
colnames(ex_df) <- c("row", "col", "value")

是否有可能在每對行之間獲得包含 Bray-Curtis 不相似性的相同bray輸出？ 我打賭存在高效的dplyr或data.table解決方案。

Answer 1

這會實現你所追求的。 基本上，它只是將長格式數據重新排列為類似矩陣的數據幀並從中計算 BC。 我想你的實際數據集是長格式的。

library(tidyverse)

BC_dist <- ex_df %>% 
  spread(2,3) %>% 
  column_to_rownames("row") %>% 
  bcdist(rmzero = FALSE)

Answer 2

ecodist::bcdist調用了 Bray Curtis 距離的 C 實現，這在時間上很難被擊敗。 但是，它是單線程的，因此，一種可能的方法是通過 Rcpp 使用 OpenMP 並行化計算：

bcd.cpp :

#include <omp.h>
#include <Rcpp.h>

using namespace Rcpp;

// [[Rcpp::plugins(openmp)]]

// [[Rcpp::export]]
NumericMatrix bcd(NumericMatrix m) {
    int i, j, k, nr = m.nrow(), nc = m.ncol();
    NumericMatrix res(nr, nr);
    double ms, sum;

    #pragma omp parallel for private(ms, sum, j, k)
    for (i = 0; i < nr - 1; i++) {
        for (j = i + 1; j < nr; j++) {
            ms = 0;
            sum = 0;
            for (k = 0; k < nc; k++) {
                if (m(i, k) < m(j, k)) {
                    ms += m(i, k);
                } else {
                    ms += m(j, k);
                }
                sum += m(i, k) + m(j, k);
            }
            res(j, i) = 1 - 2 * ms / sum;
        }
    }

    return(res);
}

計時碼：

set.seed(0L)
library(ecodist)

nr <- 10000
nc <- 100
m <- matrix(round(runif(nr*nc), 1L), nrow=nr, ncol=nc)

library(Rcpp)
sourceCpp("bcd.cpp")

microbenchmark::microbenchmark(times=3L,
    a1 <- bcdist(m, rmzero = FALSE),
    a2 <- bcd(m))

all.equal(as.vector(a1), a2[lower.tri(a2)])
#[1] TRUE

時間：

Unit: seconds
                            expr       min       lq      mean    median        uq       max neval
 a1 <- bcdist(m, rmzero = FALSE) 24.348883 24.42572 24.496605 24.502548 24.570466 24.638384     3
                    a2 <- bcd(m)  8.365889  8.50686  8.563122  8.647831  8.661739  8.675646     3