使用总变异系数

piy*_*ush 2 r

我有一个包含 50000 行和 200 列的数据框。数据中有重复的行,我想通过使用 R 中的聚合函数在重复项中选择具有最大变异系数的行来聚合数据。使用聚合,我可以默认使用“mean”、“sum”,但不能使用系数变化.

例如

aggregate(data, as.columnname, FUN=mean)
Run Code Online (Sandbox Code Playgroud)

工作正常。

我有一个用于计算变异系数的自定义函数,但不确定如何将它与聚合一起使用。

co.var <- function(x)
(
 100*sd(x)/mean(x)
)
Run Code Online (Sandbox Code Playgroud)

我试过了

aggregate(data, as.columnname, function (x) max (co.var (x, data[index (x),])
Run Code Online (Sandbox Code Playgroud)

但它给出了一个错误,因为找不到对象 x。

Ben*_*nes 5

假设我了解您的问题,我建议使用tapply()而不是aggregate()?tapply有关更多信息,请参阅)。但是,一个最小的工作示例将非常有帮助。

co.var <- function(x) ( 100*sd(x)/mean(x) )

## Data with multiple repeated measurements.
## There are three things (ID 1, 2, 3) that 
## are measured two times, twice each (val1 and val2)
myDF<-data.frame(ID=c(1,2,3,1,2,3),val1=c(20,10,5,25,7,2),
  val2=c(19,9,4,24,4,1))

## Calculate coefficient of variation for each measurement set
myDF$coVar<-apply(myDF[,c("val1","val2")],1,co.var)

## Use tapply() instead of aggregate
mySel<-tapply(seq_len(nrow(myDF)),myDF$ID,function(x){
  curSub<-myDF[x,]
  return(x[which(curSub$coVar==max(curSub$coVar))])
})

## The mySel vector is then the vector of rows that correspond to the
## maximum coefficient of variation for each ID
myDF[mySel,]
Run Code Online (Sandbox Code Playgroud)

编辑:

有更快的方法,下面是其中之一。但是,对于 40000 x 100 的数据集,上面的代码在我的机器上只需要 16 到 20 秒。

# Create a big dataset

myDF <- data.frame(val1 = c(20, 10, 5, 25, 7, 2),
  val2 = c(19, 9, 4, 24, 4, 1))
myDF <- myDF[sample(seq_len(nrow(myDF)), 40000, replace = TRUE), ]
myDF <- cbind(myDF, rep(myDF, 49))
myDF$ID <- sample.int(nrow(myDF)/5, nrow(myDF), replace = TRUE)

# Define a new function to work (slightly) better with large datasets

co.var.df <- function(x) ( 100*apply(x,1,sd)/rowMeans(x) )

# Create two datasets to benchmark the two methods
# (A second method proved slower than the third, hence the naming)

myDF.firstMethod <- myDF
myDF.thirdMethod <- myDF
Run Code Online (Sandbox Code Playgroud)

计时原方法

startTime <- Sys.time()
myDF.firstMethod$coVar <- apply(myDF.firstMethod[,
  grep("val", names(myDF.firstMethod))], 1, co.var)
mySel <- tapply(seq_len(nrow(myDF.firstMethod)),
  myDF.firstMethod$ID, function(x) {
    curSub <- myDF.firstMethod[x, ]
    return(x[which(curSub$coVar == max(curSub$coVar))])
}, simplify = FALSE)
endTime <- Sys.time()

R> endTime-startTime
Time difference of 17.87806 secs
Run Code Online (Sandbox Code Playgroud)

时间秒法

startTime3 <- Sys.time()
coVar3<-co.var.df(myDF.thirdMethod[,
  grep("val",names(myDF.thirdMethod))])
mySel3 <- tapply(seq_along(coVar3),
  myDF[, "ID"], function(x) {
    return(x[which(coVar3[x] == max(coVar3[x]))])
}, simplify = FALSE)
endTime3 <- Sys.time()

R> endTime3-startTime3
Time difference of 2.024207 secs
Run Code Online (Sandbox Code Playgroud)

并检查我们是否得到相同的结果:

R> all.equal(mySel,mySel3)
[1] TRUE
Run Code Online (Sandbox Code Playgroud)

与原始帖子相比,还有一个额外的变化,即编辑后的代码认为给定 ID 的最高 CV 可能不止一行。因此,要从编辑后的代码中获得结果,您必须unlist使用mySelmySel3对象:

myDF.firstMethod[unlist(mySel),]

myDF.thirdMethod[unlist(mySel3),]
Run Code Online (Sandbox Code Playgroud)

  • 那很好用。有了这个,我们得到了具有最小系数的行。var,只需将“min(curSub$coVar)”更改为“max(curSub$coVar)”即可达到最大值。谢谢您的帮助。 (2认同)