/
estimate.R
39 lines (36 loc) · 1.28 KB
/
estimate.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
#' Estimate a model
#'
#' @param .data A data structure suitable for the models (such as a `tsibble`).
#' @param ... Further arguments passed to methods.
#'
#' @rdname estimate
#'
#' @export
estimate <- function(.data, ...){
UseMethod("estimate")
}
#' @param .model Definition for the model to be used.
#'
#' @rdname estimate
#' @export
estimate.tbl_ts <- function(.data, .model, ...){
if(!inherits(.model, "mdl_defn")){
abort("Model definition incorrectly created. Check that specified model(s) are model definitions.")
}
.model$stage <- "estimate"
.model$add_data(.data)
validate_formula(.model, .data)
parsed <- parse_model(.model)
# Compute response data (as attributes shouldn't change, using this approach should be much faster)
.dt_attr <- attributes(.data)
resp <- map(parsed$expressions, eval_tidy, data = .data, env = .model$specials)
.data <- unclass(.data)[index_var(.data)]
.data[map_chr(parsed$expressions, expr_name)] <- resp
attributes(.data) <- c(attributes(.data), .dt_attr[setdiff(names(.dt_attr), names(attributes(.data)))])
fit <- eval_tidy(
expr(.model$train(.data = .data, specials = parsed$specials, !!!.model$extra))
)
.model$remove_data()
.model$stage <- NULL
new_model(fit, .model, .data, parsed$response, parsed$transformation)
}