使用 apply 替换嵌套的 for 循环

Question

我的目标是通过各种信号并忽略不属于系列的任何 1（至少连续两个 1）。数据是一个 xts 时间序列，包含 180K+ 列和 84 个月。我提供了一个小型简化数据集，我使用了一个嵌套 for 循环，但是完成整个数据集的时间太长了。它有效，但效率极低。

我知道有一些方法可以使用 apply 函数，但我想不通。

示例数据：

    mod_sig <- data.frame(a = c(0,1,0,0,0,1,1,0,0,0,1,0,1,1), 
                          b = c(0,0,1,0,0,1,0,0,0,1,1,1,1,1), 
                          c = c(0,1,0,1,0,1,1,1,0,0,0,1,1,0), 
                          d = c(0,1,1,1,0,1,1,0,0,1,1,1,1,1),
                          e = c(0,0,0,0,0,0,0,0,0,0,1,0,0,0))

    mod_sig <- xts(mod_sig, order.by = as.Date(seq(as.Date("2016-01-01"), as.Date("2017-02-01"), by = "month")))

示例代码：

   # fixing months where condition is only met for one month
   # creating a new data frame for modified signals
   Signals_Fin <- data.frame(matrix(nrow = nrow(mod_sig), ncol = ncol(mod_sig)))
   colnames(Signals_Fin) <- colnames(mod_sig)

   # Loop over Signals to change 1's to 0's for one month events
   for(col in 1:ncol(mod_sig)) {
     for(row in 1:nrow(mod_sig)) {
       val <- ifelse(mod_sig[row,col] == 1, 
                     ifelse(mod_sig[row-1,col] == 0, 
                            ifelse(mod_sig[row+1,col] == 0,0,1),1),0)
       Signals_Fin[row, col] <- val
     }
   }

正如您在循环中看到的那样，任何不在序列中的 1 都将更改为 0。我知道有更好的方法，所以我希望改进我的方法。任何见解将不胜感激。谢谢！

Zack 和 Ryan 的回答：

Zack 和 Ryan 对 dyplr 很满意，我只是根据给出的内容和一些同事的帮助进行了轻微的修改。

答案代码：

    mod_sig <- data.frame(a = c(0,1,0,0,0,1,1,0,0,0,1,0,1,1), 
                      b = c(0,0,1,0,0,1,0,0,0,1,1,1,1,1), 
                      c = c(0,1,0,1,0,1,1,1,0,0,0,1,1,0), 
                      d = c(0,1,1,1,0,1,1,0,0,1,1,1,1,1),
                      e = c(0,0,0,0,0,0,0,0,0,0,1,0,0,0))

    Signals_fin = mod_sig %>% 
                  mutate_all(funs(ifelse((. == 1 & (lag(.) == 1 | lead(.) == 1)),1,0))) %>% 
                  mutate_all(funs(ifelse(is.na(.), 0, .)))


    Signals_fin <- xts(Signals_fin, order.by = as.Date(seq(as.Date("2016-01-01"), as.Date("2017-02-01"), by = "month")))

Answer 1

从dplyr 的角度来看，我将您的row_names 转换为列，但您可以使用tibble::column_to_rownames() 轻松地将它们转换回rownames：

library(dplyr)
library(tibble)

mod_sig %>%
  as.data.frame() %>%
  rownames_to_column('months') %>%
  mutate_at(vars(-months), function(x){
    if_else(x == 1 & 
              (lag(x, order_by = .$months) == 1 | 
                 lead(x, order_by = .$months) == 1),
            1,
            0)
  })

正如@Ryan 所建议的，他的mutate_at 调用更加优雅，但重要的是所有内容都已经排序：

mod_sig %>%
  as.data.frame() %>%
  rownames_to_column('months') %>%
  mutate_at(vars(-months),  ~ as.numeric(.x & (lag(.x) | lead(.x))))

并以他的建议为基础：

mod_sig %>%
  as.data.frame() %>%
  mutate_all(~ as.numeric(.x & (lag(.x) | lead(.x))))