#r #dataframe #dplyr #feature-engineering
#r #фрейм данных #dplyr #разработка функций
Вопрос:
Я ищу способ закодировать информацию на основе столбцов в предыдущих 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
Набору данных много лет, поэтому мне нужен эффективный способ сделать это.
Ответ №1:
Решение от @G.Гротендик
После некоторых обсуждений это наиболее эффективный ответ.
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
ДАННЫЕ
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
Моя вторая попытка
OP указал, что мое решение не будет работать, если в первых 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
ДАННЫЕ
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. Сбой при добавлении этих данных в начале
2008-12-28 22. Похоже, что это не удается, если дата находится в пределах первых N записей data.frame, где N — диапазон окна.
3. @Robert Я не понимаю, почему вы хотите добавить
2008-12-28 2в начале. Обратите внимание, что в примере фрейма данныхdateстолбец является полным. При добавлении2008-12-28 2,dateстолбец не будет полным, так как есть пробелы. Это становится другим вопросом. Чтобы ответить на ваш вопрос, мы можем преобразоватьdateстолбец вdateclass, а затем использоватьcompleteизtidyrдля расширенияdateстолбца с заполненным рядом дат. После этого мы можем использовать мое решение. Но поскольку это не условие, указанное OP, я не буду упоминать об этом в своем ответе.4. Я думал об общем подходе, при котором в данных могут быть пробелы. В остальном вы правы.
5. @www Круто. Было бы неплохо переименовать «обновить» в нижнем заголовке, поскольку это может показаться обновлением ответа, который вы опубликовали вверху. Я соглашусь.
Ответ №2:
Мы можем выполнить скользящую сумму и проверить, что она больше 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')
Комментарии:
1. Сбой при добавлении этих данных в начале
2008-12-28 22. Похоже, что это не удается, если дата находится в пределах первых N записей data.frame, где N — диапазон окна.
3. @Learningstatsbyexample Я бы предложил обновить ваши примерные данные в вопросе, чтобы включить этот случай. Похоже, это распространенная точка отказа.
Ответ №3:
Я предпочитаю ответ Грегора, но вот две альтернативы.
База 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) amp; (0 <= x$since amp; 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) amp; 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. Ответ Грегора не выполняется, согласно одному комментатору.
2. Правильно, работает, если добавить эти данные в начале
2008-12-28 2
Ответ №4:
Не уверен в эффективности, но один из способов сделать это в базе R, используя sapply , — для каждой строки мы возвращаемся на 7 строк назад и проверяем, удовлетворяет ли она какому-либо из условий, и соответственно возвращаем логический вывод.
sapply(seq_len(nrow(df)), function(x) {
temp = df$victims[x : pmax(1, x - 7)]
any(temp > 0) amp; 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. Сбой при добавлении этих данных в начале
2008-12-28 22. @Robert Как? OP упомянул, чтобы проверить предыдущие 7 строк и посмотреть, имеет ли какая-либо из них
victimsзначение, большее 0, и значение, отличное от NA.3. Я думал об общем подходе, при котором в данных могут быть пробелы. В остальном вы правы.