Векторизованный метод для взвешенного по времени среднего значения в соответствии с заданной весовой функцией

Question

Я рассчитываю рассчитать взвешенное по времени среднее значение с использованием определенной весовой функции в векторизованном виде.

Я выяснил, как это сделать в цикле for (код ниже), но я работаю с наборами данных из строк appx 100k и надеюсь найти векторизованный метод. Я подозреваю, что для этого требуется что-то из семейства apply(), и я попытался и не смог создать функцию, которая бы работала в apply(). Я написал функцию, которая (я думаю?) Векторизует решение, но я не уверен, что сделал это правильно или эффективно, и я надеялся, что там было лучшее решение.

РЕДАКТИРОВАТЬ: txhousing можно найти в пакете ggplot2

построить набор данных:

library("tidyverse")

normal_fn <- function(x, mu = 0, theta_sq = 1){
  y <- (1 / sqrt(2 * pi * theta_sq)) * exp((-1*((x - mu)^2)) / (2 * theta_sq))

  return(y)
}

last_n <- 50

weights_df <- data.frame(weight = normal_fn(seq(0, 3, length.out = last_n)),
                         rank = seq(last_n))

txhousing.mutated <- txhousing %>% 
  filter(city %in% c("Austin", "Houston", "El Paso")) %>% 
  mutate(date = lubridate::as_date(paste0(year, "-", month, "-01"))) %>% 
  select(city, listings, date) %>% 
  group_by(city) %>% 
  arrange(date) %>% 
  mutate(date_rank = rank(date))

метод 1: для цикла

tw_txhousing.list <- vector(mode = "list", length = nrow(txhousing.mutated))
for(i in seq(nrow(txhousing.mutated))){

  txhousing.this <- txhousing.mutated %>% 
    filter(city == txhousing.mutated[[i, "city"]] & date_rank < txhousing.mutated[[i, "date_rank"]]) %>% 
    arrange(date_rank) %>% 
    tail(last_n) %>% 
    mutate(this_date_rank = rev(row_number()))

  tw_txhousing.list[[i]] <- txhousing.this %>% 
    left_join(weights_df, by = c("this_date_rank" = "rank")) %>% 
    summarise(tw_listings = weighted.mean(listings, w = weight, na.rm = T)) %>% 
    mutate(date = txhousing.mutated[[i, "date"]])

}

tw_txhousing.df2 <- txhousing.mutated %>% 
  left_join(data.table::rbindlist(tw_txhousing.list), by = c("city", "date"))

метод 2: по очереди fn

semi_vec <- function(data_df, weights, id, rank, prev){
  txhousing.this <- txhousing.mutated %>% 
    filter(city == id & date_rank < rank) %>% 
    arrange(date_rank) %>% 
    tail(last_n) %>% 
    mutate(this_date_rank = rev(row_number()))

  data.out <- txhousing.this %>% 
    left_join(weights_df, by = c("this_date_rank" = "rank")) %>% 
    summarise(tw_listings = weighted.mean(listings, w = weight, na.rm = T)) %>% 
    pull(tw_listings)

  if(length(data.out)<1){
    data.out <- NA_real_
  }

  return(data.out)
}

tw_txhousing.df <- txhousing.mutated %>%
  rowwise() %>% 
  mutate(tw_listings = semi_vec(data_df = txhousing.mutated, weights = weights_df, id = city, rank = date_rank, prev = last_n)) %>% 
  ungroup()

Я ожидаю получить те же результаты, что и показанные выше, только в более короткие сроки. Я использовал простой пример, но было бы полезно, если бы функция допускала несколько выходов (скажем, weighted.mean (na.rm = F), а также (na.rm = T), в виде списка или несколько столбцов, в зависимости от того, что проще).

Спасибо!