R/models.R

Defines functions nnar_auto arima_auto nnar lmtrend ets_sc arima_sc nnar_xreg_auto nnar_xreg arimax_auto arimax adl rmlv lmr

#' @export
lmr <- function(y, X, index_x, index_y, n_ahead, ...) {
    lmr_data <- data.frame(
        Y = y,
        X = X[1:(NROW(y)), ]
    )
    names(lmr_data)[-1] <- names(X)
    model_lmr <- forecast(
        object = stats::lm(data = lmr_data, formula = Y ~ 1 + .),
        newdata = X[setdiff(index_x, index_y), ],
        h = n_ahead
    )
    return(model_lmr)
}

#' @export
rmlv <- function(disp_y, lageed_X, n_ahead, ...) {
    rmlv_data <- data.frame(
        Y = disp_y,
        X = lageed_X[1:(NROW(disp_y)), ]
    )
    names(rmlv_data)[-1] <- names(lageed_X)
    model_rmlv <- forecast::forecast(
        object = stats::lm(data = rmlv_data, formula = Y ~ 1 + .),
        newdata = lageed_X[(NROW(lageed_X) - n_ahead + 1):NROW(lageed_X), ],
        h = n_ahead
    )
    return(model_rmlv)
}

#' @export
adl <- function(disp_y, lageed_X, n_ahead, method, ...) {
    model_adl <- forecast::forecast(
        object = forecast::Arima(
            y = disp_y,
            order = c(set_lag(disp_y)[1], 0, 0),
            xreg = lageed_X[1:(NROW(disp_y)), ],
            method = method
        ),
        xreg = lageed_X[(NROW(lageed_X) - n_ahead + 1):NROW(lageed_X), ],
        h = n_ahead
    )
    return(model_adl)
}

#' @export
arimax <- function(y, X, y_pq, y_d, index_x, index_y, n_ahead, method, ...) {
    model_arimax <- forecast::forecast(
        object = forecast::Arima(
            y = y,
            order = c(y_pq[1], y_d, y_pq[2]),
            xreg = X[index_y, ],
            method = method
        ),
        xreg = X[setdiff(index_x, index_y), ],
        h = n_ahead
    )
    return(model_arimax)
}

#' @export
arimax_auto <- function(y, X, y_d, index_x, index_y, ic, n_ahead, ...) {
    model_arimax_auto <- forecast::forecast(
        object = forecast::auto.arima(
            y = y,
            xreg = X[index_y, ],
            stationary = !y_d,
            max.p = 3,
            max.q = 3,
            ic = ic
        ),
        xreg = X[setdiff(index_x, index_y), ],
        h = n_ahead
    )
    return(model_arimax_auto)
}

#' @export
nnar_xreg <- function(y, X, y_pq, index_x, index_y, n_ahead, ...) {
    model_nnar_xreg <- forecast::forecast(
        object = forecast::nnetar(
            y = y,
            p = if (y_pq[1] == 0) 1 else y_pq[1],
            xreg = as.matrix(X[index_y, ])
        ),
        xreg = as.matrix(X[setdiff(index_x, index_y), ]),
        h = n_ahead
    )
    return(model_nnar_xreg)
}

#' @export
nnar_xreg_auto <- function(y, X, index_x, index_y, n_ahead, ...) {
    model_nnar_xreg_auto <- forecast::forecast(
        object = forecast::nnetar(
            y = y,
            xreg = as.matrix(X[index_y, ])
        ),
        xreg = as.matrix(X[setdiff(index_x, index_y), ]),
        h = n_ahead
    )
    return(model_nnar_xreg_auto)
}

#' @export
arima_sc <- function(y, y_pq, y_d, method, n_ahead, ...) {
    model_arima <- forecast::forecast(
        object = forecast::Arima(
            y = y,
            order = c(y_pq[1], y_d, y_pq[2]),
            xreg = NULL,
            method = method
        ),
        xreg = NULL,
        h = n_ahead
    )
    return(model_arima)
}

#' @export
ets_sc <- function(y, n_ahead, ...) {
    model_ets <- forecast::forecast(
        object = forecast::ets(y = y),
        h = n_ahead
    )
    return(model_ets)
}

#' @export
lmtrend <- function(y, n_ahead, ...) {
    model_lmtrend <- forecast::forecast(
        object = forecast::tslm(formula = y ~ trend),
        h = n_ahead
    )
    return(model_lmtrend)
}

#' @export
nnar <- function(y, y_pq, n_ahead, ...) {
    model_nnar <- forecast::forecast(
        object = forecast::nnetar(
            y = y,
            p = y_pq[1]
        ),
        h = n_ahead
    )
    return(model_nnar)
}

#' @export
arima_auto <- function(y, y_d, n_ahead, ic, ...) {
    model_arima_auto <- forecast::forecast(
        object = forecast::auto.arima(
            y = y,
            xreg = NULL,
            stationary = !y_d,
            max.p = 3,
            max.q = 3,
            ic = ic
        ),
        xreg = NULL,
        h = n_ahead
    )
    return(model_arima_auto)
}

#' @export
nnar_auto <- function(y, n_ahead, ...) {
    model_nnar_auto <-  fforecast::orecast(
        object = forecast::nnetar(
            y = y
        ),
        h = n_ahead
    )
    return(model_nnar_auto)
}
faganok/scenario documentation built on Nov. 28, 2017, 4:06 p.m.