如何使用 dplyr 消除 for 循环？

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) 与相反州的县 4 和 5 相邻（adj1 == 4 和 adj2 == 5），我们忽略县 2 的地理邻接，因为 1 和 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

所以你实际上在这里有三种信息，这就是你需要如此复杂的for循环的原因。我尝试将您的数据标准化为三个表：

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)

要计算 dev，您需要将此表连接回自身。这是因为，对于每个商店 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