Nothing
#' @title Solve a basic (matrix) equation
#'
#' @description The function matches to parts of the matrix equation, using the named
#' formats with row names and solves the matrix equation.
#'
#' @details This function is used in wrapper functions, such as \code{\link{multiplier_create}}.
#' to solve particular problems, but it can be used directly, too.
#' The function only performs the lhs %*% im matrix equation, but after
#' pairing industries and checking for exceptions.
#'
#' @param LHS A left-hand side vector with a key column containing the
#' industry or product names for matching, for example the employment coefficients.
#' @param Im A Leontief-inverse with a key column containing the industry or
#' product names for matching.
#' @importFrom dplyr select mutate mutate across full_join any_of
#' @return A data.frame with auxiliary metadata to conform the symmetric
#' input-output tables.
#' @examples
#' Im = data.frame (
#' a = c("row1", "row2"),
#' b = c(1,1),
#' c = c(2,0))
#' LHS = data.frame (
#' a = "lhs",
#' b = 1,
#' c = 0.5)
#' equation_solve (Im = Im, LHS = LHS)
#' @export
equation_solve <- function (LHS = NULL, Im = NULL) {
if (is.null(LHS) | is.null(Im)) stop (
"Error: matrix equation inputs are not given.")
LHS <- LHS %>%
mutate(across(where(is.factor), as.character))
Im <- Im %>%
mutate(across(where(is.factor), as.character))
if (ncol (Im) < ncol(LHS)) {
not_found <- names(LHS)[ which (! names(LHS) %in% names ( Im )) ]
if ( all ( not_found %in% c("CPA_T", "CPA_U", "CPA_L68A",
"TOTAL", "CPA_TOTAL"))) {
warning ( paste ( not_found, collapse = ','),
' from the input vector is removed. These are likely zero values,
and cannot be found in the Leontief-inverse.'
)
LHS <- dplyr::select ( LHS, -dplyr::any_of ( not_found ) )
} else if ( any( not_found %in% c("households", "P3_S14")) ) {
stop ("The input vector has households but the Leontief-inverse has not.")
} else {
stop ("Non conforming input vector and Leontief-inverse.")
}
}
###Joining matrixes to find out if all data is present ---------------------
names_lhs <- names(LHS)
names_Im <- names(Im)
names_lhs
names_Im
joined <- tryCatch(
full_join (LHS, Im, by = names(LHS)),
error = function(e) {
message ( "The technology columns are not matching.")
return (NULL)
}
)
if ( is.null(joined)) stop("Error: no result is returned.") #early termination if not
###Joining matrixes to find out if all data is present ---------------------
lhs <- joined[1,]
lhs <- as.numeric(lhs[1,2:ncol(lhs)]) #numeric left-hand side in conforming order
#lhs <- LHS[ ,which ( vapply(LHS,is.numeric, logical(1)))]
#lhs <- lhs %>% select ( any_of(names(Im))) %>% as.matrix()
im <- joined[2:nrow(joined),]
im <- as.matrix(im[,2:ncol(im)]) #numeric Leontief inverse in conforming order
#im <- Im[, which ( vapply(LHS,is.numeric, logical(1)))]
###Try to solve the matrix equation ---------------------
solution <- tryCatch(
lhs %*% im,
error = function(e) {
message ( "Violoation of the matrix operation.")
return (NULL)}
)
solution
} #end of function
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.