windows - Brug af variationskoefficient i aggregat R

Indlæg af Hanne Mølgaard Plasc

Problem



Jeg har en dataramme med 50000 rækker og 200 kolonner. Der er dobbelt række i dataene, og jeg vil aggregere dataene ved at vælge rækken med maksimal variationskoefficient blandt duplikaterne ved hjælp af aggregatfunktionen i R. Med aggregat kan jeg bruge 'average', 'sum' som standard, men ikke coef. variation.
For eksempel
aggregat (data, as.columnname, FUN=mean)
Fungerer fint


Jeg har en brugerdefineret funktion til beregning af variationskoefficient, men ikke sikker på, hvordan man bruger det med aggregat.


co.var <- funktion (x)
(
 100 * sd (x)/gennemsnit (x)
)


Jeg har forsøgt
aggregat (data, as.columnname, funktion (x) max (co.var (x, data [[index (x),]])))
men det giver en fejl, da objekt x ikke findes.


Nogen forslag!

Bedste reference


Forudsat at jeg forstår dit problem, foreslår jeg at bruge tapply() i stedet for aggregate() (se ?tapply for mere info). Men et minimalt arbejdseksempel ville være meget nyttigt.


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,]


EDIT:


Der er hurtigere måder, hvoraf den ene er under. Men med en 40000 ved 100 datasæt tog koden kun mellem 16 og 20 sekunder på min maskine.


# 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


Tid den oprindelige metode


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


Tid anden metode


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


Og kontroller at vi får de samme resultater:


R> all.equal(mySel,mySel3)
[1] TRUE


Der er en yderligere ændring fra det oprindelige indlæg, idet den redigerede kode mener, at der kan være mere end en række med det højeste CV for et givet ID. Derfor skal du have unlist mySel eller mySel3 objekter for at få resultaterne fra den redigerede kode:


myDF.firstMethod[unlist(mySel),]

myDF.thirdMethod[unlist(mySel3),]