如何使用dplyr消除循環？

Question

有沒有人知道dplyr方法對數據進行配對匹配，然後再進行算術運算？下面的for-loop重碼是基礎的MWE，但是我無法用dplyr的方法來解決問題（儘管出色的插圖和文檔）。

簡言之，代碼計算dev，這僅僅是在所有相鄰adj存儲有一週出售的非缺失量觀測q的平均值。

編輯：我感興趣的國家有不同的政策。讓下面的垂直線代表狀態邊界：縣1,2和3處於狀態A（帶有政策A），而縣4,5和6處於狀態B（帶有政策B）。縣可能有多個商店。

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

contig.id標識縣即鄰接在相反狀態的一個或多個縣。例如，縣1（contig.id == 1）與處於相反狀態（adj1 == 4和adj2 == 5）的縣4和5相鄰，因爲1和2處於相同狀態，所以我們無視縣2的地理鄰接關係。

通過同樣的方法，縣4（contig.id == 4）僅與縣1相鄰（adj1 == 1和adj2 == NA）。 結束編輯。

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

所以你實際上有三種信息在這裏，這就是爲什麼你需要如此複雜的循環。我試着將數據正常化到三個表：

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）。我還將數據從廣泛的數據轉換爲長期數據 - 如果您有與其他> 2個其他縣相鄰的縣，這可能會派上用場。

我們可以參加所有的這些結合在一起，獲得每個門店的業績數據集在兩個「時間」和「空間」：

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

要計算開發，你需要加入這個表回到其自身。這是因爲，對於每個商店x時間組合，您希望平均所有相鄰的商店。所以當你加入表格時，你需要加入county至adj_next_state。我們可以使用一些魔法select使它容易：

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 

你可以使用其他與stores_time合併計算dev1 = q/dev