Обнаружение изменений из предыдущих строк с пропущенными значениями - ускорение на l oop - R - PullRequest
Новая
       9

Обнаружение изменений из предыдущих строк с пропущенными значениями - ускорение на l oop - R

1 голос
/ 15 января 2020

У меня есть набор данных со значениями, включая пропущенные значения. Цель состоит в том, чтобы создать вектор change, который указывает на изменение по сравнению с последним предыдущим действительным значением.

Вот некоторые данные: 

test <- data.frame(resp = c(9, NA, NA, 11, NA, NA, 6, 16, NA, 12, 0, 0, 0, 0, 0, NA, 0, 11, NA, NA, NA, NA, NA, NA, 14, NA, 23, NA, NA, 16, 16))

Идея заключается в следующем:

  • без изменений приводит к значению 0
  • значение> последнее предыдущее действительное значение добавляет 1 для каждого увеличения (например, 1, 2, 3)
  • значение <последнее предыдущее действительное значение приводит к <code>-1 и -1, если предыдущее значение уже было отрицательным.

Таким образом, результат выглядел бы так для данных выше: 

    resp change
1      9      0
2     NA     NA
3     NA     NA
4     11      1
5     NA     NA
6     NA     NA
7      6     -1
8     16      1
9     NA     NA
10    12     -1
11     0     -2
12     0      0
13     0      0
14     0      0
15     0      0
16    NA     NA
17     0      0
18    11      1
19    NA     NA
20    NA     NA
21    NA     NA
22    NA     NA
23    NA     NA
24    NA     NA
25    14      2

Я попытался для l oop, и это работает как-то, но я чувствую, что это грязный код плюс это очень медленно Любая идея для лучшего решения этой задачи (например, purrr)? 

    for (i in 2:nrow(test)) {
  test$change[i] <- 0
  test$change[i] <- case_when(
    test$resp[i] > last(test$resp[which(!is.na(test$resp[1:i-1]))]) & last(test$change[which(!is.na(test$resp[2:i-1]))]) >= 0  ~ test$change[i] + last(test$change[which(!is.na(test$resp[1:i-1]))]) + 1,
    test$resp[i] > last(test$resp[which(!is.na(test$resp[1:i-1]))]) & last(test$change[which(!is.na(test$resp[2:i-1]))]) <= 0  ~ test$change[i] + 1,
    test$resp[i] < last(test$resp[which(!is.na(test$resp[1:i-1]))]) & last(test$change[which(!is.na(test$resp[2:i-1]))]) <= 0  ~ test$change[i] + last(test$change[which(!is.na(test$resp[1:i-1]))]) - 1,
    test$resp[i] < last(test$resp[which(!is.na(test$resp[1:i-1]))]) & last(test$change[which(!is.na(test$resp[2:i-1]))]) >= 0  ~ test$change[i]- 1,
    TRUE ~ test$change[i])
  test$change[i] <- if_else(is.na(test$resp[i]), NA_real_, test$change[i])
}

В конце концов, это должно быть применено к набору данных с> 30 переменными и> 100000 строк.

Ответы [ 2 ]

0 голосов
/ 15 января 2020

Вот альтернативный подход, который удаляет все строки с NA, выполняет некоторые вычисления и объединяет строки NA в нужном месте. 

library(tidyverse)
library(zoo)

# example data
test <- data.frame(resp = c(9, NA, NA, 11, NA, NA, 6, 16, NA, 12, 0, 0, 0, 0, 0, NA, 0, 11, NA, NA, NA, NA, NA, NA, 14))

# add an id for each row
test = test %>% mutate(id = row_number())

test %>%
  na.omit() %>%                                                               # exclude rows with NAs
  mutate(flag = case_when(resp == lag(resp, default = first(resp)) ~ 0,
                          resp > lag(resp, default = first(resp)) ~ 1,
                          resp < lag(resp, default = first(resp)) ~ -1)) %>%  # check relationship between current and previous value
  mutate(g = cumsum(flag != lag(flag, default = first(flag)))) %>%            # create a grouping based on change in flag column
  group_by(g) %>%                                                             # for each group
  mutate(change = ifelse(flag != 0, flag * row_number(), flag)) %>%           # calculate the change column
  ungroup() %>%                                                               # forget the grouping
  select(id, change) %>%                                                      # keep useful columns
  right_join(test, by="id") %>%                                               # join back to get NA rows in the right place
  select(resp, change)                                                        # keep useful columns

В результате вы получите: 

#    resp change
# 1     9      0
# 2    NA     NA
# 3    NA     NA
# 4    11      1
# 5    NA     NA
# 6    NA     NA
# 7     6     -1
# 8    16      1
# 9    NA     NA
# 10   12     -1
# 11    0     -2
# 12    0      0
# 13    0      0
# 14    0      0
# 15    0      0
# 16   NA     NA
# 17    0      0
# 18   11      1
# 19   NA     NA
# 20   NA     NA
# 21   NA     NA
# 22   NA     NA
# 23   NA     NA
# 24   NA     NA
# 25   14      2
0 голосов
/ 15 января 2020

Это дублирует ваш результат, за исключением того, что он использует 0 для неизменности всегда (как в вашем описании), а не NA. В основном он использует fill и lag для создания столбцов, содержащих значения, которые вы создаете с помощью last и which, затем использует case_when для заполнения столбца change.

Если вы хотите NA вместо 0 в столбце change, замените ~ 0 в первом предложении case_when на ~ NA_real_. Если вы действительно хотите сочетание 0 и NA, как в вашем примере, пожалуйста, объясните, когда использовать каждый из них. 

library(tidyverse)
test <- data.frame(resp = c(9, NA, NA, 11, NA, NA, 6, 16, NA, 12, 0, 0, 0, 0, 0, NA, 0, 11, NA, NA, NA, NA, NA, NA, 14, NA, 23, NA, NA, 16, 16))

test %>% mutate(filled=resp) %>% 
  fill(filled) %>% 
  mutate(change_sign=sign(filled-lag(filled, default=filled[1])),
         lag_filled_change = lag(if_else(change_sign==0, NA_real_, change_sign), default=0)) %>% 
  fill(lag_filled_change) %>% 
  mutate(change = case_when(
    change_sign==0 ~ 0,
    change_sign==1 & lag_filled_change<=0 ~ 1,
    change_sign==1 & lag_filled_change >0 ~ lag_filled_change+1,
    change_sign==-1& lag_filled_change>=0 ~ -1,
    change_sign==-1& lag_filled_change <0 ~ lag_filled_change-1
  )) %>% 
  select(resp, change)
#>    resp change
#> 1     9      0
#> 2    NA      0
#> 3    NA      0
#> 4    11      1
#> 5    NA      0
#> 6    NA      0
#> 7     6     -1
#> 8    16      1
#> 9    NA      0
#> 10   12     -1
#> 11    0     -2
#> 12    0      0
#> 13    0      0
#> 14    0      0
#> 15    0      0
#> 16   NA      0
#> 17    0      0
#> 18   11      1
#> 19   NA      0
#> 20   NA      0
#> 21   NA      0
#> 22   NA      0
#> 23   NA      0
#> 24   NA      0
#> 25   14      2
#> 26   NA      0
#> 27   23      2
#> 28   NA      0
#> 29   NA      0
#> 30   16     -1
#> 31   16      0

Создано в 2020-01-15 с помощью Представить пакет (v0.3.0)

...