벡터화 된 R 필터링 및 데이터 프레임에서 여러 지연 값 가져 오기

Question

벡터화 질문이 있는데 온라인 솔루션을 찾지 못하는 것 같습니다. 나는 매우 큰 dataframe이 있고, 현재 나는 지연 값을 필터링하고 얻을 수있는 다음과 같은 루프를 사용하고 있습니다 : 각각에 대해

> df 
    rowtype values1 index firstBLagged secondBLagged thirdBLagged 
1  A  2  1   0    0   0 
2  B  1  2   0    0   0 
3  A  8  3   0    0   0 
4  A  5  4   0    0   0 
5  B  -4  5   0    0   0 
6  B  6  6   0    0   0 
7  B  42  7   0    0   0 
8  B  10  8   0    0   0 
9  A  20  9   10   42   6 
10  B  5 10   0    0   0 
11  B  7 11   0    0   0 
12  A  8 12   7    5   10 
13  B  -2 13   0    0   0 
14  A  8 14   7    5   10 
15  B  9 15   0    0   0 
16  B  3 16   0    0   0 
17  A  2 17   3    9   7 
18  A  5 18   3    9   7 

본질적 :

이

rowtype <-c('A','B','A','A','B','B','B','B','A','B','B','A','B','A','B','B','A','A'); 
values1<-c(2,1,8,5,-4,6,42,10,20,5,7,8,-2,8,9,3,2,5); 
index<-seq(1:length(values1)); 

df<-data.frame(rowtype, values1, index); 

mininumBsize <- 2; 

df$firstBLagged<-0; 
df$secondBLagged<-0; 
df$thirdBLagged<-0; 

for (idx in which(df$rowtype=='A')) 
{ 
    #get the past 5 lagged values of type 'B' that exceed a threshold 
    laggedValues <- rev(df[df$rowtype=='B' & df$values1 > mininumBsize & df$index < idx,]$values1)[1:5]; 

    #take out any NA values here 
    laggedValues[is.na(laggedValues)]<-0; 

    #store those lagged values back into the dataframe 
    df$firstBLagged[idx]<-laggedValues[1]; 
    df$secondBLagged[idx]<-laggedValues[2]; 
    df$thirdBLagged[idx]<-laggedValues[3]; 
} 

dataframe의 출력은 다음과 같습니다를 행에 'A'유형이 있으면 특정 임계 값 인 "mininumBsize"를 초과하는 'B'유형의 과거 5 개 값을 가져오고 싶습니다. 그런 다음 df $ firstBlagged 등으로 데이터 프레임에 다시 저장하고 싶습니다. 나중에 회귀 분석 및 기타 분석에 사용할 수 있습니다.

불행히도이 코드는 실행하는 데 너무 오래 걸립니다. (그리고 더 나은 R을 작성하는 방법도 알고 싶습니다.) 대부분의 온라인 예제는 행 ​​자체 만 필터링하는 방법을 보여 주지만 조건에 따라 지연 값을 얻는 방법은 표시하지 않습니다. 누구든지이 문제를 해결하는 방법을 알고 있습니까? 감사!

Answer 1

완전히 벡터화하는 쉬운 방법은 없지만 하나 있으면 학습하는 데 관심이 있습니다. 그러나 더 효율적으로 만들 수 있습니다.

의 더 큰 data.frame을 사용하자, 그래서 우리는 system.time을 사용할 수 있습니다 : 이제

addlagged<-function(df,mininumBsize = 2){ 
    df$firstBLagged<-0; 
    df$secondBLagged<-0; 
    df$thirdBLagged<-0; 

    for (idx in which(df$rowtype=='A')) 
    { 
    #get the past 5 lagged values of type 'B' that exceed a threshold 
    laggedValues <- rev(df[df$rowtype=='B' & df$values1 > mininumBsize & df$index < idx,]$values1)[1:5]; 

    #take out any NA values here 
    laggedValues[is.na(laggedValues)]<-0; 

    #store those lagged values back into the dataframe 
    df$firstBLagged[idx]<-laggedValues[1]; 
    df$secondBLagged[idx]<-laggedValues[2]; 
    df$thirdBLagged[idx]<-laggedValues[3]; 
    } 
    return(df) 
} 

보다 효율적인 기능 :

을

rowtype <-rep(c('A','B','A','A','B','B','B','B','A','B','B','A','B','A','B','B','A','A'),1000) 
values1<-rep(c(2,1,8,5,-4,6,42,10,20,5,7,8,-2,8,9,3,2,5),1000) 
index<-seq(1:length(values1)) 

df<-data.frame(rowtype, values1, index) 

이제 우리는 함수에 코드를 포장

addlagged2<-function(df,mininumBsize = 2){ 
    #make sure rowtype is not a factor, but a character 
    df$rowtype<-as.character(df$rowtype) 
    #subset before the loop 
    df2<-subset(df,!(rowtype=="B" & values1<mininumBsize)) 


    #initialize vectors 
    firstBLagged <- rep(0,nrow(df2)) 
    secondBLagged <- rep(0,nrow(df2)) 
    thirdBLagged <- rep(0,nrow(df2)) 

    for (idx in which(df2$rowtype=='A')) 
    { 
    #get the past 3 lagged values of type 'B'  
    laggedValues <- df2$values1[1:idx][df2$rowtype[1:idx]=='B'] 
    #do not use rev 
    laggedValues <- laggedValues[length(laggedValues):(length(laggedValues)-2)] 

    #don't save to data.frame inside loop, use vectors 
    firstBLagged[idx]<-laggedValues[1]; 
    secondBLagged[idx]<-laggedValues[2]; 
    thirdBLagged[idx]<-laggedValues[3]; 
    } 
    #take out any NA values here (do it only ones and not inside the loop) 
    firstBLagged[is.na(firstBLagged)]<-0 
    secondBLagged[is.na(secondBLagged)]<-0 
    thirdBLagged[is.na(thirdBLagged)]<-0 

    #create columns in df  
    df$firstBLagged<-0 
    df$secondBLagged<-0 
    df$thirdBLagged<-0 

    #transfer results to df 
    df$firstBLagged[!(as.character(df$rowtype)=="B" & df$values1<mininumBsize)]<-firstBLagged 
    df$secondBLagged[!(as.character(df$rowtype)=="B" & df$values1<mininumBsize)]<-secondBLagged 
    df$thirdBLagged[!(as.character(df$rowtype)=="B" & df$values1<mininumBsize)]<-thirdBLagged 
    return(df) 
} 

더 빠릅니까?

> system.time(df2<-addlagged(df)) 
     User  System verstrichen 
    37.157  24.591  61.735 
> system.time(df3<-addlagged2(df)) 
     User  System verstrichen 
     2.866  0.517  3.382 

결과가 동일합니까?

> df3$rowtype<-factor(df3$rowtype) 
> identical(df2,df3) 
[1] TRUE 

개선 된 기능을 수행하는 데 필요한 대부분의 시간은 무엇입니까? Rprof의 출력을 살펴 봅시다 :

는

> summaryRprof() 
$by.self 
       self.time self.pct total.time total.pct 
"=="     0.346 61.79  0.346  61.79 
":"     0.189 33.75  0.189  33.75 
"$"     0.016  2.86  0.016  2.86 
"$<-.data.frame"  0.005  0.89  0.005  0.89 
"try"    0.001  0.18  0.002  0.36 
"-"     0.001  0.18  0.001  0.18 
"is.na"    0.001  0.18  0.001  0.18 
"tryCatch"   0.001  0.18  0.001  0.18 

$by.total 
       total.time total.pct self.time self.pct 
"=="     0.346  61.79  0.346 61.79 
":"     0.189  33.75  0.189 33.75 
"$"     0.016  2.86  0.016  2.86 
"$<-.data.frame"  0.005  0.89  0.005  0.89 
"$<-"     0.005  0.89  0.000  0.00 
"try"     0.002  0.36  0.001  0.18 
"-"     0.001  0.18  0.001  0.18 
"is.na"    0.001  0.18  0.001  0.18 
"tryCatch"   0.001  0.18  0.001  0.18 

$sample.interval 
[1] 0.001 

$sampling.time 
[1] 0.56 

대부분의 시간은 모든 subseting 루프에서 시퀀스를 생성하여 보내고있다. * apply 함수를 사용하면 도움이되지 않습니다. data.table과 이진 검색을 사용하려고했지만 도움이되지 않았습니다. 루프 내부에 키를 설정해야했기 때문에 가능합니다. data.table에 대한 경험이 많지 않으므로 아마도 뭔가 잘못된 것이 있습니다.

결국 코드 검토 였고 실제로 스택 오버플로에 속하지 않습니다.