Использование apply для замены вложенного цикла for - PullRequest
Новая
       17

Использование apply для замены вложенного цикла for

0 голосов
/ 17 мая 2018

Моя цель состоит в том, чтобы пройти через различные сигналы и игнорировать любые 1, которые не являются частью серии (минимум как минимум 2 1 в ряду).Данные представляют собой временные ряды xts с 180K + столбцами и 84 месяцами.Я предоставил небольшой упрощенный набор данных, в котором я использовал гнездо для цикла, но это занимает слишком много времени, чтобы закончить весь набор данных.Это работает, но ужасно неэффективно.

Я знаю, что есть какой-то способ использовать функцию применения, но я не могу понять это.

Пример данных: 

    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 '.Я знаю, что есть лучший способ, поэтому я надеюсь улучшить свой подход.Любая идея будет принята с благодарностью.Спасибо!

Ответ от Зака ​​и Райана:

Зак и Райан были заняты с помощью 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")))

1 Ответ

0 голосов
/ 17 мая 2018

вот удар с точки зрения dplyr, я преобразовал ваши имена строк в столбец, но вы можете также легко преобразовать их обратно в имена строк с помощью tibble::column_to_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))))
...