Блог

У меня есть модель, которая в качестве предиктора имеет предыдущий прогноз. например target ~ lag(target prediction)

Используя purrr::накопите, я могу написать пользовательскую функцию для прогнозирования. Пример некоторых глупых данных и глупой модели, которая иллюстрирует:

  ### A model that uses a lag prediction as a predictor using purrr::accumulate() ###
my_diamonds <- diamonds %>% 
  group_by(cut) %>% 
  mutate(cumprice = cumsum(price)) %>% # cumulative within groups
  mutate(lag_cumprice = lag(cumprice)) %>% 
  mutate(InitialValue = min(cumprice)) %>% 
  filter(!is.na(lag_cumprice)) %>% 
  select(cut, cumprice, lag_cumprice, x, InitialValue)

silly_model <- glm(formula = cumprice ~ x   lag_cumprice, family = 'poisson', data = my_diamonds)
 

Эта модель использует предыдущий прогноз в качестве входных данных для следующего прогноза. Я могу написать пользовательскую функцию для изменения прогноза:

 # when predicting won't have lag_cumprice, instead the result of the previous pediction should be an input to the model:
accPrice <- function(mod, acc, cur) {
  
  db=cur_data_all() # grouped data segment
  x = db$x[cur] # cur is the current row in the data, use it to get 'this' iterations value of x
  
  total_exponent <- mod$coefficients['(Intercept)']   
    (mod$coefficients['x'] * x)  
    (mod$coefficients['lag_cumprice'] * acc) # acc is the accumulated prediction for cumprice
}

# now predict
my_diamonds <- my_diamonds %>% 
  mutate(predicted = accumulate(.x = row_number()[-1], .init = InitialValue %>% unique, .f = accPrice, mod = silly_model))
 

Пока все хорошо. В этом примере я использовал предыдущий прогноз acc в качестве входных данных.

Но я создал вариационную модель, которая теперь использует две запаздывающие переменные в качестве предикторов:

 ### now a model with lag on two variables not just one ###
my_diamonds2 <- diamonds %>% 
  group_by(cut) %>% 
  mutate(cumprice = cumsum(price)) %>% # cumulative within groups
  mutate(lag_cumprice = lag(cumprice)) %>% 
  mutate(InitialValue = min(cumprice)) %>% 
  mutate(rn = row_number()) %>% 
  mutate(cumrn = cumsum(rn)) %>% 
  mutate(lag_cumrn = lag(cumrn)) %>% 
  filter(!is.na(lag_cumprice)) %>% 
  select(cut, cumprice, lag_cumprice, lag_cumrn, x, InitialValue)

silly_model2 <- glm(formula = cumprice ~ x   lag_cumprice   lag_cumrn, family = 'poisson', data = my_diamonds2)

### Stuck after here ###
 

Как я могу изменить функцию accPrice() выше, чтобы накапливать 2 переменные, как lag_cumprice, так и lag_cumrn, а не просто lag_cumprice, как раньше?

Мы могли бы добавить аргумент в функцию. Затем извлеките соответствующий коэффициент из модели и умножьте на него

 accPrice2 <- function(mod, acc, acc2, cur) {
   
   db=cur_data_all() # grouped data segment
   x = db$x[cur] # cur is the current row in the data, use it to get 'this' iterations value of x
   
   total_exponent <- mod$coefficients['(Intercept)']   
     (mod$coefficients['x'] * x)  
     (mod$coefficients['lag_cumprice'] * acc)    
    (mod$coefficients['lag_cumrn'] * acc2)
 }

my_diamonds2 %>% 
   mutate(predicted = accumulate(.x = row_number()[-1], 
      .init = InitialValue %>%
              unique, .f = accPrice2, mod = silly_model))