r - 巨大なモデル オブジェクトをファイルに保存する

Question

VAR() 回帰操作から返されたクラス 'varrest' のモデル オブジェクトがあるとします。モデルをファイルに保存したいのですが、係数の推定に使用されたすべてのデータではありません。

トレーニングデータなしでモデル仕様を保存するにはどうすればよいですか? モデルを保存すると、ファイル サイズが 1 GB を超えるため、読み込みに時間がかかるためです。いくつかの属性なしでオブジェクトを保存できますか?

Answer 1

Forecast.varest関数は、次のコードで始まります。

K <- object$K
p <- object$p
obs <- object$obs
type <- object$type
data.all <- object$datamat
ynames <- colnames(object$y)

次に、どの程度の剪定を達成できるかを調査できます。

data(Canada)
tcan <- 
VAR(Canada, p = 2, type = "trend")
names(tcan)
# [1] "varresult"    "datamat"      "y"            "type"         "p"           
# [6] "K"            "obs"          "totobs"       "restrictions" "call"        
 object.size(tcan[c("K","p", "obs", "type", "datamat", "y")] )
#15080 bytes
 object.size(tcan)
#252032 bytes

したがって、違いはかなりありますが、predict.varestの次の行は次のとおりであるため、これらのアイテムを保存するだけでは不十分です。

B <- Bcoef(object)

そのオブジェクトを上記のリストに追加してから、モデルオブジェクトの大きな「varresult」ノードよりも小さいものを受け入れる新しいpredict-functionを作成する必要があります。また、保存する必要のある内部関数へのダウンストリーム呼び出しがあったことが判明しました。（予測に必要な間隔を事前に決定する必要があります。）

tsmall <- c( tcan[c("K","p", "obs", "type", "datamat", "y", "call")] )
tsmall[["Bco"]] <- Bcoef(tcan)
tsmall$sig.y <- vars:::.fecov(x = tcan, n.ahead = 10)

そして、変更されたpredict関数は次のようになります。

sm.predict <- function (object, ..., n.ahead = 10, ci = 0.95, dumvar = NULL) 
{
    K <- object$K
    p <- object$p
    obs <- object$obs
    type <- object$type
    data.all <- object$datamat
    ynames <- colnames(object$y)
    n.ahead <- as.integer(n.ahead)
    Z <- object$datamat[, -c(1:K)]
  # This used to be a call to Bcoef(object)
    B <- object$Bco
    if (type == "const") {
        Zdet <- matrix(rep(1, n.ahead), nrow = n.ahead, ncol = 1)
        colnames(Zdet) <- "const"
    }
    else if (type == "trend") {
        trdstart <- nrow(Z) + 1 + p
        Zdet <- matrix(seq(trdstart, length = n.ahead), nrow = n.ahead, 
            ncol = 1)
        colnames(Zdet) <- "trend"
    }
    else if (type == "both") {
        trdstart <- nrow(Z) + 1 + p
        Zdet <- matrix(c(rep(1, n.ahead), seq(trdstart, length = n.ahead)), 
            nrow = n.ahead, ncol = 2)
        colnames(Zdet) <- c("const", "trend")
    }
    else if (type == "none") {
        Zdet <- NULL
    }
    if (!is.null(eval(object$call$season))) {
        season <- eval(object$call$season)
        seas.names <- paste("sd", 1:(season - 1), sep = "")
        cycle <- tail(data.all[, seas.names], season)
        seasonal <- as.matrix(cycle, nrow = season, ncol = season - 
            1)
        if (nrow(seasonal) >= n.ahead) {
            seasonal <- as.matrix(cycle[1:n.ahead, ], nrow = n.ahead, 
                ncol = season - 1)
        }
        else {
            while (nrow(seasonal) < n.ahead) {
                seasonal <- rbind(seasonal, cycle)
            }
            seasonal <- seasonal[1:n.ahead, ]
        }
        rownames(seasonal) <- seq(nrow(data.all) + 1, length = n.ahead)
        if (!is.null(Zdet)) {
            Zdet <- as.matrix(cbind(Zdet, seasonal))
        }
        else {
            Zdet <- as.matrix(seasonal)
        }
    }
    if (!is.null(eval(object$call$exogen))) {
        if (is.null(dumvar)) {
            stop("\nNo matrix for dumvar supplied, but object varest contains exogenous variables.\n")
        }
        if (!all(colnames(dumvar) %in% colnames(data.all))) {
            stop("\nColumn names of dumvar do not coincide with exogen.\n")
        }
        if (!identical(nrow(dumvar), n.ahead)) {
            stop("\nRow number of dumvar is unequal to n.ahead.\n")
        }
        if (!is.null(Zdet)) {
            Zdet <- as.matrix(cbind(Zdet, dumvar))
        }
        else {
            Zdet <- as.matrix(dumvar)
        }
    }
    Zy <- as.matrix(object$datamat[, 1:(K * (p + 1))])
    yse <- matrix(NA, nrow = n.ahead, ncol = K)
  # This used to be a call to vars:::.fecov
    sig.y <- object$sig.y
    for (i in 1:n.ahead) {
        yse[i, ] <- sqrt(diag(sig.y[, , i]))
    }
    yse <- -1 * qnorm((1 - ci)/2) * yse
    colnames(yse) <- paste(ci, "of", ynames)
    forecast <- matrix(NA, ncol = K, nrow = n.ahead)
    lasty <- c(Zy[nrow(Zy), ])
    for (i in 1:n.ahead) {
        lasty <- lasty[1:(K * p)]; print(lasty); print(B)
        Z <- c(lasty, Zdet[i, ]) ;print(Z)
        forecast[i, ] <- B %*% Z
        temp <- forecast[i, ]
        lasty <- c(temp, lasty)
    }
    colnames(forecast) <- paste(ynames, ".fcst", sep = "")
    lower <- forecast - yse
    colnames(lower) <- paste(ynames, ".lower", sep = "")
    upper <- forecast + yse
    colnames(upper) <- paste(ynames, ".upper", sep = "")
    forecasts <- list()
    for (i in 1:K) {
        forecasts[[i]] <- cbind(forecast[, i], lower[, i], upper[, 
            i], yse[, i])
        colnames(forecasts[[i]]) <- c("fcst", "lower", "upper", 
            "CI")
    }
    names(forecasts) <- ynames
    result <- list(fcst = forecasts, endog = object$y, model = object, 
        exo.fcst = dumvar)
    class(result) <- "varprd"
    return(result)
}

Answer 2

また

• NULLにしたくない属性を設定する、または
• 必要なパーツを新しいオブジェクトにコピーするか、
• save()適切なインデックスを付けて関数を呼び出します。