루프를 제거하기 위해 dplyr을 사용하는 방법은 무엇입니까?

Question

누락 된 관측치와 후속 산술을 가진 데이터에서 pairwise 일치를 수행하는 dplyr 메소드를 아는 사람이 있습니까? 아래의 for-loop 무거운 코드는 기본 MWE이지만 훌륭한 비네팅 및 문서에도 불구하고 dplyr 방식으로 내 팔을 얻을 수는 없습니다.

간단히 말해 코드는 을 계산합니다. 이는 누락 수량 관측치 q이 그 주에 인접한 adj 상점에서 판매 된 것의 평균입니다.

편집 : 여러 정책이있는 주에 관심이 있습니다. 아래 세로줄은 주 경계를 나타냅니다. 카운티 1, 2 및 3은 상태 A (정책 A 포함)에 있고 카운티 4, 5 및 6은 상태 B (정책 B 포함)에 있습니다. 카운티에는 여러 매장이있을 수 있습니다.

----|---- 
    1 | 4 
    |---- 
----| 5 
    2 | 
----|---- 
    3 | 6 
----|---- 

contig.id

는 대향 상태에서 하나 개 이상의 군으로 연속되는 군을 식별한다. 예를 들어, 카운티 1 ( contig.id == 1)은 1과 2가 동일한 상태이므로 카운티 2의 지리적 인접성을 무시한 반대 상태 ( adj1 == 4 및 adj2 == 5)의 카운티 4와 5에 인접합니다.

동일한 방법으로 county 4 (contig.id == 4)는 county 1에만 인접합니다 (adj1 == 1 및 adj2 == NA). EDIT 종료.

df <- data.frame(store  = c(1001,1001,145,331,228,228,500,500,61,1135), 
       end.week = c(20061125,20061118,20061125,20061125,20061125, 
          20061118,20061125,20061118,20061118,20061125), 
       contig.id = c(1,1,2,3,4,4,4,4,5,NA), 
       adj1  = c(4,4,5,6,1,1,1,1,1,NA), 
       adj2  = c(5,5,NA,NA,NA,NA,NA,NA,2,NA), 
       q   = c(12.25,14.5,18.75,16,16.5,22,55.25,8.25,24,37.75)) 

dev <- NULL 
dev1 <- NULL 
for (i in 1:length(df$contig.id)) { 
    temp1 <- integer(0) 
    temp2 <- integer(0) 
    if (is.na(df$contig.id[i]) == FALSE) { 
    temp1 <- which((df$contig.id == df$adj1[i]) & 
        (df$end.week == df$end.week[i])) 
    if (length(temp1) > 0) { 
     dev[i] <- sum(df$q[temp1]) 
    } 
    if (is.na(df$adj2[i]) == FALSE) { 
     temp2 <- which((df$contig.id == df$adj2[i]) & 
         (df$end.week == df$end.week[i])) 
     if (length(temp2) > 0) { 
     dev[i] <- dev[i] + sum(df$q[temp2]) 
     } 
    } 
    } else { 
    dev[i] <- NA 
    } 
    dev[i] <- dev[i]/(length(temp1) + length(temp2)) 
    dev1[i] <- (df$q[i])/dev[i] 
} 
df <- cbind(df,dev,dev1) 

Answer 1

실제로 여기에는 세 가지 종류의 정보가 있습니다. 그래서 복잡한 for-looping이 필요한 이유입니다. 나는 세 개의 테이블에 데이터를 정상화 시도했다 :

library(dplyr) 
library(tidyr) 

stores_time <- df %>% 
    select(-contig.id,-adj1,-adj2) 

stores_space <- df %>% 
    select(store,contig.id) %>% 
    mutate(county = contig.id %>% paste0("c",.)) %>% 
    select(-contig.id) %>% 
    unique 

counties <- df %>% 
    select(contig.id,adj1,adj2) %>% 
    mutate(county = contig.id %>% paste0("c",.)) %>% 
    select(-contig.id) %>% 
    unique %>% 
    gather(varname,adj_next_state,starts_with("adj")) %>% 
    select(-varname) %>% 
    mutate(adj_next_state = adj_next_state %>% paste0("c",.)) 

이제 우리는 시간 (stores_time)를 통해 각 점포의 판매에 대한 정보를 가지고, 공간의 각 상점의 "위치"(즉, 그들이에있는 카운티, stores_space) 카운티의 인접에 대한 정보 (counties). 또한 데이터를 광범위하게 변환했습니다. 다른 카운티와 인접한 카운티가있는 경우 편리 할 수 ​​있습니다.

우리는 "시간"과 "공간"모두 각 점포의 성능 데이터 집합을 얻기 위해, 함께이 모든 가입 할 수 있습니다

: 당신은 그 자체로 다시이 테이블에 가입해야

stores_tsc <- stores_time %>% 
    left_join(stores_space) %>% 
    left_join(counties) 

는 DEV을 계산하려면 . 이는 각 상점 x 시간 조합에 대해 인접 상점을 평균화하려고하기 때.입니다. 그래서 테이블에 가입하면 county ~ adj_next_state에 가입해야합니다.

이

stores_tsc %>% 
    # rename one column 
    select(store,end.week,county = adj_next_state) %>% 
    # left join table to itself 
    # removing unneeded columns and using unique simply prevents duplicate rows. 
    left_join(stores_tsc %>% 
       select(-adj_next_state,-store) %>% 
       unique, 
      by = c("county","end.week")) %>% 
    # filter out the store in an unknown county 
    filter(county != "cNA") %>% 
    # calculate dev 
    group_by(store,end.week) %>% 
    summarize(dev = mean(q,na.rm = TRUE)) %>% 
    ungroup %>% 
    mutate(dev = ifelse(is.nan(dev), yes = NA,no = dev)) 

    store end.week  dev 
1 61 20061118 14.50000 
2 145 20061125  NA 
3 228 20061118 14.50000 
4 228 20061125 12.25000 
5 331 20061125  NA 
6 500 20061118 14.50000 
7 500 20061125 12.25000 
8 1001 20061118 18.08333 
9 1001 20061125 35.87500 

당신은 또 다른 나는 그것이 가능해야한다고 생각 dev1 = q/dev