Как рассчитать уклон бега для RLM с помощью бегуна?

Question

У меня есть сборка "клиентов" фрейма данных, содержащая идентификатор клиента, месяц и общее количество покупок за этот месяц. Я пытаюсь рассчитать наклон для окна в 12 месяцев, используя надежную регрессию.

Я пробовал следующее:

Coef <- function(x) {return(rlm(cbind(x)~cbind(1:length(x)))$coefficients[2])}
customer_slope = customers %>% mutate(slope = runner(x=total_purchases,k=12,f=Coef))

Я получаю следующую ошибку:

x 'x' - это единственное число: единственное совпадение не реализовано в 'rlm'

Если я запустил единственный пример, функция вернет то, что я ожидал:

Coef(c(4,11,7,15,5,14,8,9,14,17,14,13))

cbind (1: длина (x)) 0,6888112

Answer 1

Итак, я столкнулся с аналогичными проблемами и, наконец, пришел к решению, приведенному ниже, с использованием слайдера. Это дает скользящую оценку за 3 дня (конечно, вы можете изменить ее по своему усмотрению). Это не совсем соответствует вашему ответу (который вы, вероятно, могли бы получить с помощью циклов), но большую часть пути туда.

library(MASS)
library(dplyr)
library(slider)

dat <- tibble::tibble(customers = c(4,11,7,15,5,14,8,9,14,17,14,13)) %>% 
  mutate(t = 1:n() %>% as.numeric())

dat %>% 
  mutate(results = slide_dbl(.x = .,
                             .f = ~rlm(customers ~ t, k = 12, data = .x)$coefficients[2],
                             .before = 2,
                             .complete = T))

Answer 2

Рассмотрим данные двух клиентов с данными за период в 1000 дней. total_purchases накапливаются заказчиком, и размер каждой покупки составляет ~ pois (5).

set.seed(1)
customers <- data.frame(
  id = factor(rep(1:2, length.out = 100)),
  date = seq(Sys.Date(), Sys.Date() + 1000, length.out = 100)
) %>%
  group_by(id) %>%
  mutate(
    total_purchases = cumsum(rpois(n(), lambda = 5)) 
  )

При использовании вычисления регрессии в скользящем окне убедитесь, что вы обрабатываете ошибки, возникающие из-за недостаточной степени свободы, особенности et c. - вот почему я поставил tryCatch вокруг вызова rlm - если есть ошибка, функция возвращает NA для сбойного окна. Данные ниже сгруппированы по id, что означает, что модель рассчитана для каждого клиента. Ежегодная скользящая регрессия должна сходиться к slope = 5 (+/- случайная ошибка).

  customers %>%
    group_by(id) %>%
    mutate(
      slope = runner(
        x = .,
        f = function(x) {
          tryCatch(
            rlm(x$total_purchases ~ seq_len(nrow(x)))$coefficients[2],
            error = function(e) NA
          )
        },
        idx = "date",
        k = "year"
      )
    )

График уклона во времени для клиентов

ggplot(customers, aes(x = date, y = slope, color = id, group = id)) +
  geom_line() +
  geom_hline(yintercept = 5, color = "red")

введите описание изображения здесь

Answer 3

Похоже, это путь к go, спасибо! Похоже, что причиной сингулярности было то, что я не изменил значение по умолчанию .complete с F на T. Итак, в сочетании с вашим предложением, я заставил его работать вот так (на 3M строк у меня ушло около двух часов, но у меня было больше задействован комплекс group_by, который не показан ниже)

slope_rlm <- function(x) {
  x=as.numeric(x)
  prep = tibble(data=x)%>%mutate(t=1:n()%>%as.numeric())
  return(rlm(data~t,data=prep)$coefficients[2])
}


customers_rlm = customers %>% 
  mutate(cust_rlm_12=slide_dbl(total_purchases,slope_rlm,.before=11,.complete=T))