initial draft of dqi approach

Author: bl-young

R/BuildModel.R

@@ -33,6 +33,7 @@ constructEEIOMatrices <- function(model, configpaths = NULL) {
   # Generate B matrix
   logging::loginfo("Building B matrix (direct emissions and resource use per dollar)...")
   model$B <- createBfromFlowDataandOutput(model)
+  model$B_dqi <- createB_dqi(model)
   B_h <- standardizeandcastSatelliteTable(model$CbS, model, final_demand=TRUE)
   if(!is.null(B_h)) {
     model$B_h <- as.matrix(B_h)
@@ -48,6 +49,7 @@ constructEEIOMatrices <- function(model, configpaths = NULL) {
     # Add direct impact matrix
     logging::loginfo("Calculating D matrix (direct environmental impacts per dollar)...")
     model$D <- model$C %*% model$B
+    model$D_dqi <- (model$C %*% (model$B * model$B_dqi)) / model$D
   }
 
   model <- buildPriceMatrices(model)
@@ -61,6 +63,7 @@ constructEEIOMatrices <- function(model, configpaths = NULL) {
     # Calculate total emissions/resource use per dollar (M)
     logging::loginfo("Calculating M matrix (total emissions and resource use per dollar)...")
     model$M <- model$B %*% model$L
+    model$M_dqi <- ((model$B * model$B_dqi) %*% model$L) / model$M
 
     colnames(model$M) <- colnames(model$M)
     # Calculate M_d, the domestic emissions per dollar using domestic Leontief
@@ -73,6 +76,7 @@ constructEEIOMatrices <- function(model, configpaths = NULL) {
     if(!is.null(model$M)) {
       logging::loginfo("Calculating N matrix (total environmental impacts per dollar)...")
       model$N <- model$C %*% model$M
+      model$N_dqi <- ((model$D * model$D_dqi) %*% model$L) / model$N
     }
     if(!is.null(model$M_m)) {
       logging::loginfo("Calculating N_m matrix (total environmental impacts per dollar from imported activity)...")

R/DataQualityFunctions.R

@@ -93,3 +93,27 @@ scoreTemporalDQ <- function(data_year,target_year=NA, scoring_bounds) {
   score <- lookupDQBoundScore(age, "TemporalCorrelation", scoring_bounds) 
   return(score)
 }
+
+createB_dqi <- function(model) {
+  # modeled from standardizeandcastSatelliteTable()
+  df <- model$TbS
+  df[, "Sector"] <- apply(df[, c("Sector", "Location")],
+                          1, FUN = joinStringswithSlashes)
+  # Cast df into a flow x sector matrix
+  df_cast <- reshape2::dcast(df, Flow ~ Sector, fun.aggregate = sum, value.var = "TemporalCorrelation")
+  # Move Flow to rowname so matrix is all numbers
+  rownames(df_cast) <- df_cast$Flow
+  df_cast$Flow <- NULL
+  df_cast[, setdiff(model$Industries$Code_Loc, colnames(df_cast))] <- 0
+  # Adjust column order to be the same with V_n rownames
+  df_cast <- df_cast[, model$Industries$Code_Loc]
+  dqi <- as.matrix(df_cast)
+  
+  # Need to Transform into a flow x commodity matrix using market shares matrix for commodity models
+  # see createBfromFlowDataandOutput()
+  
+  # array(combined_vector, dim = c(5, 5, 5))
+  
+  
+  return(dqi)
+}