-
Notifications
You must be signed in to change notification settings - Fork 9
/
Copy pathindirect_effects_create.R
67 lines (55 loc) · 2.35 KB
/
indirect_effects_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
#' @title Create indirect effects
#'
#' @description The function creates the indirect effects vector.
#' @param input_requirements A matrix or vector created by
#' \code{\link{input_indicator_create}}
#' @param inverse A Leontief-inverse created by \code{\link{leontief_inverse_create}}.
#' @param digits Rounding digits, defaults to \code{NULL}, in which case
#' no rounding takes place.
#' @importFrom dplyr select mutate across
#' @return A data.frame containing the indirect effects and the necessary
#' metadata to sort them or join them with other matrixes.
#' @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)
#'
#' indirect_effects_create(input_requirements = compensation_indicator,
#' inverse = I_nl)
#' @export
indirect_effects_create <- function ( input_requirements,
inverse,
digits = NULL) {
names_direct <- names(input_requirements)
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)
new_key_column <- gsub(pattern ="_indicator", replacement = "", key_column[,1])
new_key_column <- paste0(new_key_column, "_indirect_effect")
new_key_column <- data.frame( key_colum = as.character(key_column))
names(new_key_column)[1] <- names(input_requirements)[1]
input_requirements_matrix <- input_requirements[,-1]
inverse <- inverse[, -1]
inverse <- as.matrix ( inverse )
input_requirements_matrix <- as.matrix ( input_requirements_matrix )
effects <- input_requirements_matrix %*% inverse
multipliers <- effects
indirect_effects <- effects
for ( i in seq_len(nrow(effects))) {
multipliers[i, ] <- effects[i, ] / input_requirements_matrix[i,]
indirect_effects[i, ] <- multipliers[i,] - effects[i,]
}
if ( !is.null(digits)) {
if ( digits>=0 )
multipliers <- round ( indirect_effects, digits )
}
cbind (new_key_column, indirect_effects)
}