优化申请

Question

我有一些现有的代码可以计算数据框/矩阵的一致性值。基本上是行数，其中所有值在总行数中都是相同的。

...
concordance<-new[complete.cases(new),] #removes rows with NAs
TF<-apply(concordance, 1, function(x) if(length(unique(x))>1) F else T)
#outputs vector of T/F if it is concordant
numF<-table(TF)["TRUE"]#gets number of trues
concValue<-numF/NROW(TF) #true/total
...

以上是我现在所拥有的。一切正常，但我想知道是否有任何方法可以使其更快。

编辑：对象的尺寸是可变的，但是列数通常为2-6，通常有1,000,000+行。这是我正在开发的程序包的一部分，因此输入数据是可变的。

Answer 1

因为行数比列数大得多，所以改为在列上循环是有必要的，因为在过程中存在多个不同的一个值的情况下，丢弃行：

propIdentical <- function(Mat){
    nrowInit <- nrow(Mat)  

    for(i in 1:(ncol(Mat) - 1)){
       if(!nrow(Mat)) break #stop if the matrix has no rows
       else{
            #check which elements of column i and column i+1 are equal:
            equals <- Mat[,i] == Mat[, i+1] 

            # remove all other rows from the matrix
            Mat <- Mat[equals,,drop = F]
       }
    }

    return(nrow(Mat)/nrowInit)
}

一些测试

set.seed(1)

# normal case
dat <- matrix(sample(1:10, rep = T, size = 3*10^6), nrow = 10^6)
system.time(prI <- propIdentical(dat)) ; prI

 user  system elapsed 
 0.053   0.017   0.070 
[1] 0.009898

# normal case on my pc for comparison:
system.time(app <- mean(apply(dat, 1, function(x) length(unique(x))) == 1L)); app
   user  system elapsed 
 12.176   0.036  12.231 
[1] 0.009898

# worst case
dat <- matrix(1L, nrow = 10^6, ncol = 6)
> system.time(prI <- propIdentical(dat)) ; prI
   user  system elapsed 
  0.302   0.044   0.348 
[1] 1
# worst case on my pc for comparison
system.time(mean(apply(dat, 1, function(x) length(unique(x))) == 1L))
   user  system elapsed 
 12.562   0.001  12.578

# testing drop = F and if(!nrow(Mat)) break
dat <- matrix(1:2, ncol = 2)
> system.time(prI <- propIdentical(dat)) ; prI
   user  system elapsed 
      0       0       0 
[1] 0

注意：如果您在data.frame上运行此代码，请确保先将其转换为矩阵。