r - 如何使用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 ==不适用)。结束编辑。

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)

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