如何使用dplyr消除for循环？

Question

有没有人知道dplyr方法对数据进行成对匹配,缺少观察后跟随后的算术？下面的for循环重码是一个基础的MWE,但我无法绕过dplyr方法(尽管有出色的装饰和文档).

简而言之,代码计算dev,这只是该周q相邻adj商店出售的所有非缺失数量观察的平均值.

编辑:我对政策不同的国家感兴趣.让下面的垂直线代表州边界:县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相邻,我们忽略县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