From 38ed94b98256dc866c50cdc140435c1db15a72ac Mon Sep 17 00:00:00 2001 From: jvendries Date: Thu, 16 Nov 2023 17:19:24 -0500 Subject: [PATCH] remove calculateAndValidateImportA function --- R/ValidateModel.R | 79 +++-------------------------------------------- 1 file changed, 5 insertions(+), 74 deletions(-) diff --git a/R/ValidateModel.R b/R/ValidateModel.R index 7d728547..19238eea 100644 --- a/R/ValidateModel.R +++ b/R/ValidateModel.R @@ -520,75 +520,6 @@ compareOutputfromMakeandUse <- function(model, output_type = "Commodity") { return(rel_diff) } -#' Create import direct requirements table based on import use and import y tables -#' @param model, An EEIO model object with model specs and crosswalk table loaded -#' @param y A final demand VECTOR used for calculating the conventional model results, L*Y -#' @param y_d A final demand VECTOR used for validating the model results using the A_m calculation. -#' @return A calculated direct requirements table -calculateAndValidateImportA <- function(model, y = NULL, y_d = NULL){ - - U_n_m <- model$U_n_m - A_m <- model$A_m - - - # Calculate production demand vector - FD_columns <- unlist(sapply(list("HouseholdDemand", "InvestmentDemand", - "ChangeInventories", "Export", "Import", - "GovernmentDemand"), - getVectorOfCodes, ioschema = model$specs$BaseIOSchema, - iolevel = model$specs$BaseIOLevel)) - FD_columns <- model$FinalDemandMeta$Code_Loc[which(model$FinalDemandMeta$Code %in% FD_columns)] #get the right column names, with location ids - - # calculate "standard" x - y <- rowSums(model$U[c(model$Commodities$Code_Loc),c(FD_columns)]) - x <- model$L %*% y # if y = I, then x = model$L. I <- diag(nrow(model$A)) - - # Calculate x as domestic + import components - y_m <- rowSums(model$ImportFinalDemand[,c(FD_columns)]) - y_d <- rowSums(model$DomesticFDWithITA[,c(FD_columns)]) - - x_d <- model$L_d %*% y_d - x_dm <- x_d + A_m%*%x_d + y_m - - - # Validate results - rel_dif_x <- (x-x_dm)/x_dm - failures <- compare2RVectorTotals(x_dm, x) - - - - # TODO: Move this to new function - testing adding environmental import factors - # Including the environmental components, S^d and Q^t, of the Swedish equation for import factors: f^(d+m) = S^d*L^d*y^d + Q^t*A^m*L^d*y^d + Q^t*y^m + f^h - # Since f^h is not currently part of the useeior model calculations, we drop it: - - # f^(d+m) = S^d*L^d*y^d + Q^t*A^m*L^d*y^d + Q^t*y^m (eq 1) - - # Note that: - # S^d = model$B, where model$B is used for both domestic and non-domestic calculations in the standard results calculations. - # L^d = model$L_d. - # y^d = y_d as defined in the code above - # Q^t = model$M. This is because the non-domestic L matrix in the M calculation (model$B %*% model$L) takes the place of the MRIO-based L matrix, - # even though the satellite table of environmental coefficients (B) is equivalent in this case. - # A^m = A_m as defined in the code above - # y^m = y_m as defined in the code above - - # Thus, Eq. 1 then becomes - - # f^(d+m) = model$B %*% model$L_d %*% y_d + model$M %*% A_m %*% model$L_d %*% y_d + model$M %*% y_m (eq 2) - - # "Standard" result calculation is model$B %*% model$L %*% y = model$M %*% y - cat("\n Calculating results (M matrix) using import A (A_m).\n") - standard_M <- model$M - result_Standard <- standard_M %*% y - M_m <- standard_M #Q^t = M_m = imported M matrix, which for validation purposes is equivalent to the current standard_M - result_M <- (model$B %*% model$L_d %*% y_d) + (M_m %*% A_m %*% model$L_d %*% y_d + M_m %*% y_m) # parentheses used to denote (domestic) and (import) components - - rel_dif_result <- (result_Standard - result_M)/result_M - result_failures <- compare2RVectorTotals(result_M, result_Standard) - -} - - #' Validate the results of the model build using the Import Factor approach (i.e., coupled model approach) #' @param model, An EEIO model object with model specs and crosswalk table loaded #' @param y A final demand VECTOR used for calculating the conventional model results, L*Y @@ -608,7 +539,7 @@ validateImportFactorsApproach <- function(model, y = NULL, y_d = NULL){ # Calculate Import final demand, y_m y_m <- as.matrix(rowSums(model$ImportMatrix[,FD_col_index])) - print("Testing that production final demand vector is equivalent between standard and coupled model approaches. I.e.: y = y_m + y_d") + cat("Testing that production final demand vector is equivalent between standard and coupled model approaches. I.e.: y = y_m + y_d.\n") print(all.equal(y, y_d+y_m)) @@ -621,8 +552,8 @@ validateImportFactorsApproach <- function(model, y = NULL, y_d = NULL){ x_dm <- (model$L_d %*% y_d) + (model$L %*% model$A_m %*% model$L_d %*% y_d + model$L %*% y_m) - print("Testing that economic throughput is equivalement between standard and coupled model approaches when using production final demand vector. - I.e.,: x = x_dm") + cat("Testing that economic throughput is equivalement between standard and coupled model approaches when using production final demand vector.\n") + cat("I.e.,: x = x_dm.\n") print(all.equal(x, x_dm)) @@ -636,8 +567,8 @@ validateImportFactorsApproach <- function(model, y = NULL, y_d = NULL){ LCI_dm <- (model$M_d %*% y_d) + (model$M %*% model$A_m %*% model$L_d %*% y_d + model$M %*% y_m) - print("Testing that environmental results are equivalemnt between standard and coupled model approaches (i.e., LCI = LCI_dm) when: - 1) using production final demand vector; 2) assuming model$M = model$M_m ") + cat("Testing that environmental results are equivalemnt between standard and coupled model approaches (i.e., LCI = LCI_dm) when:\n") + cat("1) using production final demand vector; 2) assuming model$M = model$M_m.\n") print(all.equal(LCI, LCI_dm))