2013-08-26 2 views
1

Для данного столбца в кадре данных я хочу построить новый вектор, который для каждой точки состоит из среднего значения точек с обеих сторон. Однако для последнего наблюдения он вместо этого будет вторым. И для первого наблюдения он будет вторым. Я написал этот код R, чтобы решить проблему, но я назову ее неоднократно, и она очень медленная. Может кто-нибудь дать несколько советов о том, как сделать это более эффективно? Благодарю.Как улучшить производительность этой линейной интерполяции в r

x1 <- c(rep('a',100),rep('b',100),rep('c',100)) 
x2 <- rnorm(300) 
x <- data.frame(x1,x2) 
names(x) <- c('col1','data1') 


a.linear.interpolation <- function(x) { 
    require(zoo) 
    require(data.table) 

    a.dattab <- data.table(x) 

    setkey(a.dattab,col1) 

    #replace any NA values using LOCF/NOCB 
    a.dattab[,data1:=na.locf(data1,na.rm=FALSE),by=list(col1)] 
    a.dattab[,data1:=na.locf(data1,na.rm=FALSE,fromLast=TRUE),by=list(col1)] 

    #Adding a within group sequence number and a size of group field to facilitate 
    #row by row processing 
    a.dattab[,grpseq:=seq_len(.N),by=list(col1)] 
    a.dattab[,grpseq_max:=.N,by=list(col1)] 

    #convert back to data.frame 
    #data.frame seems faster than data.table for this row by row type processing 
    a.df <- data.frame(a.dattab) 

    new.col <- vector(length=nrow(a.df)) 

    for(i in seq(nrow(a.df))){ 
     if(a.df[i,"grpseq"]==1){ 
       new.col[i] <- a.df[i+1,"data1"] 
      } 
     else if(a.df[i,"grpseq"]==a.df[i,"grpseq_max"]){ 
       new.col[i] <- a.df[i-1,"data1"] 
      } 
     else { 
       new.col[i] <- (a.df[i-1,"data1"]+a.df[i+1,"data1"])/2 
      } 
    } 

    return(new.col) 
} 
+3

Вы уже используете PKG :: зоопарк. Почему бы не использовать 'rollapply'? или 'rollmeans' –

+0

Почему вы используете' na.locf' два раза? После первого не останется никаких NA. Кроме того, если первое значение вектора - 'NA', ваша процедура вызовет репликацию полученного более короткого вектора. –

ответ

1

Помимо использования rollmeans, функция базового R filter может делать такие вещи, как хорошо. Например .:

linint <- function(vec) { 
    c(vec[2], filter(vec, c(0.5, 0, 0.5))[-c(1, length(vec))], vec[length(vec) - 1]) 
} 

x <- c(1,3,6,10,1) 
linint(x) 
#[1] 3.0 3.5 6.5 3.5 10.0 

И это довольно быстро, жевательная через случаях 10М менее чем второй:

x <- rnorm(1e7) 
system.time(linint(x)) 
#user system elapsed 
#0.57 0.18 0.75 
Смежные вопросы