R/set_d.R

Defines functions set_d

#' @export
set_d  <- function(x, test = "KPSS", alpha = 0.05, max_d = 3) {
    x <- c(na.omit(unlist(x)))
    d <- 0
    is.const <- function(x) {
        x <- as.numeric(x)
        y <- rep(x[1], length(x))
        return(identical(x, y))
    }
    if (is.const(x)) {
        return(d)
    }
    tryCatch(
        expr = {
            suppressWarnings(
                if (test == "KPSS") {
                    dodiff <- tseries::kpss.test(x)[["p.value"]] < alpha
                } else if (test == "ADF") {
                    dodiff <- tseries::adf.test(x, k = 0)[["p.value"]] > alpha
                } else if (test == "PP")  {
                    dodiff <- tseries::pp.test(x)[["p.value"]] > alpha
                } else {
                    stop("This shouldn`t happen.")
                }
            )
        },
        error = function(e) {
            dodiff <<- NA
            cat(
                "Message: Stationary test was not designed for", names(x),
                "\b.\n"
            )
        }
    )
    if (is.na(dodiff)) {
        d <- 1
        rm("dodiff", envir = .GlobalEnv)
        return(d)
    }
    while (dodiff == TRUE & d < max_d) {
        d <- d + 1
        x <- diff(x)
        if (is.const(x)) {
            return(d)
        }
        suppressWarnings(
            if (test == "KPSS") {
                dodiff <- tseries::kpss.test(x)[["p.value"]] < alpha
            } else if (test == "ADF") {
                dodiff <- tseries::adf.test(x, k = 0)[["p.value"]] > alpha
            } else if (test == "PP")  {
                dodiff <- tseries::pp.test(x)[["p.value"]] > alpha
            } else {
                stop("This shouldn`t happen.")
            }
        )
        if (is.na(dodiff)) {
            return(d - 1)
        }
    }
    return(d)
}
faganok/scenario documentation built on Nov. 28, 2017, 4:06 p.m.