R根据两个不同的参数创建多个列答案

【问题标题】：R Create multiple columns based on two different parametersR根据两个不同的参数创建多个列
【发布时间】：2019-05-21 14:12:17
【问题描述】：

我有一个数据框，它有 2 列：日期和返回。现在我想改变多个新列，这取决于两个参数：阈值参数和滞后参数。功能很简单。新列计算如下：

var= ifelse(lag(return, n= lag_day)>threshold,return, NA))

如果lag(return) 高于阈值，则给我return-值，否则给我NA。

以下是阈值和 lag_days 的值：

threshold=c(2,4,6)
lag_day=c(1,2,3)

我在这里手动解决我的问题：

test<-df%>%
  mutate(var_t1_lag1= ifelse(lag(return, n= lag_day[1] )>threshold[1],return, NA))%>%
  mutate(var_t2_lag1= ifelse(lag(return, n= lag_day[1] )>threshold[2],return, NA))%>%
  mutate(var_t3_lag1= ifelse(lag(return, n= lag_day[1] )>threshold[3],return, NA))%>%
  mutate(var_t1_lag2= ifelse(lag(return, n= lag_day[2] )>threshold[1],return, NA))%>%
  mutate(var_t2_lag2= ifelse(lag(return, n= lag_day[2] )>threshold[2],return, NA))%>%
  mutate(var_t3_lag2= ifelse(lag(return, n= lag_day[2] )>threshold[3],return, NA))%>%
  mutate(var_t1_lag3= ifelse(lag(return, n= lag_day[3] )>threshold[1],return, NA))%>%
  mutate(var_t2_lag3= ifelse(lag(return, n= lag_day[3] )>threshold[2],return, NA))%>%
  mutate(var_t3_lag3= ifelse(lag(return, n= lag_day[3] )>threshold[3],return, NA))

但是有没有一种解决方案可以让它变得更容易？也许有一两个应用函数？

这是我的示例数据框：

df <- tibble(
  date= today()+0:12,
  return=c(1,2.5,2,3,5,6.5,1,9,3,2,4,7,2)
)

【问题讨论】：

标签： r

【解决方案1】：

一种选择是获取“阈值”、“滞后日”和crossing 的所有组合，然后遍历行 (pmap)、transmute 以创建感兴趣的列并与原始列绑定数据集。这使用了base R (seq_along) 中的一个函数

library(tidyverse)
crossing(threshold = seq_along(threshold), lag_day) %>%
    pmap_dfc(~  
             df %>%
               transmute(!! str_c("var_t", ..1, "_lag", ..2) := 
                  case_when(lag(return, n = ..2) > threshold[..1] ~ return, 
                            TRUE ~ NA_real_))) %>% 
   bind_cols(df, .)

【讨论】：

函数第5行最好省略threshold[ ]。否则可能会导致错误。现在我正在使用更改后的函数：case_when(lag(return, n = ..2) > ..1 ~ return, （仅更改了第 5 行）
@TobKel Initialy，我使用crossing(threshold, lag_day) 和..1，但是我需要根据顺序更改列名，这就是我使用seq_along 和@987654332 的原因@。有趣的是，它并没有给我一个错误

【解决方案2】：

使用 dplyr::lag 的两个应用循环的基本 R 方法

df[paste0("var_t", outer(seq_along(lag_day), seq_along(threshold),
   FUN = paste, sep = "_"))] <-  do.call(cbind, 
     lapply(lag_day, function(x) sapply(threshold, function(y) 
            ifelse(dplyr::lag(df$return, n = x) > y, df$return, NA))))


#   date       return var_t1_1 var_t2_1 var_t3_1 var_t1_2 var_t2_2 var_t3_2 var_t1_3 var_t2_3 var_t3_3
#   <date>      <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>
# 1 2019-05-21    1       NA       NA         NA     NA         NA       NA       NA       NA       NA
# 2 2019-05-22    2.5     NA       NA         NA     NA         NA       NA       NA       NA       NA
# 3 2019-05-23    2        2       NA         NA     NA         NA       NA       NA       NA       NA
# 4 2019-05-24    3       NA       NA         NA      3         NA       NA       NA       NA       NA
# 5 2019-05-25    5        5       NA         NA     NA         NA       NA        5       NA       NA
# 6 2019-05-26    6.5      6.5      6.5       NA      6.5       NA       NA       NA       NA       NA
# 7 2019-05-27    1        1        1          1      1          1       NA        1       NA       NA
# 8 2019-05-28    9       NA       NA         NA      9          9        9        9        9       NA
# 9 2019-05-29    3        3        3          3     NA         NA       NA        3        3        3
#10 2019-05-30    2        2       NA         NA      2          2        2       NA       NA       NA
#11 2019-05-31    4       NA       NA         NA      4         NA       NA        4        4        4
#12 2019-06-01    7        7       NA         NA     NA         NA       NA        7       NA       NA
#13 2019-06-02    2        2        2          2      2         NA       NA       NA       NA       NA

【讨论】：