在我的示例中，我有一个包含 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 在时间序列中的信号后几天提取
以下是仅针对一个信号的解决方案：
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)
}
这是最简单的解决方案，不优雅，但它有效：
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)
或者使用来自咕噜声的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是有原因的——它实际上更具可读性。
使用基本 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...