-
Notifications
You must be signed in to change notification settings - Fork 9
/
Copy pathinput_multipliers_create.R
88 lines (69 loc) · 3.32 KB
/
input_multipliers_create.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
#' @title Create input multipliers
#'
#' @description The function creates the multipliers (direct + indirect effects).
#' @param input_requirements A matrix or vector created by
#' \code{\link{input_indicator_create}}
#' @param Im A Leontief-inverse created by \code{\link{leontief_inverse_create}}.
#' @param multiplier_name An optional name to be placed in the key column of the multiplier.
#' Defaults to \code{NULL}.
#' @param digits Rounding digits, defaults to \code{NULL}, in which case
#' no rounding takes place. Rounding is important if you replicate examples from the literature,
#' rounding differences can add up to visible differences in matrix equations.
#' @importFrom dplyr select mutate across
#' @return A data frame with the vector of multipliers and the an
#' auxiliary metadata column, containing an automatically given row identifier (for joining with other matrixes)
#' which can be overruled with setting \code{multiplier_name}.
#' @family multiplier functions
#' @examples
#' nl <- netherlands_2006
#'
#' input_coeff_nl <- input_coefficient_matrix_create(
#' data_table = netherlands_2006,
#' households = FALSE)
#'
#' compensation_indicator <- input_indicator_create(netherlands_2006, 'compensation_employees')
#'
#' I_nl <- leontief_inverse_create(input_coeff_nl)
#'
#' input_multipliers_create(input_requirements = compensation_indicator,
#' Im = I_nl)
#' @export
input_multipliers_create <- function ( input_requirements,
Im,
multiplier_name = NULL,
digits = NULL) {
names_direct <- names (input_requirements)
if (is.null(multiplier_name)) {
multiplier_name <- gsub("_coefficients|_coefficient|_effect",
"_multiplier",
unlist(input_requirements[1]))
}
new_key_column <- key_column_create(names(Im)[1], multiplier_name)
col_n <- ncol(input_requirements)
#columns of the left matrix must be the same as the number of rows of
#the right matrix
#Remove key column------
key_column <- subset ( input_requirements, select = 1)
input_requirements_matrix <- input_requirements[,-1]
inverse <- Im[, -1]
if(! all(names(input_requirements_matrix) %in% names(inverse))) {
mismatch_1 <- names(input_requirements_matrix)[which(!names(input_requirements_matrix) %in% names(inverse))]
mismatch_2 <- names(inverse)[which(!names(inverse) %in% names(input_requirements_matrix))]
stop("input_multipliers_create() error. Non-conforming matrixes: ", paste0(mismatch_1, mismatch_2),
" is not present in both input_requirements and Im.")
}
inverse <- as.matrix ( inverse )
input_requirements_matrix <- as.matrix ( input_requirements_matrix )
effects <- input_requirements_matrix %*% inverse
multipliers <- effects
for ( i in seq_len(nrow(effects))) {
multipliers[i, ] <- effects[i, ] / input_requirements_matrix[i,]
}
## Rounding is important when you compare with peer-reviewed literature sources.
## You want the same rounding to be able to replicate the results.
if ( !is.null(digits) ) {
if ( digits>=0 )
multipliers <- round ( multipliers, digits )
}
cbind (new_key_column, multipliers)
}