不同组的dplyr滞后

Question

我正在尝试使用dplyr对包含同一组变量滞后的列以及（其中之一）其他组的滞后进行变异。编辑：抱歉，在第一版中，我在最后一秒重新排列了日期顺序，弄乱了顺序。

这是我期望的结果:

这是一个简单的代码示例:

library(tidyverse)

set.seed(2)
df <-
  data.frame(
    x =  sample(seq(as.Date('2000/01/01'), as.Date('2015/01/01'), by="day"), 10),
    group = sample(c("A","B"),10,replace = T),
    value = sample(1:10,size=10)
  ) %>% arrange(x)

df <- df %>%
  group_by(group) %>%
  mutate(own_lag = lag(value))


df %>% data.frame(other_lag = c(NA,1,2,7,7,9,10,10,8,6))

非常感谢！

- Marcel Schliebs

---

有趣的问题，但我能够理解你的逻辑。第五行和第六行的other_lag是如何计算的？ - mt1022

我认为在某些逻辑中使用findInterval会很有用。 - Rana Usman

@mt1022 抱歉，在发布前按日期重新排列会导致数据有些混乱。我希望现在清楚了。 - Marcel Schliebs

“另一组的滞后”是指您希望在第1组中的第n个项目中获得不同组中的（n + lag）th项目吗？如果是这样，请为每个组添加一个递增列（如行号），并基于该列连接这些组。 - anotherfred

根据我的理解，“other_lag” 中的第二项应该是1而不是NA，这正确吗？ - talat

@docendo discimus，你当然是完全正确的。 - Marcel Schliebs

Answer 1

使用data.table的解决方案：

library(data.table)

# to create own lag: 
setDT(df)[, own_lag:=c(NA, head(value, -1)), by=group]

# to create other group lag: (the function works actually outside of data.table, in base R, see N.B. below)
df[, other_lag:=sapply(1:.N, 
                       function(ind) {
                          gp_cur <- group[ind]
                          if(any(group[1:ind]!=gp_cur)) tail(value[1:ind][group[1:ind]!=gp_cur], 1) else NA
                       })]

df
 #            x group value own_lag other_lag
 #1: 2001-12-08     B     1      NA        NA
 #2: 2002-07-09     A     2      NA         1
 #3: 2002-10-10     B     7       1         2
 #4: 2007-01-04     A     5       2         7
 #5: 2008-03-27     A     9       5         7
 #6: 2008-08-06     B    10       7         9
 #7: 2010-07-15     A     4       9        10
 #8: 2012-06-27     A     8       4        10
 #9: 2014-02-21     B     6      10         8
#10: 2014-02-24     A     3       8         6

其他滞后确定的解释：这个想法是，对于每个观察值，查看组值，如果有任何不同于当前和前一个组值的组值，则取最后一个值，否则放置NA。 注意：other_lag可以在不需要data.table的情况下创建。

df$other_lag <- with(df, sapply(1:nrow(df), 
                                function(ind) {
                                 gp_cur <- group[ind]
                                 if(any(group[1:ind]!=gp_cur)) tail(value[1:ind][group[1:ind]!=gp_cur], 1) else NA
                               }))

- Cath

Answer 2

另一种与 @Cath 相似的 data.table 方法：

library(data.table)
DT = data.table(df)
DT[, vlag := shift(value), by=group]
DT[, volag := .SD[.(chartr("AB", "BA", group), x - 1), on=.(group, x), roll=TRUE, x.value]]

这假定A和B是唯一的组。如果还有更多...

DT[, volag := DT[!.BY, on=.(group)][.(.SD$x - 1), on=.(x), roll=TRUE, x.value], by=group]

工作原理：

:= 创建一个新的列。

DT[, col := ..., by=] 每个 by= 组分别执行赋值操作，本质上是一个循环。

• 当前迭代循环的分组值在命名列表 .BY 中。
• 当前迭代循环使用的数据子集是数据表 .SD。

x[!i, on=] 是一种反连接，查找 i 在 x 中的行，并返回匹配的行去掉后的 x。

x[i, on=, roll=TRUE, x.v] ...

• 使用 on= 条件在 x 中查找每一行的 i
• 当没有精确的 on= 匹配时，它会“滚动”到最接近的上一个 on= 列的值
• 它从表 x 返回 v

有关更多详细信息和直觉，请查看键入 library(data.table) 时显示的启动消息。

- Frank

Answer 3

我不确定我是否正确理解了你的问题，但如果“own”和“other”指的是A组和B组，那么这可能会起作用。我强烈认为还有更优雅的方法来做到这一点：

df.x <-  df %>% 
  dplyr::group_by(group) %>% 
  mutate(value.lag=lag(value)) %>% 
  mutate(index=seq_along(group)) %>% 
  arrange(group)

df.a <- df.x %>%
  filter(group=="A") %>% 
  rename(value.lag.a=value.lag)

df.b <- df.x %>% 
  filter(group=="B") %>% 
  rename(value.lag.b = value.lag)

df.a.b <- left_join(df.a, df.b[,c("index", "value.lag.b")], by=c("index"))

df.b.a <- left_join(df.b, df.a[,c("index", "value.lag.a")], by=c("index"))

df.x <- bind_rows(df.a.b, df.b.a)

- zoowalk

Answer 4

尝试这个：（仅管道方法）

  library(zoo)
  df %>%
     mutate(groupLag = lag(group),
         dupLag = group == groupLag) %>%
     group_by(dupLag) %>%
     mutate(valueLagHelp = lag(value)) %>%
     ungroup() %>%
     mutate(helper = ifelse(dupLag == T, NA, valueLagHelp)) %>%
     mutate(helper = case_when(is.na(helper) ~ na.locf(helper, na.rm=F),
                                   TRUE ~ helper)) %>%
     mutate(valAfterLag = lag(dupLag)) %>%
     mutate(otherLag = ifelse(is.na(lag(valueLagHelp)), lag(value), helper)) %>%
     mutate(otherLag = ifelse((valAfterLag | is.na(valAfterLag)) & !dupLag, 
     lag(value), otherLag)) %>% 
     select(c(x, group, value, ownLag, otherLag))

抱歉造成混乱。它首先创建了一个组延迟，并为组等于其延迟的情况（即连续两个“A”时）创建了一个帮助变量。然后按照此帮助变量进行分组，并将dupLag == F的所有值分配正确的值。现在我们需要处理dupLag == T的值。

所以，取消分组。我们需要一个新的延迟值助手，将所有dupLag == T分配为NA，因为它们尚未正确分配。

接下来要做的是将助手中的所有NA分配给最后一个非NA值。这还不是全部，因为我们仍然需要处理一些dupLag == F数据点（当您查看完整的tibble时会得到该结果）。首先，我们基本上只需使用第一个mutate（otherLag==...操作更改第二个数据点。下一个操作完成所有操作，然后选择我们想要最终拥有的变量。

- Ben