R: Как сгенерировать столбец со значениями строки на основе значений ближайшей строки N - PullRequest
Новая
       31

R: Как сгенерировать столбец со значениями строки на основе значений ближайшей строки N

4 голосов
/ 26 марта 2019

Я ищу способ кодирования информации на основе столбцов в предыдущих N строках для данной строки. Набор данных отсортирован.

Короче говоря, я хочу создать столбец с именем oneweeksince, который возвращает TRUE, если столбец victims больше 0 (или! NA) для семи строк после.

Поставьте другой путь, если для row[i], row[i]$victims > 0 в любом ряду от row[i - 7] до row[i], тогда row[i]$oneweeksince должно быть TRUE. Значение oneweeksince также должно быть TRUE в строках, в которых victims > 0 или !is.na(victims)

Как я могу автоматизировать создание этой колонки / функции? Также можно использовать столбец даты для вычисления расстояния до даты. Я пытаюсь избежать создания цикла из-за медленного перфорирования в R.

Набор данных должен выглядеть следующим образом: 

      date           oneweeksince victims
1    2009-01-01         FALSE      NA
2    2009-01-02         FALSE      NA
3    2009-01-03         FALSE      NA
4    2009-01-04         FALSE      NA
5    2009-01-05         FALSE      NA
6    2009-01-06         FALSE      NA
7    2009-01-07         FALSE      NA
8    2009-01-08          TRUE       1
9    2009-01-09          TRUE      NA
10   2009-01-10          TRUE      NA
11   2009-01-11          TRUE      NA
12   2009-01-12          TRUE      NA
13   2009-01-13          TRUE      NA
14   2009-01-14          TRUE      NA
15   2009-01-15          TRUE      NA
16   2009-01-16         FALSE      NA
17   2009-01-17         FALSE      NA
18   2009-01-18         FALSE      NA
19   2009-01-19         FALSE      NA
20   2009-01-20         FALSE      NA

Набор данных длится много лет, поэтому мне нужен эффективный способ сделать это.

Ответы [ 4 ]

4 голосов
/ 26 марта 2019

Решение от @ G.Grothendieck

После некоторых обсуждений это самый эффективный и действенный ответ. 

library(dplyr)
library(zoo)

dat2 <- dat %>%
  mutate(roll = rollapplyr(victims > 0, 8, any, na.rm = TRUE, fill = NA, partial = TRUE)) %>%
  mutate(oneweeksince = roll > 0) %>%
  select(-roll)

Решение из моей предыдущей попытки

Решение с использованием rollapplyr из пакета zoo. rollapplyr может применить функцию со скользящим окном. В этом случае мы можем указать скользящее окно равным 8 и применить функцию mean. Обратите внимание, что функция rollmean не подходит в этом случае, потому что мы не можем указать na.rm = TRUE в функции rollmean. Последний шаг - просто оценить, больше ли столбец roll, чем 1. 

library(dplyr)
library(zoo)

dat2 <- dat %>%
  mutate(roll = rollapplyr(victims, width = 8, FUN = function(x) mean(x, na.rm = TRUE), fill = NA)) %>%
  mutate(oneweeksince = roll > 0) %>%
  select(-roll)
# dat2
#          date victims oneweeksince
# 1  2009-01-01      NA           NA
# 2  2009-01-02      NA           NA
# 3  2009-01-03      NA           NA
# 4  2009-01-04      NA           NA
# 5  2009-01-05      NA           NA
# 6  2009-01-06      NA           NA
# 7  2009-01-07      NA           NA
# 8  2009-01-08       1         TRUE
# 9  2009-01-09      NA         TRUE
# 10 2009-01-10      NA         TRUE
# 11 2009-01-11      NA         TRUE
# 12 2009-01-12      NA         TRUE
# 13 2009-01-13      NA         TRUE
# 14 2009-01-14      NA         TRUE
# 15 2009-01-15      NA         TRUE
# 16 2009-01-16      NA           NA
# 17 2009-01-17      NA           NA
# 18 2009-01-18      NA           NA
# 19 2009-01-19      NA           NA

DATA 

dat <- read.table(text = "      date           oneweeksince victims
1    '2009-01-01'         FALSE      NA
                  2    '2009-01-02'         FALSE      NA
                  3    '2009-01-03'         FALSE      NA
                  4    '2009-01-04'         FALSE      NA
                  5    '2009-01-05'         FALSE      NA
                  6    '2009-01-06'         FALSE      NA
                  7    '2009-01-07'         FALSE      NA
                  8    '2009-01-08'          TRUE       1
                  9    '2009-01-09'          TRUE      NA
                  10   '2009-01-10'          TRUE      NA
                  11   '2009-01-11'          TRUE      NA
                  12   '2009-01-12'          TRUE      NA
                  13   '2009-01-13'          TRUE      NA
                  14   '2009-01-14'          TRUE      NA
                  15   '2009-01-15'          TRUE      NA
                  16   '2009-01-16'         FALSE      NA
                  17   '2009-01-17'         FALSE      NA
                  18   '2009-01-18'         FALSE      NA
                  19   '2009-01-19'         FALSE      NA
                  20   '2009-01-20'         FALSE      NA",
                  header = TRUE, stringsAsFactors = FALSE)

dat$oneweeksince <- NULL

Моя вторая попытка

ОП указал, что мое решение не будет работать, если в первых N строках есть записи, где N - ширина окна. Здесь я предоставил решение для решения этой проблемы. Я собираюсь использовать тот же пример фрейма данных, за исключением того, что я изменяю вторую строку victims на 1. Новому решению нужны функции из purrr и tidyr, поэтому для этого я загружаю пакет tidyverse. 

library(tidyverse)
library(zoo)

dat2 <- dat %>%
  mutate(roll = rollapplyr(victims, width = 8, FUN = function(x) mean(x, na.rm = TRUE), fill = NA)) %>%
  # Split the data frame for the first width - 1 rows and others
  mutate(GroupID = ifelse(row_number() <= 7, 1L, 2L)) %>%
  split(.$GroupID) %>%
  # Check if the GroupID is 1. If yes, change the roll column to be the same as victims
  # After that, use fill to fill in NA
  map_if(function(x) unique(x$GroupID) == 1L, 
         ~.x %>% mutate(roll = victims) %>% fill(roll)) %>%
  # Combine data frames
  bind_rows() %>%
  mutate(oneweeksince = roll > 0) %>%
  select(-roll)
# dat2
# date victims GroupID oneweeksince
# 1  2009-01-01      NA       1           NA
# 2  2009-01-02       1       1         TRUE
# 3  2009-01-03      NA       1         TRUE
# 4  2009-01-04      NA       1         TRUE
# 5  2009-01-05      NA       1         TRUE
# 6  2009-01-06      NA       1         TRUE
# 7  2009-01-07      NA       1         TRUE
# 8  2009-01-08       1       2         TRUE
# 9  2009-01-09      NA       2         TRUE
# 10 2009-01-10      NA       2         TRUE
# 11 2009-01-11      NA       2         TRUE
# 12 2009-01-12      NA       2         TRUE
# 13 2009-01-13      NA       2         TRUE
# 14 2009-01-14      NA       2         TRUE
# 15 2009-01-15      NA       2         TRUE
# 16 2009-01-16      NA       2           NA
# 17 2009-01-17      NA       2           NA
# 18 2009-01-18      NA       2           NA
# 19 2009-01-19      NA       2           NA
# 20 2009-01-20      NA       2           NA

DATA 

dat <- read.table(text = "      date           oneweeksince victims
1    '2009-01-01'         FALSE      NA
                  2    '2009-01-02'         FALSE       1
                  3    '2009-01-03'         FALSE      NA
                  4    '2009-01-04'         FALSE      NA
                  5    '2009-01-05'         FALSE      NA
                  6    '2009-01-06'         FALSE      NA
                  7    '2009-01-07'         FALSE      NA
                  8    '2009-01-08'          TRUE       1
                  9    '2009-01-09'          TRUE      NA
                  10   '2009-01-10'          TRUE      NA
                  11   '2009-01-11'          TRUE      NA
                  12   '2009-01-12'          TRUE      NA
                  13   '2009-01-13'          TRUE      NA
                  14   '2009-01-14'          TRUE      NA
                  15   '2009-01-15'          TRUE      NA
                  16   '2009-01-16'         FALSE      NA
                  17   '2009-01-17'         FALSE      NA
                  18   '2009-01-18'         FALSE      NA
                  19   '2009-01-19'         FALSE      NA
                  20   '2009-01-20'         FALSE      NA",
                  header = TRUE, stringsAsFactors = FALSE)

dat$oneweeksince <- NULL
1 голос
/ 26 марта 2019

Я предпочитаю ответ Грегора, но здесь есть две альтернативы.

База R 

x$y <- Sys.Date()[NA] # just a class-stable way
x$y[ !is.na(x$victims) ] <- x$date[ !is.na(x$victims) ]
x$since <- difftime(x$date, zoo::na.locf(x$y, na.rm = FALSE), units="days")
x$oneweeksince <- !is.na(x$since) & (0 <= x$since & x$since <= 7)

dplyr

library(dplyr)
x %>%
  mutate(
    y = zoo::na.locf(if_else(is.na(victims), date[NA], date), na.rm = FALSE),
    since = difftime(date, zoo::na.locf(if_else(is.na(victims), date[NA], date), na.rm = FALSE),
                     units = "days"),
    anotherweeksince = !is.na(since) & between(since, 0, 7)
  )

Данные: 

x <- read.table(stringsAsFactors=FALSE, header=TRUE, text="
      date           oneweeksince victims
1    2009-01-01         FALSE      NA
2    2009-01-02         FALSE      NA
3    2009-01-03         FALSE      NA
4    2009-01-04         FALSE      NA
5    2009-01-05         FALSE      NA
6    2009-01-06         FALSE      NA
7    2009-01-07         FALSE      NA
8    2009-01-08          TRUE       1
9    2009-01-09          TRUE      NA
10   2009-01-10          TRUE      NA
11   2009-01-11          TRUE      NA
12   2009-01-12          TRUE      NA
13   2009-01-13          TRUE      NA
14   2009-01-14          TRUE      NA
15   2009-01-15          TRUE      NA
16   2009-01-16         FALSE      NA
17   2009-01-17         FALSE      NA
18   2009-01-18         FALSE      NA
19   2009-01-19         FALSE      NA
20   2009-01-20         FALSE      NA")
x$date <- as.Date(x$date)
1 голос
/ 26 марта 2019

Не уверен насчет эффективности, но одним из способов сделать это в базе R с использованием sapply будет то, что для каждой строки мы возвращаемся назад на 7 строк и проверяем, удовлетворяет ли она какому-либо из условий и возвращают логический вывод соответственно. 

sapply(seq_len(nrow(df)), function(x) {
    temp = df$victims[x : pmax(1, x - 7)]
    any(temp > 0) & any(!is.na(temp))
})

#[1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE 
#    TRUE  TRUE  TRUE FALSE FALSE FALSE FALSE FALSE
1 голос
/ 26 марта 2019

Мы можем сделать скользящую сумму и проверить, что она больше 0: 

library(RcppRoll)
your_data$result = roll_sum(
  x = your_data$victims,
  n = 8, 
  na.rm = TRUE,
  fill = 0,
  align = "right"
) > 0
your_data
#          date oneweeksince victims result
# 1  2009-01-01        FALSE      NA  FALSE
# 2  2009-01-02        FALSE      NA  FALSE
# 3  2009-01-03        FALSE      NA  FALSE
# 4  2009-01-04        FALSE      NA  FALSE
# 5  2009-01-05        FALSE      NA  FALSE
# 6  2009-01-06        FALSE      NA  FALSE
# 7  2009-01-07        FALSE      NA  FALSE
# 8  2009-01-08         TRUE       1   TRUE
# 9  2009-01-09         TRUE      NA   TRUE
# 10 2009-01-10         TRUE      NA   TRUE
# 11 2009-01-11         TRUE      NA   TRUE
# 12 2009-01-12         TRUE      NA   TRUE
# 13 2009-01-13         TRUE      NA   TRUE
# 14 2009-01-14         TRUE      NA   TRUE
# 15 2009-01-15         TRUE      NA   TRUE
# 16 2009-01-16        FALSE      NA  FALSE
# 17 2009-01-17        FALSE      NA  FALSE
# 18 2009-01-18        FALSE      NA  FALSE
# 19 2009-01-19        FALSE      NA  FALSE
# 20 2009-01-20        FALSE      NA  FALSE

Используя эти данные: 

your_data = read.table(header = T, text = '      date           oneweeksince victims
1    2009-01-01         FALSE      NA
2    2009-01-02         FALSE      NA
3    2009-01-03         FALSE      NA
4    2009-01-04         FALSE      NA
5    2009-01-05         FALSE      NA
6    2009-01-06         FALSE      NA
7    2009-01-07         FALSE      NA
8    2009-01-08          TRUE       1
9    2009-01-09          TRUE      NA
10   2009-01-10          TRUE      NA
11   2009-01-11          TRUE      NA
12   2009-01-12          TRUE      NA
13   2009-01-13          TRUE      NA
14   2009-01-14          TRUE      NA
15   2009-01-15          TRUE      NA
16   2009-01-16         FALSE      NA
17   2009-01-17         FALSE      NA
18   2009-01-18         FALSE      NA
19   2009-01-19         FALSE      NA
20   2009-01-20         FALSE      NA')
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Похожие темы

...