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倍。