时间戳

首页 > 解决方案 > 有没有一种使用 R 近似函数的方法，其中要插值的值取决于数据框中的其他列？

r - 有没有一种使用 R 近似函数的方法，其中要插值的值取决于数据框中的其他列？

问题描述

在下面的示例中，我想使用 approx 函数将 pct_answer 列添加到我的名为“data”的表中。pct_answer 列是通过从名为“查找”的表中线性插值来计算的。

要插值的值取决于名为 data 的表中的“account”和“pattern_number”的值。

通过创建一个函数，然后使用 purrr::map 将此函数应用于数据框的所有行，我设法产生了我需要的答案（请参阅下面的可重现示例）。然而，在我试图解决的实际问题中，数据中有数百万行，这需要很长时间才能运行。

有没有更快的方法来达到同样的结果？

library(tidyverse)

data <- tibble(
  account = c(rep("a", 5), rep("b", 7), rep("c", 7)),
  pattern_num = c(rep(1, 2), rep(2, 3), rep(1, 11), rep(2, 3)),
  pct_lookup = c(seq(0.05, 0.25, by = 0.05), seq(0.5, 0.8, by = 0.05), seq(0.65, 0.95, by = 0.05))
)

lookup <- tibble(
  account = c(rep("a", 20), rep("b", 10)),
  pattern_num = c(rep(1, 10), rep(2, 10), rep(1, 10)),
  pct_lookup = rep(seq(0.1, 1, by = 0.1), 3),
  norm_mean = c(rep(0, 10), rep(0.5, 10), rep(0.25, 10))
) %>% 
  mutate(pct_answer = map2_dbl(pct_lookup, norm_mean, pnorm)) %>% 
  dplyr::select(-norm_mean)

lookup_function <- function(account_name, pattern_number, lookup_num){
  
  lookup_table <- lookup %>% 
    filter(account == {{account_name}}, pattern_num == {{pattern_number}})
  
  if(nrow(lookup_table) == 0){
    return(NA)
  }else{
  
  result <- approx(lookup_table$pct_lookup, lookup_table$pct_answer, xout = lookup_num, ties = "ordered", rule = 2)$y
  
  return(result)
  }
}

data <- data %>% 
  rowwise() %>% 
  mutate(pct_answer = map2(account, pattern_num, lookup_function, lookup_num = pct_lookup))

标签： rtidyversepurrr

解决方案

使用Map

library(data.table)
setDT(data)[, pct_answer := unlist(Map(lookup_function, account, pattern_num, pct_lookup)])

推荐阅读