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

Question

考虑到一些历史性的变化，我想有效地创建一个带有每个 id 在给定日期的值的小标题。

例子

library(lubridate)
library(tidyverse)

df <- tribble(
  ~id, ~value, ~date_created,
  1, "a", as_date("2020-01-01"),
  1, "b", as_date("2020-01-06"),
  1, "c", as_date("2020-02-01"),
  2, "Y", as_date("2020-01-01"),
  2, "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,~value,1,NA,2,NA)

get_value_at_date(df, as_date("2020-01-06")) 应该有输出 tribble(~id,~value,1,"b",2,"Z")

get_value_at_date(df, as_date("2020-03-01")) 应该有输出 tribble(~id,~value,1,"c",2,"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 的 class 感觉不是很好的做法。这样做的原因是函数的输入 tibble 的值列可能与任何 class 一样。我不知道是否每个 class --class-- 函数都作为.--class--存在。

Answer 1

filter 的 .preserve 参数消除了处理已删除组的需要。

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).

混合

我结束了运行一个基准测试，性能并没有真正好

create_df <- function(n, rows_to_groups_ratio, seed = 123) {
  set.seed(seed)
  tibble(
    id = sample(sample(n %/% rows_to_groups_ratio, 1), n, replace = TRUE),
    value = sample(c(letters, LETTERS), n, replace = TRUE),
    date_declared = sample(seq(as.Date("2019-01-01"), as.Date("2020-07-01"), "day"), 
                           n, replace = TRUE)
  )
}

mybench <- bench::press(
  n = c(1e3, 10e3, 100e3, 1e6),
  rows_to_groups_ratio = c(3, 5, 10, 50, 100),
  {
    df <- create_df(n, rows_to_groups_ratio)
    date <- as.Date("2020-01-01")
    bench::mark(
      get_value_at_date(df, date),
      get_value_at_date_2(df, date) 
    )
  }
)

autoplot(mybench)

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

Efficient tidyverse way of finding value at given date in data set with historic changes

r

lubridate

tidyverse