在我的示例中，我有一个包含3列的数据框：日期，信号和值。现在，我要对新列进行变异，该列取决于信号。
如果前一天（ifelse(lag(signal) == 1）发出信号，请在第二天的第一天给我，第二天在第一列和第二天给我（else = NA）。
但是在这种情况下，我有三个不同的信号（c(1,2,3)）。
我想要一个动态的解决方案。这意味着我可以确定接下来几天的数量（因为在我的实际情况下，我想使用接下来的第七天）以及信号的数量。
这是我的示例数据：
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)
}
答案 0 :(得分：3)
这是最简单的解决方案，虽然不是很优雅，但是可以起作用：
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列是数字（即双/浮点数），则您应该永远不要使用==或{{1 }以比较其值。要么使用%in%，要么-在您的情况下-将列转换为字符向量。
关于sprintf：在这里您可以使用all_equal()代替%s，然后信号将被解释为字符向量。在其他情况下，您可能会对%d或诸如%f之类的变体感兴趣。我建议学习sprintf函数的格式，不仅在R中使用它。
编辑2：当然，您可以使用lapply代替for。
%.2f或使用purrr中的map2：
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)
现在您可以将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是有原因的-实际上它更具可读性。
答案 1 :(得分：1)
使用基数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...