R/class_model.R

Defines functions gecon_model is.gecon_model list_eq list_calibr_eq get_index_sets re_solved ss_solved get_model_info

Documented in gecon_model get_index_sets get_model_info is.gecon_model list_calibr_eq list_eq re_solved ss_solved

# ############################################################################
# This file is a part of gEcon.                                              #
#                                                                            #
# (c) Chancellery of the Prime Minister of the Republic of Poland 2012-2015  #
# (c) Grzegorz Klima, Karol Podemski, Kaja Retkiewicz-Wijtiwiak 2015-2018    #
# License terms can be found in the file 'LICENCE'                           #
#                                                                            #
# Authors: Karol Podemski, Kaja Retkiewicz-Wijtiwiak                         #
# ############################################################################
# Class representing general equilibrium model
# ############################################################################


# ############################################################################
# Class to store Jacobian function or NULL value
# ############################################################################
setClassUnion("function_or_null", c("function", "NULL"))


# ############################################################################
# Class definition
# ############################################################################
setClass(
    Class = "gecon_model",
    representation = representation(
        # Info about the model
        model_info = "character",

        # Index sets
        index_sets = "list",

        # Parameters, variables, shocks
        parameters = "character",
        parameters_tex = "character",
        parameters_free = "character",
        map_free_into_params = "numeric",
        parameters_calibr = "character",
        map_calibr_into_params = "numeric",
        variables = "character",
        variables_tex = "character",
        shocks = "character",
        shocks_tex = "character",

        # Equations
        equations = "character",
        calibr_equations = "character",
        var_eq_map = "Matrix",
        shock_eq_map = "Matrix",
        var_ceq_map = "Matrix",
        cpar_eq_map = "Matrix",
        cpar_ceq_map = "Matrix",
        fpar_eq_map = "Matrix",
        fpar_ceq_map = "Matrix",

        # Model type
        is_stochastic = "logical",
        is_dynamic = "logical",
        is_calibrated = "logical",

        # Steady-state / equilibrium
        ss_function = "function",
        calibr_function = "function",
        ss_calibr_jac_function = "function_or_null",
        parameters_free_init_val = "vector",
        parameters_free_val = "vector",
        parameters_free_mod_flag = "logical",
        parameters_calibr_val = "numeric",

        # Steady-state / equilibrium solution
        init_residual_vector = "numeric",
        residual_vector = "numeric",
        solver_status = "character",
        parameters_val = "numeric",
        variables_ss_val = "numeric",
        ss_solved = "logical",

        # 1st order perturbation
        pert = "function",
        loglin_var = "logical",

        # Solution to 1st order perturbation
        eig_vals = "matrix",
        solution = "list",
        state_var_indices = "numeric",
        solver_exit_info = "character",
        solution_resid = "list",
        re_solved = "logical",

        # Stochastic simulation
        active_shocks = "logical",
        shock_cov_mat = "matrix",
        shock_cov_mat_flag = "logical",
        corr_mat = "matrix",
        autocorr_mat = "matrix",
        ref_var_corr_mat = "matrix",
        ref_var_idx = "integer",
        var_dec = "matrix",
        sdev = "matrix",
        corr_computed = "logical"
    ) ,
    prototype = prototype(
        parameters = character(0),
        variables = character(0),
        shocks = character(0),
        ref_var_idx = 0L,
        solution_resid = list(),
        ss_solved = FALSE,
        init_residual_vector = numeric(0),
        residual_vector = numeric(0),
        pert = function(x) NULL,
        corr_computed = FALSE,
        loglin_var = logical(0),
        is_calibrated = TRUE,
        re_solved = FALSE,
        is_dynamic = FALSE,
        is_stochastic = TRUE,
        shock_cov_mat_flag = FALSE,
        solution = list(P = NULL,
                        Q = NULL,
                        R = NULL,
                        S = NULL)
    )
)

# ############################################################################
# The gecon_model function is a constructor of the class gecon_model
# ############################################################################
# Input
#   model_info - [character vector, length = 3] information about
#                   model: input file name, file path and the date of creation
#   index_sets - [list] each of the list components corresponds to one
#                 set specified in gecon model class. Each components stores
#                 all the elements in the set.
#   variables - [character vector] of all variable names
#   variables_tex - [character vector] of all variable LaTeX names
#   shocks - [character vector]  of all shock names
#   shocks_tex - [character vector]  of all shock LaTeX names
#   parameters - [character vector] of all parameter names
#   parameters_tex - [character vector] of all parameter LaTeX names
#   parameters_free - [character vector] of all free parameter names
#   parameters_free_val - [numeric vector] values of free parameters
#   equations - [character vector] of all the model equations
#   calibr_equations - [character vector] of all calibrating equations
#   var_eq_map - [(sparse) Matrix class] the mapping of variables
#                to equations
#   shock_eq_map - [(sparse) Matrix class] the mapping of shocks
#                  to equations
#   var_ceq_map - [sparse Matrix class] the mapping of variables
#                  to calibrating equations.
#   cpar_eq_map - [sparse Matrix class] the mapping of calibrated
#                  parameters to equations.
#   cpar_ceq_map - [sparse Matrix class] the mapping of calibrated
#                   parameters to calibrating equations.
#   fpar_eq_map - [sparse Matrix class] the mapping of free
#                  parameters to equations.
#   fpar_ceq_map - [sparse Matrix class] the mapping of free
#                   parameters to calibrating equations.
#   ss_function - [function] function returning residuals of steady state equations
#   calibr_function - [function] a function used for calibration of variables
#   ss_calibr_jac_function - [function or NULL] Jacobian of system
#                             of functions defining steady state
#                             a dynamic model or equilibrium
#                             in a static model
#                             and calibration equations
#   pert - [function] the function returning perturbation matrices.
#
# Output
#   An object of class "gecon_model"
# ############################################################################
gecon_model <- function(model_info,
                        index_sets,
                        variables,
                        variables_tex,
                        shocks,
                        shocks_tex,
                        parameters,
                        parameters_tex,
                        parameters_free,
                        parameters_free_val,
                        equations,
                        calibr_equations,
                        var_eq_map,
                        shock_eq_map,
                        var_ceq_map,
                        cpar_eq_map,
                        cpar_ceq_map,
                        fpar_eq_map,
                        fpar_ceq_map,
                        ss_function,
                        calibr_function,
                        ss_calibr_jac_function,
                        pert)
{
    mod <- new("gecon_model")

    if (!is.character(model_info)) {
        stop("model_info should be of character type")
    } else {
        mod@model_info <- model_info
        names(mod@model_info) <- c("Model name", "Source .gcn file", "Generated")
    }

    if (!is.list(index_sets)) {
        stop("index_sets must be a list of sets (character vectors)")
    } else mod@index_sets <- index_sets

    if (!is.character(variables)) {
        stop("variables should be of character type")
    } else mod@variables <- variables

    if (!is.character(variables_tex)) {
        stop("variables_tex should be of character type")
    } else mod@variables_tex <- variables_tex

    if (!is.character(shocks)) {
        stop("shocks should be of character type")
    } else mod@shocks <- shocks

    if (!is.character(shocks_tex)) {
        stop("shocks_tex should be of character type")
    } else mod@shocks_tex <- shocks_tex

    if (!is.character(parameters)) {
        stop("parameters should be of character type")
    } else mod@parameters <- parameters

    if (!is.character(parameters_tex)) {
        stop("parameters_tex should be of character type")
    } else mod@parameters_tex <- parameters_tex

    if (!is.character(parameters_free)) {
        stop("parameters_free should be of character type")
    } else mod@parameters_free <- parameters_free

    mod@parameters_calibr <-
        parameters[-which(parameters %in% parameters_free)]

    if (!is.logical(parameters_free_val) & !is.numeric(parameters_free_val)) {
        stop("parameters_free_val should be a numeric or logical vector")
    } else {
        mod@parameters_free_val <- as.numeric(parameters_free_val)
        mod@parameters_free_init_val <- as.numeric(parameters_free_val)
    }

    if (!is.character(equations)) {
        stop("equations should be of character type")
    } else mod@equations <- equations

    if (!is.character(calibr_equations)) {
        stop("calibr_equations should be of character type")
    } else mod@calibr_equations <- calibr_equations

    if (!inherits(var_eq_map, "Matrix")) {
        stop("var_eq_map should be of Matrix class")
    } else mod@var_eq_map <- var_eq_map

    if (!inherits(shock_eq_map, "Matrix")) {
        stop("shock_eq_map should be of Matrix class")
    } else mod@shock_eq_map <- shock_eq_map

    if (!inherits(var_ceq_map, "Matrix")) {
        stop("var_ceq_map should be of Matrix class")
    } else mod@var_ceq_map <- var_ceq_map

    if (!inherits(cpar_eq_map, "Matrix")) {
        stop("cpar_eq_map should be of Matrix class")
    } else mod@cpar_eq_map <- cpar_eq_map

    if (!inherits(cpar_ceq_map, "Matrix")) {
        stop("cpar_ceq_map should be of Matrix class")
    } else mod@cpar_ceq_map <- cpar_ceq_map

    if (!inherits(fpar_eq_map, "Matrix")) {
        stop("fpar_eq_map should be of Matrix class")
    } else mod@fpar_eq_map <- fpar_eq_map

    if (!inherits(fpar_ceq_map, "Matrix")) {
        stop("fpar_ceq_map should be of Matrix class")
    } else mod@fpar_ceq_map <- fpar_ceq_map

    if (!is.function(ss_function)) {
        stop("ss_function should be a function")
    } else mod@ss_function <- ss_function

    if (!is.function(calibr_function)) {
        stop("calibr_function should be a function")
    } else mod@calibr_function <- calibr_function

    if (!is.function(ss_calibr_jac_function) & !is.null(ss_calibr_jac_function)) {
        stop("ss_calibr_jac_function should be a function or a NULL value")
    } else mod@ss_calibr_jac_function <- ss_calibr_jac_function

    if (!is.function(pert)) {
        stop("pert should be a function")
    } else mod@pert <- pert

    if (length(parameters) == length(parameters_free)) {
        mod@is_calibrated <- FALSE
    }

    if (!length(shock_eq_map))
        mod@is_stochastic <- FALSE

    if (mod@is_stochastic) {
        mod@active_shocks <- rep(TRUE, length(mod@shocks))
        mod@shock_cov_mat <- diag(length(mod@shocks))
    }

    if (any((var_eq_map != 2) & (var_eq_map != 0))) {
        mod@is_dynamic <- TRUE
    }

    mod@variables_ss_val <- as.numeric(rep(NA, length(mod@variables)))
    mod@parameters_calibr_val <- as.numeric(rep(NA, length(mod@parameters_calibr)))
    mod@parameters_free_mod_flag <- rep(FALSE, length(mod@parameters_free))
    mod@map_free_into_params <- match(mod@parameters_free, mod@parameters)
    mod@map_calibr_into_params <- match(mod@parameters_calibr, mod@parameters)
    mod@parameters_val[mod@map_free_into_params] <- mod@parameters_free_val

    return(mod)
}

# ############################################################################
# The is.gecon_model function checks if given object
# is of class "gecon_model"
# ############################################################################
# Input
#   x - any R object
# Output
#   Logical value indicating if object is of class "gecon_model"
# ############################################################################
is.gecon_model <- function(x)
{
    if (is(x, "gecon_model")) return(TRUE)
    return(FALSE)
}



# ############################################################################
# Function list_eq returns equations with specified indices
# ############################################################################
# Input
#   model - object of gecon_model class
#   eq_idx -  indices of equations to be returned
# Output
#   character matrix - equations with given indices
# ############################################################################
list_eq <- function(model, eq_idx = NULL)
{
    if (!is.gecon_model(model)) {
        stop("model argument should be of gecon_model class")
    }

    if (is.null(eq_idx)) {
        eq_idx <- (1:length(model@equations))
    }

    if (any(eq_idx < 1 | eq_idx > length(model@equations))) {
        stop("invalid equation index")
    }

    eq <- matrix(model@equations[eq_idx], length(eq_idx), 1)
    rownames(eq) <- paste0("Eq. ", eq_idx, ": ")
    colnames(eq) <- ""

    return(eq)
}

# ############################################################################
# Function list_calibr_eq returns calibrating equations with specified indices
# ############################################################################
# Input
#   model - object of gecon_model class
#   eq_idx -  indices of equations to be returned
# Output
#   character matrix - calibrating equations with given indices
# ############################################################################
list_calibr_eq <- function(model, eq_idx = NULL)
{
    if (!is.gecon_model(model)) {
        stop("model argument should be of gecon_model class")
    }

    if (is.null(eq_idx)) {
        if (!length(model@calibr_equations))
            stop("the model has no calibrating equations")
        eq_idx <- (1:length(model@calibr_equations))
    }

    if (any(eq_idx < 1 | eq_idx > length(model@calibr_equations))) {
        stop("invalid calibrating equation index")
    }

    eq <- matrix(model@calibr_equations[eq_idx], length(eq_idx), 1)
    rownames(eq) <- paste0("Calibr. Eq. ", eq_idx, ": ")
    colnames(eq) <- ""

    return(eq)
}



# ############################################################################
# The get_index_sets function allows to retrieve a list with
# the index sets from an object of gecon_model class
# ############################################################################
# Input
#   model - object of the gecon_model class.
# Output
#   list with index sets specified for the model.
# ############################################################################
get_index_sets <- function(model)
{
    if (!is.gecon_model(model))
        stop("model argument should be of gecon_model class")

    if (!length(model@index_sets))
        stop("no index sets have been specified")

    return(model@index_sets)
}


# ############################################################################
# The re_solved function returns a logical value indicating
# if the perturbation has been solved.
# ############################################################################
# Input
#   model - object of the gecon_model class.
# Output
#   Logical value. If TRUE, the model has been solved.
# ############################################################################
re_solved <- function(model)
{
    if (!is.gecon_model(model))
        stop("model argument should be of gecon_model class")

    return(model@re_solved)
}


# ############################################################################
# The ss_solved function returns a logical value indicating
# if the steady state (equilibrium) for the model has been found.
# ############################################################################
# Input
#   model - object of the gecon_model class.
# Output
#   Logical value. If TRUE, the steady state (equilibrium)
#   for the model has been found.
# ############################################################################
ss_solved <- function(model)
{
    if (!is.gecon_model(model))
        stop("model argument should be of gecon_model class")

    return(model@ss_solved)
}


# ############################################################################
# The get_model_info function returns a character vector
# with information about the model.
# ############################################################################
# Input
#   model - object of the gecon_model class.
# Output
#   character vector of length 3, containing information
#   about the model: the input file name, the input file path,
#   and the date of creation.
# ############################################################################
get_model_info <- function(model)
{
    if (!is.gecon_model(model))
        stop("model argument should be of gecon_model class")

    return(model@model_info)
}




# ########################ja####################################################
# The show method controls how object of class gecon_model is printed
# ############################################################################
# Input
#   object - an object of class gecon_model
# Output
#   None
# ############################################################################
setMethod("show", signature(object = "gecon_model"),
function(object)
{
    if (!is.gecon_model(object)) {
        stop("argument should be of gecon_model class")
    }
    model_name <- object@model_info[1]
    no_var <- length(object@variables)
    no_shocks <- length(object@shocks)
    no_par <- length(object@parameters)
    no_par_mod <- sum(object@parameters_free_mod_flag)
    no_calibr_par <- length(object@parameters_calibr)
    no_state <- length(object@state_var_indices)

#     cat("\n")
    if (!object@is_dynamic) {
        cat("\'", model_name, "\' is a static model.\n\n", sep = "")
    } else if (object@is_stochastic) {
        cat("\'", model_name, "\' is a dynamic, stochastic model.\n\n", sep = "")
    } else {
        cat("\'", model_name, "\' is a dynamic, deterministic model.\n\n", sep = "")
    }

    cat("Generated ", object@model_info[3], " from \'", add_gcn_ext(object@model_info[2]),
        "\'.\n\n", sep = "")

    if (object@is_dynamic)
        cat("Steady-state values of variables have ")
    else
        cat("Equilibrium has ")
    if (object@ss_solved) {
        cat("been FOUND.\n")
    } else {
        cat("NOT been FOUND.\n")
    }

    if (length(object@calibr_equations)) {
        if (object@is_calibrated && object@ss_solved) {
            if (object@is_dynamic) {
                cat("Calibrating equations have been taken",
                    "into account when solving for the steady state.\n")
            } else {
                cat("Calibrating equations have been taken",
                    "into account when solving for the equilibrium.\n")
            }
        } else if (!object@is_calibrated && object@ss_solved) {
            if (object@is_dynamic) {
                cat("Calibrating equations have not been taken",
                    "into account when solving for the steady state.\n")
            } else {
                cat("Calibrating equations have not been taken",
                    "into account when solving for the equilibrium.\n")
            }
        }
    }

    if (object@re_solved) {
        cat("The (log-)linearised version of the model has been SOLVED.\n")
    } else if (object@is_dynamic) {
        cat("The model in its (log-)linearised form has NOT been SOLVED.\n")
    } else {
        cat("\n")
    }

    if (object@corr_computed) {
        cat("Correlations have been COMPUTED.\n\n")
    } else if(object@is_stochastic) {
            cat("Correlations have NOT been COMPUTED.\n\n")
    }

    cat("Number of variables:", no_var, "\n")
    if (no_par) {
        cat("Number of parameters:", no_par, "\n")
    }
    if (no_calibr_par) {
        cat("Number of calibrated parameters:", no_calibr_par, "\n")
    }
    if (object@is_stochastic) {
        cat("Number of stochastic shocks:", no_shocks, "\n")
    }
    if (object@is_dynamic) {
        cat("Number of state variables: ")
        if (object@re_solved) {
            cat(no_state, "\n")
        } else {
            cat("?\n")
        }
    }
#     cat("\n")
})


# ############################################################################
# The print method prints basic information and diagnostics of
# gecon_model objects
# ############################################################################
# Input
#   x - an object of class gecon_model
# Output
#   None
# ############################################################################
setMethod("print", signature(x = "gecon_model"),
function(x)
{
    if (!is.gecon_model(x)) {
        stop("argument should be of gecon_model class")
    }
    object <- x

    # model_name <- deparse(substitute(x))
    model_name <- object@model_info[1]
    no_var <- length(object@variables)
    no_shocks <- length(object@shocks)
    no_par <- length(object@parameters)
    no_par_mod <- sum(object@parameters_free_mod_flag)
    no_calibr_par <- length(object@parameters_calibr)
    no_state <- length(object@state_var_indices)
    variables <- object@variables
    calibr_parameters <- object@parameters_calibr
    shocks <- object@shocks
    parameters <- object@parameters
    parameters_modified <-
        object@parameters_free[object@parameters_free_mod_flag]
    state_variables <-
        object@variables[object@state_var_indices]

#     cat("\n")
    if (!object@is_dynamic) {
        cat("\'", model_name, "\' is a static model.\n\n", sep = "")
    } else if (object@is_stochastic) {
        cat("\'", model_name, "\' is a dynamic, stochastic model.\n\n", sep = "")
    } else {
        cat("\'", model_name, "\' is a dynamic, deterministic model.\n\n", sep = "")
    }

    cat("Generated ", object@model_info[3], " from \'", add_gcn_ext(object@model_info[2]),
        "\'.\n\n", sep = "")

    if (object@is_dynamic) {
        cat("Steady-state values of variables have ")
    } else {
        cat("Equilibrium has ")
    }
    if (object@ss_solved) {
        cat("been FOUND.\n")
    } else {
        cat("NOT been FOUND.\n")
    }

    if (length(object@calibr_equations)) {
        if (object@is_calibrated && object@ss_solved) {
            if (object@is_dynamic) {
                cat("Calibrating equations have been taken \n")
                cat("into account when solving for the steady state. \n")
            } else {
                cat("Calibrating equations have been taken \n")
                cat("into account when solving for the equilibrium. \n")
            }
        } else if (!object@is_calibrated && object@ss_solved) {
            if (object@is_dynamic) {
                cat("Calibrating equations have not been taken \n")
                cat("into account when solving for the steady state. \n")
            } else {
                cat("Calibrating equations have not been taken \n")
                cat("into account when solving for the equilibrium. \n")
            }
        }
    }

    if (object@re_solved) {
        cat("The (log-)linearised version of the model has been SOLVED.\n")
    } else if (object@is_dynamic) {
            cat("The model in its (log-)linearised form has NOT been SOLVED.\n")
    } else {
        cat("\n")
    }

    if (object@corr_computed) {
        if (object@ref_var_idx) {
            cat(paste0("Correlations have been COMPUTED (with ",
                       object@variables[object@ref_var_idx],
                       " as the reference variable).\n"))
        } else {
            cat("Correlations have been COMPUTED.\n")
        }
    } else {
        if (object@is_stochastic) {
            cat("Correlations have NOT been COMPUTED.\n")
        }
    }

    cat("\n")
    cat(paste0("Variables (", no_var, "):\n"))
    cat(list2str2(variables))
    cat("\n")

    if (no_par) {
        cat(paste0("Parameters (", no_par, "):\n"))
        cat(list2str2(parameters))
        cat("\n")
    }

    if(no_par_mod) {
        cat(paste0("Parameters whose values have been modified at R level (", no_par_mod, "):\n"))
        cat(list2str2(parameters_modified))
        cat("\n")
    }

    if (no_calibr_par) {
        cat(paste0("Calibrated parameters (", no_calibr_par, "):\n"))
        cat(list2str2(calibr_parameters))
        cat("\n")
    }

    if (object@re_solved) {
        if (no_state) {
            cat(paste0("State variables (", no_state, "):\n"))
            cat(list2str2(state_variables))
            cat("\n")
        } else {
            cat("The are NO STATE VARIABLES in the model.",
                "Solution matrices are empty.\n")
        }
    } else if (object@is_dynamic) {
            cat("In order to identify state variables you have to solve",
                "the model in its (log-)linearised form first.\n")
    }

    if (no_shocks) {
        cat(paste0("Stochastic shocks (", no_shocks, "):\n"))
        cat(list2str2(shocks))
        cat("\n")
    }

    cat("\n")
})


# ############################################################################
# The summary method prints and returns the summary of model solution
# ############################################################################
# Input
#   object - an object of class gecon_model
# Output
#   Summary of model solution
# ############################################################################
setMethod("summary", signature(object = "gecon_model"),
function (object)
{
    if (!is.gecon_model(object)) {
        stop("argument should be of gecon_model class");
    }
    if (!object@ss_solved) {
        cat("Model has NOT been SOLVED.\n")
        return(invisible())
    }
    if (object@is_dynamic) {
        cat("\nSteady state:\n")
    } else {
        cat("\nEquilibrium:\n")
    }
    cat_ss <- as.data.frame(object@variables_ss_val)
    colnames(cat_ss) <- c("")
    rownames(cat_ss) <- object@variables
    print(round(cat_ss, digits = 6))

    if (length(object@parameters_val)) {
        cat("\n----------------------------------------------------------\n")
        cat("\nParameter values:\n")
        cat_par <- as.data.frame(object@parameters_val)
        colnames(cat_par) <- c("")
        rownames(cat_par) <- object@parameters
        print(cat_par)
    }

    if (object@is_dynamic) {
        cat("\n----------------------------------------------------------\n")
    } else {
        return(invisible())
    }

    if (!object@re_solved) {
        cat("\nThe model in its (log-)linearised form has NOT been SOLVED.\n\n")
        if (length(object@solver_exit_info)) {
            cat("Solver exit infomation:\n", object@solver_exit_info, "\n", sep = "")
        }
        return(invisible())
    }

    if (!length(object@state_var_indices)) {
        cat("The are NO STATE VARIABLES in the model.",
            "Solution matrices are empty.\n")
        return(invisible())
    }

    cat("\nLinearisation:\n")
    cat("x_t = P x_{t-1} + Q epsilon_t\n")
    cat("y_t = R x_{t-1} + S epsilon_t\n")

    cat("\nP:\n")
    print(round(object@solution$P, digits = 6))

    if (object@is_stochastic) {
        cat("\nQ:\n")
        print(round(object@solution$Q, digits = 6))
    }

    cat("\nR:\n")
    print(round(object@solution$R, digits = 6))

    if (object@is_stochastic) {
        cat("\nS:\n")
        print(round(object@solution$S, digits = 6))
    }

    if (object@is_stochastic) {
        cat("\n----------------------------------------------------------\n")
    } else {
        return(invisible())
    }

    cat("\nShock covariance matrix:\n\n")
    rownames(object@shock_cov_mat) <- object@shocks
    colnames(object@shock_cov_mat) <- object@shocks
    print(object@shock_cov_mat)

    if (!object@corr_computed) {
        cat("\nCorrelations have NOT been COMPUTED.\n\n")
        return(invisible())
    }

    cat("\nBasic statistics:\n\n")
    loglin_indic <- rep("Y   ", length(object@loglin_var))
    loglin_indic[which(!object@loglin_var)] <- "N   "
    cat_mom <- round(cbind(object@variables_ss_val,  object@sdev, object@sdev ^ 2), digits = 4)
    cat_mom <- as.data.frame(cbind(cat_mom, loglin_indic))
    rownames(cat_mom) <- object@variables
    colnames(cat_mom) <- c("Steady-state value", "Std. dev.", " Variance", "Loglin")
    print(cat_mom)

    nzind <- which(object@sdev != 0)

    cat("\nCorrelation matrix:\n\n")
    cat_corrm <- object@corr_mat[nzind, nzind]
    cat_corrm <- as.data.frame(cat_corrm)
    N <- length(nzind)
    for (j in (1:N)) {
        cat_corrm[, j] <- as.character(round(cat_corrm[, j], digits = 3))
        if (j < N) {
            for (i in ((j + 1):N)) {
                cat_corrm[i, j] <- ""
            }
        }
    }
    print(cat_corrm)

    cat("\nAutocorrelations:\n\n")
    print(round(object@autocorr_mat[nzind, ], digits = 3))

    if (object@ref_var_idx) {
        cat(paste0("\nCross correlations with reference variable (",
                   object@variables[object@ref_var_idx], "):\n\n"))
        print(round(object@ref_var_corr_mat[nzind, ], digits = 3))
    }
    cat("\n")

    if (dim(object@var_dec)[2]) {
        cat("Variance decomposition:\n\n")
        cat_vd <- object@var_dec[nzind, ]
        dim(cat_vd) <- c(length(nzind), dim(object@var_dec)[2])
        colnames(cat_vd) <- colnames(object@var_dec)
        rownames(cat_vd) <- rownames(object@var_dec)[nzind]
        print(round(cat_vd, digits = 3))
        cat("\n")
    }
})

Try the gEcon package in your browser

Any scripts or data that you put into this service are public.

gEcon documentation built on May 2, 2019, 6:52 p.m.