在具有历史变化的数据集中，在给定日期寻找价值的有效方法

问题描述

考虑到一些历史性变化，我想有效地创建一个具有每个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)
}

我的解决方案存在以下两个问题：

1. 它看起来相当慢，尤其是在按比例扩展到实际数据（数千行的数量级）时。
2. 使用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