Question

我有一个大的，稀疏的二进制矩阵（大约39,000 x 14,000;大多数行只有一个“1”条目）。我想将类似的行聚集在一起，但我的初始计划需要很长时间才能完成：

d <- dist(inputMatrix, method="binary")
hc <- hclust(d, method="complete")

第一步没有完成，所以我不确定第二步的表现如何。有哪些方法可以有效地在R？

中对大型稀疏二进制矩阵的相似行进行分组

Answer 1

我已经编写了一些Rcpp代码和R代码，它们可以计算出二进制矩阵的二进制/ Jaccard距离。比dist(x, method = "binary")快80倍。它将输入矩阵转换为原始矩阵，该矩阵是输入的转置（以便位模式在内部以正确的顺序）。然后将其用于某些C ++代码中，该代码将数据处理为64位无符号整数以提高速度。两个向量x和y的Jaccard距离等于x ^ y / (x | y)，其中^是xor运算符。如果xor或or的结果为非零，Hamming Weight计算用于计算设置的位数。

我已将代码放在https://github.com/NikNakk/binaryDist/的github上，并复制了下面的两个文件。我已经确认，对于一些随机数据集，结果与dist(x, method = "binary")相同。

在39000行乘14000列的数据集上，每行1-5个，大约需要11分钟。输出距离矩阵为5.7 GB。

bDist.cpp

#include <Rcpp.h>
using namespace Rcpp;

//countBits function taken from https://en.wikipedia.org/wiki/Hamming_weight#Efficient_implementation

const uint64_t m1  = 0x5555555555555555; //binary: 0101...
const uint64_t m2  = 0x3333333333333333; //binary: 00110011..
const uint64_t m4  = 0x0f0f0f0f0f0f0f0f; //binary:  4 zeros,  4 ones ...
const uint64_t h01 = 0x0101010101010101; //the sum of 256 to the power of 0,1,2,3...

int countBits(uint64_t x) {
  x -= (x >> 1) & m1;             //put count of each 2 bits into those 2 bits
  x = (x & m2) + ((x >> 2) & m2); //put count of each 4 bits into those 4 bits 
  x = (x + (x >> 4)) & m4;        //put count of each 8 bits into those 8 bits 
  return (x * h01)>>56;  //returns left 8 bits of x + (x<<8) + (x<<16) + (x<<24) + ... 
}

// [[Rcpp::export]]
int countBitsFromRaw(RawVector rv) {
  uint64_t* x = (uint64_t*)RAW(rv);
  return(countBits(*x));
}

// [[Rcpp::export]]
NumericVector bDist(RawMatrix mat) {
  int nr(mat.nrow()), nc(mat.ncol());
  int nw = nr / 8;
  NumericVector res(nc * (nc - 1) / 2);
  // Access the raw data as unsigned 64 bit integers
  uint64_t* data = (uint64_t*)RAW(mat);
  uint64_t a(0);
  // Work through each possible combination of columns (rows in the original integer matrix)
  for (int i = 0; i < nc - 1; i++) {
    for (int j = i + 1; j < nc; j++) {
      uint64_t sx = 0;
      uint64_t so = 0;
      // Work through each 64 bit integer and calculate the sum of (x ^ y) and (x | y)
      for (int k = 0; k < nw; k++) {
        uint64_t o = data[nw * i + k] | data[nw * j + k];
        // If (x | y == 0) then (x ^ y) will also be 0
        if (o) {
          // Use Hamming weight method to calculate number of set bits
          so = so + countBits(o);
          uint64_t x = data[nw * i + k] ^ data[nw * j + k];
          if (x) {
            sx = sx + countBits(x);
          }
        }
      }
      res(a++) = (double)sx / so;
    }
  }
  return (res);
}

R source

library("Rcpp")
library("plyr")
sourceCpp("bDist.cpp")

# Converts a binary integer vector into a packed raw vector,
# padding out at the end to make the input length a multiple of packWidth
packRow <- function(row, packWidth = 64L) {
  packBits(as.raw(c(row, rep(0, (packWidth - length(row)) %% packWidth))))
}

as.PackedMatrix <- function(x, packWidth = 64L) {
  UseMethod("as.PackedMatrix")
}

# Converts a binary integer matrix into a packed raw matrix
# padding out at the end to make the input length a multiple of packWidth
as.PackedMatrix.matrix <- function(x, packWidth = 64L) {
  stopifnot(packWidth %% 8 == 0, class(x) %in% c("matrix", "Matrix"))
  storage.mode(x) <- "raw"
  if (ncol(x) %% packWidth != 0) {
    x <- cbind(x, matrix(0L, nrow = nrow(x), ncol = packWidth - (ncol(x) %% packWidth)))
  }
  out <- packBits(t(x))
  dim(out) <- c(ncol(x) %/% 8, nrow(x))
  class(out) <- "PackedMatrix"
  out
}

# Converts back to an integer matrix
as.matrix.PackedMatrix <- function(x) {
  out <- rawToBits(x)
  dim(out) <- c(nrow(x) * 8L, ncol(x))
  storage.mode(out) <- "integer"
  t(out)
}

# Generates random sparse data for testing the main function
makeRandomData <- function(nObs, nVariables, maxBits, packed = FALSE) {
  x <- replicate(nObs, {
    y <- integer(nVariables)
    y[sample(nVariables, sample(maxBits, 1))] <- 1L
    if (packed) {
      packRow(y, 64L)
    } else {
      y
    }
  })
  if (packed) {
    class(x) <- "PackedMatrix"
    x
  } else {
    t(x)
  }
}

# Reads a binary matrix from file or character vector
# Borrows the first bit of code from read.table
readPackedMatrix <- function(file = NULL, text = NULL, packWidth = 64L) {
  if (missing(file) && !missing(text)) {
    file <- textConnection(text)
    on.exit(close(file))
  }
  if (is.character(file)) {
    file <- file(file, "rt")
    on.exit(close(file))
  }
  if (!inherits(file, "connection")) 
    stop("'file' must be a character string or connection")
  if (!isOpen(file, "rt")) {
    open(file, "rt")
    on.exit(close(file))
  }
  lst <- list()
  i <- 1
  while(length(line <- readLines(file, n = 1)) > 0) {
    lst[[i]] <- packRow(as.integer(strsplit(line, "", fixed = TRUE)[[1]]), packWidth = packWidth)
    i <- i + 1
  }
  out <- do.call("cbind", lst)
  class(out) <- "PackedMatrix"
  out
}

# Wrapper for the C++ code which 
binaryDist <- function(x) {
  if (class(x) != "PackedMatrix") {
    x <- as.PackedMatrix(x)
  }
  dst <- bDist(x)
  attr(dst, "Size") <- ncol(x)
  attr(dst, "Diag") <- attr(dst, "Upper") <- FALSE
  attr(dst, "method") <- "binary"
  attr(dst, "call") <- match.call()
  class(dst) <- "dist"
  dst
}

x <- makeRandomData(2000, 400, maxBits = 5, packed = TRUE)

system.time(bd <- binaryDist(x))

原帖：

要考虑的其他事项是对两行与单个行进行一些预过滤比较，因为对于重复，距离将为0或对于任何其他可能性，距离将为1。

vegan 包中的vegdist函数和Dist这两个相对简单的选项可能更快而不需要太多代码来自 amap 包的功能。如果你有多个内核并利用它支持并行化的事实，后者可能会更快。

Answer 2

计算这么长时间的原因是对dist的调用是计算并存储超过7.6亿的成对距离。如果您的数据存储稀疏，则需要很长时间和大量存储空间。如果您的数据没有稀疏存储，那么每个距离计算至少需要14,000次操作，总操作次数超过1千万亿！

更快的方法是k均值聚类，因为它不需要预先计算距离矩阵;在每次迭代中，您只需要39000 * k个距离计算，其中k是簇的数量。要获得与Jaccard索引类似的成对距离（如果相同，则为0，如果没有索引重合，则为1，如果某些但不是所有索引重合，则为中间），您可以将每行x除以sqrt(2*sum(x^2))。例如，如果您有以下输入矩阵：

(mat <- rbind(c(1, 0, 0, 0, 0), c(0, 0, 0, 1, 1)))
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    1    0    0    0    0
# [2,]    0    0    0    1    1

标准化版本将是（仅在矩阵中假设二进制值;如果不是这种情况，则使用rowSums(mat^2)）：

(mat.norm <- mat / sqrt(2*rowSums(mat)))
#           [,1] [,2] [,3] [,4] [,5]
# [1,] 0.7071068    0    0  0.0  0.0
# [2,] 0.0000000    0    0  0.5  0.5

这两个观察结果（没有共同的指数），欧几里德距离1，与此情况下的Jaccard距离一致。

dist(mat.norm, "euclidean")
#   1
# 2 1

此外，相同的观察结果显然欧几里德距离为0，再次对应于Jaccard距离。

Answer 3

你有重复的行吗？无需计算两次距离。
单个1的所有行与不同位置的所有行100％不同。

因此，对此类数据运行群集没有意义。输出是可预测的，归结为找到1。

尝试将数据集限制为只有一个的对象。除非你只能在这些上获得有趣的结果，否则不需要继续下去。二进制数据信息太少。

在R中聚类一个大的，非常稀疏的二进制矩阵

3 个答案:

bDist.cpp

R source