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))))

使用apply替换嵌套for循环

1 个答案: