R根据不同的信号在时间序列中提取接下来的日子答案

【问题标题】：R Extracting following days in time series based on different signalsR根据不同的信号在时间序列中提取接下来的日子
【发布时间】：2019-12-01 07:07:14
【问题描述】：

在我的示例中，我有一个包含 3 列的数据框：日期、信号和值。现在我想改变以信号为条件的新列。

如果前一天有信号 (ifelse(lag(signal) == 1)，那么在第二天的第一天给我，然后在下一栏中给我第二天的第一天和第二天 (else = NA)。
但在这种情况下，我有三个不同的信号 (c(1,2,3))。

我想要一个动态的解决方案。这意味着我可以计算接下来的天数（因为在我的实际情况下，我想使用接下来的 7 天）以及信号数。

这是我的示例数据：

library(tidyverse)
library(lubridate)

set.seed(123)

df <- tibble(date   = today()+0:10,
             signal = c(0,1,0,0,2,0,0,3,0,0,0),
             value  = sample.int(n=11))
# A tibble: 11 x 3
   date       signal value
   <date>      <dbl> <int>
 1 2019-07-23      0     3
 2 2019-07-24      1    11
 3 2019-07-25      0     2
 4 2019-07-26      0     6
 5 2019-07-27      2    10
 6 2019-07-28      0     5
 7 2019-07-29      0     4
 8 2019-07-30      3     9
 9 2019-07-31      0     8
10 2019-08-01      0     1
11 2019-08-02      0     7

这是我想要的输出：

# A tibble: 11 x 3
   date       signal value   new_col_day1_sig_1  new_col_day2_sig_1  new_col_day1_sig_2  new_col_day2_sig_2  new_col_day1_sig_3  new_col_day2_sig_3
   <date>      <dbl> <int>
 1 2019-07-23      0     3                 NA                   NA                   NA                  NA                 NA                NA
 2 2019-07-24      1    11                 NA                   NA                   NA                  NA                 NA                NA
 3 2019-07-25      0     2                  2                    2                   NA                  NA                 NA                NA
 4 2019-07-26      0     6                 NA                    6                   NA                  NA                 NA                NA
 5 2019-07-27      2    10                 NA                   NA                   NA                  NA                 NA                NA
 6 2019-07-28      0     5                 NA                   NA                    5                   5                 NA                NA
 7 2019-07-29      0     4                 NA                   NA                   NA                   4                 NA                NA
 8 2019-07-30      3     9                 NA                   NA                   NA                  NA                 NA                NA
 9 2019-07-31      0     8                 NA                   NA                   NA                  NA                  8                 8
10 2019-08-01      0     1                 NA                   NA                   NA                  NA                 NA                 1
11 2019-08-02      0     7                 NA                   NA                   NA                  NA                 NA                NA

我已经问过同样的问题，但没有不同的信号：
R Extracting following days after signal in time series

这是一个只针对一个信号的解决方案：

anylag <- function(x, n) {
  l <- lapply(1:n, function(i) lag(x, i) == 1)
  Reduce("|", l)
}

df %>% mutate(calculation=ifelse(anylag(signal, 3), value, NA))

但现在我想实现信号。解决方案应该类似于：

signals<-c(1,2,3)

anylag <- function(x, n, signals) {
  l <- lapply(1:n, function(i) lag(x, i) == 1 * signals)
  Reduce("|", l)
}

【问题讨论】：

标签： r dplyr time-series

【解决方案1】：

这是最简单的解决方案，虽然不优雅，但很有效：

anylag <- function(x, n, s) {
  l <- lapply(1:n, function(i) lag(x, i) == s)
  Reduce("|", l)
}

for(s in signals) {
  for(lag in 1:2) {
    varname <- sprintf("new_col_day_%d_sig_%d", lag, s)
    df <- mutate(df, !!varname := ifelse(anylag(signal, lag, s), value, NA))
  }
}

在某些情况下 for 循环更简单，至少在概念上是这样；-)

编辑：

类似于“1.5”的信号。这里有两个问题。

第一个问题是，如果您的 signals 列是数字（即双精度/浮点），那么您应该永远不要使用 == 或 %in% 来比较其值.要么使用all_equal()，要么 - 在你的情况下 - 将列转换为字符向量。

关于sprintf：这里你可以使用%s而不是%d，那么信号将被解释为一个字符向量。在其他情况下，您可能对%f 或%.2f 等变体感兴趣。我建议学习 sprintf 函数的格式，它不仅在 R 中使用。

编辑 2：当然，您可以使用 lapply 代替 for。

res <- lapply(signals, function(s) 
          sapply(1:2, function(lag)
             ifelse(anylag(df$signal, lag, s), df$value, NA)
        ))
res <- do.call(cbind, res)
colnames(res) <- expand.grid(1:2, signals) %>% 
  mutate(cn=sprintf("new_col_day_%d_sig_%d", Var1, Var2)) %>% 
  pull(cn)

或者使用 purrr 中的 map2：

cc <- expand.grid(1:2, signals) 
res <- map2_dfc(cc$Var1, cc$Var2, 
   ~ ifelse(anylag(df$signal, .x, .y), df$value, NA)) %>%
    setNames(sprintf("new_col_day_%d_sig_%d", cc$Var1, cc$Var2))

现在您可以使用您的数据框cbind 结果res。

在这种情况下我选择for 是有原因的——它实际上更具可读性。

【讨论】：

【解决方案2】：

使用基数 R，我们可以编写一个函数，它接受 lookback 的天数和多个 signal 值来检查。然后我们编写一个嵌套循环，它为我们提供布尔列

anylag <- function(x, lookback, signal) {
   do.call(cbind, lapply(signals, function(z)
         sapply(seq_len(lookback), function(y) 
           sapply(seq_along(x), function(i) any(x[max(1, i - y) : (i - 1)] == z)))))
}

number_of_days <- 2
signals<-c(1,2,3)

并将signal 值传递给它

cols <- c(outer(1:number_of_days, signals, function(x, y) 
              paste0("new_col_day", x, "_sig", y)))

df[cols] <-  anylag(df$signal, number_of_days, signals)

编写另一个函数来改变值

change_values <- function(x, value) {
     ifelse(x, value, NA)
}

df[cols] <- lapply(df[cols], function(x) change_values(x, df$value))


#   date       signal value new_col_day1_si… new_col_day2_si… new_col_day1_si…
#   <date>      <dbl> <int>            <int>            <int>            <int>
# 1 2019-07-23      0     4               NA               NA               NA...
# 2 2019-07-24      1     8               NA               NA               NA...
# 3 2019-07-25      0    11               11               11               NA...
# 4 2019-07-26      0    10               NA               10               NA...
# 5 2019-07-27      2     7               NA               NA               NA...
# 6 2019-07-28      0     1               NA               NA                1
# 7 2019-07-29      0     3               NA               NA               NA...
# 8 2019-07-30      3     9               NA               NA               NA...
# 9 2019-07-31      0     2               NA               NA               NA...
#10 2019-08-01      0     6               NA               NA               NA...
#11 2019-08-02      0     5               NA               NA               NA...

【讨论】：