如何解决在具有历史变化的数据集中,在给定日期寻找价值的有效方法
考虑到一些历史性变化,我想有效地创建一个具有每个id在给定日期具有什么值的小工具。
示例
library(lubridate)
library(tidyverse)
df <- tribble(
~id,~value,~date_created,1,"a",as_date("2020-01-01"),"b",as_date("2020-01-06"),"c",as_date("2020-02-01"),2,"Y","Z",as_date("2020-01-02")
)
# function should output a tibble with one row per id with the value it had at that date
get_value_at_date <- function(df,date){}
get_value_at_date(df,as_date("2019-01-01"))
应该具有输出tribble(~id,NA,NA)
get_value_at_date(df,as_date("2020-01-06"))
应该具有输出tribble(~id,"Z")
get_value_at_date(df,as_date("2020-03-01"))
应该具有输出tribble(~id,"Z")
示例解决方案功能
get_value_at_date <- function(df,date){
# find the last change before the date
value_at_date_df <- df %>%
arrange(id,date_created) %>%
group_by(id) %>%
filter(date_created <= date) %>%
slice_tail(n = 1) %>%
select(id,value)
# value could be of many class types,and need a unique NA for each
value_class <- class(df %>% select(value) %>% pull())
# we're assuming as.CLASS(NA) works for all CLASS inputs
bespoke_na <- eval(parse(text=paste0("as.",value_class,"(NA)")))
# find any that have been removed so should be blank
missed_ids <- df %>%
anti_join(value_at_date_df,by = "id") %>%
pull(id) %>%
unique()
# make it a df
missed_ids_df <- tibble(
id = missed_ids,value = bespoke_na
)
# attach the 2 dfs
out_df <- bind_rows(value_at_date_df,missed_ids_df) %>%
arrange(id) %>%
ungroup()
return(out_df)
}
我的解决方案存在以下两个问题:
- 它看起来相当慢,尤其是在按比例扩展到实际数据(数千行的数量级)时。
- 使用
eval
来猜测NA的类别并不是一种好习惯。这样做的原因是函数的输入小标题可能将value列作为任何类。我不知道每个类-class-的功能是否存在。-class-。
解决方法
.preserve
的{{1}}参数无需处理已删除的组。
filter
使用last
表示明显的缺失值,但可以根据需要将其覆盖。
dplyr:::default_missing
(基准测试省去了,因为它最好在实际数据的中到实际规模上进行,并且在上面的示例数据中可能没有意义。如果性能仍然存在问题,请考虑使用get_value_at_date_2 <- function(df,date){
df %>%
group_by(id) %>%
dplyr::filter(date_created <= date,.preserve = TRUE) %>%
summarize(value = dplyr::last(value,order_by = date_created))
}
get_value_at_date_2(df,as_date("2019-01-01"))
#> `summarise()` ungrouping output (override with `.groups` argument)
#> # A tibble: 2 x 2
#> id value
#> <dbl> <chr>
#> 1 1 <NA>
#> 2 2 <NA>
get_value_at_date_2(df,as_date("2020-01-06"))
#> `summarise()` ungrouping output (override with `.groups` argument)
#> # A tibble: 2 x 2
#> id value
#> <dbl> <chr>
#> 1 1 b
#> 2 2 Z
get_value_at_date_2(df,as_date("2020-03-01"))
#> `summarise()` ungrouping output (override with `.groups` argument)
#> # A tibble: 2 x 2
#> id value
#> <dbl> <chr>
#> 1 1 c
#> 2 2 Z
软件包,这样可以与data.table
混合)。
我最终运行了一个基准测试,性能并没有真正改善
tidyverse
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。