Как суммировать данные на основе расчетов по датам
У меня есть данные, которые выглядят так (примечание даты в формате ДД-ММ-ГГГГ):
ID date drug score
A 28/08/2016 2 3
A 29/08/2016 1 4
A 30/08/2016 2 4
A 2/09/2016 2 4
A 3/09/2016 1 4
A 4/09/2016 2 4
B 8/08/2016 1 3
B 9/08/2016 2 4
B 10/08/2016 2 3
B 11/08/2016 1 3
C 30/11/2016 2 4
C 2/12/2016 1 5
C 3/12/2016 2 1
C 5/12/2016 1 4
C 6/12/2016 2 4
C 8/12/2016 1 2
C 9/12/2016 1 2
Для "наркотиков": 1= наркотики приняты, 2= наркотики не приняты.
Мне нужно подвести итог для каждого удостоверения личности:
- 0day: средний балл за дни, когда принимался препарат.
- -1день: средний балл за дни, предшествующие моменту приема препарата.
- +1 день: средний балл по дням сразу после приема препарата.
Если лекарство принималось 2 дня подряд (например, последние 2 строки примера), то эти оценки не должны учитываться в расчетах -1 или +1 день (т. Е. Каждая из последних двух строк будет вносить вклад в оценку 0 дней. но не будет способствовать другим метрикам).
Поэтому для данных этого примера мне понадобится таблица вывода, например:
-1day 0day +1day
A 3.5 4 4
B 3 3 4
C 3.25 2.5
Обратите внимание, что не существует записей для всех дат, и что вычисления -1day и +1day должны основываться на фактических датах, а не только на записях в наборе данных.
Я понятия не имею, как это сделать.
У меня также есть два дополнительных бонусных вопроса:
Скорее всего, мне также понадобится рассчитать 2-дневный и +2-дневный баллы, поэтому я должен быть в состоянии адаптировать ответ для этого.
Как я могу рассчитать показатель NoDrug, который является средним значением всех дней, которые не находятся в пределах 5 дней с момента приема препарата.
Вот код для генерации кадра данных с данными этого примера:
data<-data.frame(ID=c("A","A","A","A","A","A","B","B","B","B","C","C","C","C","C","C","C"),
date=as.Date(c("28/08/2016","29/08/2016","30/08/2016","2/09/2016","3/09/2016","4/09/2016","8/08/2016","9/08/2016","10/08/2016","11/08/2016","30/11/2016","2/12/2016","3/12/2016","5/12/2016","6/12/2016","8/12/2016","9/12/2016"),format= "%d/%m/%Y"),
drug=c(2,1,2,2,1,2,1,2,2,1,2,1,2,1,2,1,1),
score=c(3,4,4,4,4,4,3,4,3,3,4,5,1,4,4,2,2))
3 ответа
Вы можете использовать dplyr, чтобы получить это:
Создать данные
df <- data.frame(
ID=c("A","A","A","A","A","A","B","B","B","B","C","C","C","C","C","C","C"),
date=as.Date(c("28/08/2016","29/08/2016","30/08/2016","2/09/2016","3/09/2016","4/09/2016","8/08/2016","9/08/2016","10/08/2016","11/08/2016","30/11/2016","2/12/2016","3/12/2016","5/12/2016","6/12/2016","8/12/2016","9/12/2016"),format= "%d/%m/%Y"),
drug=c(2,1,2,2,1,2,1,2,2,1,2,1,2,1,2,1,1),
score=c(3,4,4,4,4,4,3,4,3,3,4,5,1,4,4,2,2)
)
df
#> ID date drug score
#> 1 A 2016-08-28 2 3
#> 2 A 2016-08-29 1 4
#> 3 A 2016-08-30 2 4
#> 4 A 2016-09-02 2 4
#> 5 A 2016-09-03 1 4
#> 6 A 2016-09-04 2 4
#> 7 B 2016-08-08 1 3
#> 8 B 2016-08-09 2 4
#> 9 B 2016-08-10 2 3
#> 10 B 2016-08-11 1 3
#> 11 C 2016-11-30 2 4
#> 12 C 2016-12-02 1 5
#> 13 C 2016-12-03 2 1
#> 14 C 2016-12-05 1 4
#> 15 C 2016-12-06 2 4
#> 16 C 2016-12-08 1 2
#> 17 C 2016-12-09 1 2
Заполните пропущенные строки (дни)
Хорошим способом решения подобных проблем, при котором строки неявным образом пропускают явные пропущенные наблюдения, является использование tidyr::complete
library(dplyr)
library(tidyr)
df1 <- df %>%
group_by(ID) %>%
complete(date = seq(min(date), max(date), by = "day"))
df1
#> Source: local data frame [22 x 4]
#> Groups: ID [3]
#>
#> # A tibble: 22 x 4
#> ID date drug score
#> <fctr> <date> <dbl> <dbl>
#> 1 A 2016-08-28 2 3
#> 2 A 2016-08-29 1 4
#> 3 A 2016-08-30 2 4
#> 4 A 2016-08-31 NA NA
#> 5 A 2016-09-01 NA NA
#> 6 A 2016-09-02 2 4
#> 7 A 2016-09-03 1 4
#> 8 A 2016-09-04 2 4
#> 9 B 2016-08-08 1 3
#> 10 B 2016-08-09 2 4
#> # ... with 12 more rows
Категории дней
df2 <- df1 %>%
group_by(ID) %>%
mutate(day_of = drug == 1,
day_before = (lead(drug) == 1 & day_of == FALSE),
day_after = (lag(drug) == 1 & day_of == FALSE))
df2
#> Source: local data frame [22 x 7]
#> Groups: ID [3]
#>
#> # A tibble: 22 x 7
#> ID date drug score day_of day_before day_after
#> <fctr> <date> <dbl> <dbl> <lgl> <lgl> <lgl>
#> 1 A 2016-08-28 2 3 FALSE TRUE NA
#> 2 A 2016-08-29 1 4 TRUE FALSE FALSE
#> 3 A 2016-08-30 2 4 FALSE NA TRUE
#> 4 A 2016-08-31 NA NA NA NA FALSE
#> 5 A 2016-09-01 NA NA NA FALSE NA
#> 6 A 2016-09-02 2 4 FALSE TRUE NA
#> 7 A 2016-09-03 1 4 TRUE FALSE FALSE
#> 8 A 2016-09-04 2 4 FALSE NA TRUE
#> 9 B 2016-08-08 1 3 TRUE FALSE FALSE
#> 10 B 2016-08-09 2 4 FALSE FALSE TRUE
#> # ... with 12 more rows
Суммируйте по типам дня
dplyr::mutate_at применяет функцию (в funs()) ко всем столбцам, выбранным в vars(), summarise_at работает аналогичным образом в отношении работы с некоторыми выбранными столбцами, но вместо изменения значений полного набора данных он сокращает количество операций до одной строки на группу. Может можете узнать больше о м mutate, summarise и специальный *_at версии.
df3 <- df2 %>%
mutate_at(vars(starts_with("day_")), funs(if_else(. == TRUE, score, NA_real_))) %>%
summarise_at(vars(starts_with("day_")), mean, na.rm = TRUE)
df3
#> # A tibble: 3 x 4
#> ID day_of day_before day_after
#> <fctr> <dbl> <dbl> <dbl>
#> 1 A 4.00 3.5 4.0
#> 2 B 3.00 3.0 4.0
#> 3 C 3.25 NaN 2.5
Я предпочитаю использовать пакеты временных рядов (например, zoo) для таких задач.
library(zoo)
#function that handles conversion to zoo time series
my_zoo=function(x,idx) {
date_range=seq(min(idx),max(idx),by="day")
#add missing dates
dummy_zoo=merge(zoo(x,idx),zoo(NA,date_range),all=TRUE)[,1]
#add NA entry at top/bottom
rbind(dummy_zoo,rbind(zoo(NA,max(idx)+1),zoo(NA,min(idx)-1)))
}
#split by ID, handle cases where drug is NA
split_data=lapply(split(data,df$ID),function(x) {
list(score=my_zoo(x$score,x$date),
taken=(my_zoo(x$drug,x$date)==1)&
!is.na(my_zoo(x$drug,x$date)))})
#calculate stats
#your requirement that subsequent days with drug taken...
#... are completely omitted is a bit tricky to handle
res=data.frame(
mean_m1=sapply(split_data,function(x) {
mean(x$score[diff(x$taken,-1)>0&
lag(diff(x$taken),+1)],
na.rm=TRUE)}),
mean_0=sapply(split_data,function(x) {
mean(x$score[x$taken],
na.rm=TRUE)}),
mean_p1=sapply(split_data,function(x) {
mean(x$score[diff(x$taken,+1)<0&
lag(diff(x$taken),-1)],
na.rm=TRUE)}))
res
# mean_m1 mean_0 mean_p1
# A 3.5 4.00 4.0
# B 3.0 3.00 4.0
# C NaN 3.25 2.5
Вот возможность использования dplyr И его lead а также lagфункции:
library(tidyverse)
data %>% group_by(ID) %>%
arrange(date) %>%
mutate(
# use ifelse for cases of drugs being take twice or more in a row
`-1 day` = ifelse(dplyr::lag(drug) != 1, dplyr::lag(score, 1), NA),
`+1 day` = ifelse(dplyr::lead(drug) != 1, dplyr::lead(score, 1), NA)
) %>%
filter(drug == 1) %>%
summarise_all(mean, na.rm = TRUE) %>%
select(
`-1 day`,
`0 day` = score,
`+1 day`,
-date,
-drug
)
# A tibble: 3 × 3
`-1 day` `0 day` `+1 day`
<dbl> <dbl> <dbl>
1 3.5 4.00 4.0
2 3.0 3.00 4.0
3 3.0 3.25 2.5