R中的下采样矩阵？

Question

我的问题是关于如何提高函数的性能，从矩阵的列中下采样而不用替换（又称为“稀疏矩阵”......我知道这里提到了这个here，但是我找不到明确答案a）做我需要的; b）快速完成）。

这里是我的功能：

downsampled <- function(data,samplerate=0.8) { 
    data.test <- apply(data,2,function(q) { 
    names(q) <- rownames(data) 
    samplepool <- character() 
    for (i in names(q)) { 
     samplepool <- append(samplepool,rep(i,times=q[i])) 
    } 
    sampled <- sample(samplepool,size=samplerate*length(samplepool),replace = F) 
    tab <- table(sampled) 
    mat <- match(names(tab),names(q)) 
    toret=numeric(length <- length(q)) 
    names(toret) <- names(q) 
    toret[mat] <- tab 
    return(toret) 
    }) 
return(data.test) 
} 

我需要进行采样矩阵与数以百万计的条目。我觉得这是相当缓慢（在这里我使用1000×1000矩阵，这大约是20-100x比我典型的数据尺寸）：

mat <- matrix(sample(0:40,1000*1000,replace=T),ncol=1000,nrow=1000) 
colnames(mat) <- paste0("C",1:1000) 
rownames(mat) <- paste0("R",1:1000) 
system.time(matd <- downsampled(mat,0.8)) 

## user system elapsed 
## 69.322 21.791 92.512 

是否有执行该操作更快/更简单的方法，我有没有想过？

Answer 1

节省的一个来源是删除使用rep追加样本池的for循环。这里是一个重复的例子：

myRows <- 1:5 
names(myRows) <- letters[1:5] 
# get the repeated values for sampling 
samplepool <- rep(names(myRows), myRows) 

在你的功能，这将是

samplepool <- rep(names(q), q) 

Answer 2

我觉得你可以做这将大大加快。如果我理解你正在尝试做的是正确的，那么你需要对矩阵的每个单元格进行下采样，例如，如果samplerate = 0.5和矩阵的单元格是mat[i,j] = 5，那么你想要采样多达5件东西，每件东西都有一个0.5被抽样的机会。

为了加快速度，而不是做对矩阵的列所有这些操作，你可以通过矩阵的每个细胞循环，借鉴该小区ň东西用runif（例如，如果mat[i,j] = 5，你可以生成0到1之间的5个随机数，然后累加值为< samplerate）的数量，最后将事物的数量添加到新矩阵中。我认为这有效地实现了相同的下采样方案，但更有效率（无论是在运行时间和代码行方面）。

# Sample matrix 
set.seed(23) 
n <- 1000 
mat <- matrix(sample(0:10,n*n,replace=T),ncol=n,nrow=n) 
colnames(mat) <- paste0("C",1:n) 
rownames(mat) <- paste0("R",1:n) 

# Old function 
downsampled<-function(data,samplerate=0.8) { 
    data.test<-apply(data,2,function(q){ 
    names(q)<-rownames(data) 
    samplepool<-character() 
    for (i in names(q)) { 
     samplepool=append(samplepool,rep(i,times=q[i])) 
    } 
    sampled=sample(samplepool,size=samplerate*length(samplepool),replace = F) 
    tab=table(sampled) 
    mat=match(names(tab),names(q)) 
    toret=numeric(length = length(q)) 
    names(toret)<-names(q) 
    toret[mat]<-tab 
    return(toret) 
    }) 
return(data.test) 
} 

# New function 
downsampled2 <- function(mat, samplerate=0.8) { 
    new <- matrix(0, nrow(mat), ncol(mat)) 
    colnames(new) <- colnames(mat) 
    rownames(new) <- rownames(mat) 
    for (i in 1:nrow(mat)) { 
     for (j in 1:ncol(mat)) { 
      new[i,j] <- sum(runif(mat[i,j], 0, 1) < samplerate) 
     } 
    } 
    return(new) 
} 

# Compare times 
system.time(downsampled(mat,0.8)) 
## user system elapsed 
## 26.840 3.249 29.902 
system.time(downsampled2(mat,0.8)) 
## user system elapsed 
## 4.704 0.247 4.918 

使用示例1000 X 1000矩阵，我提供的新函数运行速度提高了大约6倍。