enables writing of economic models, including two region

NAMESPACE

@@ -5,6 +5,7 @@ export(aggregateResultMatrix)
 export(aggregateResultMatrixbyRow)
 export(barplotFloworImpactFractionbyRegion)
 export(barplotIndicatorScoresbySector)
+export(buildIOModel)
 export(buildModel)
 export(buildTwoRegionModels)
 export(calculateEEIOModel)

R/BuildModel.R

@@ -285,12 +285,13 @@ buildTwoRegionModels <- function(modelname, configpaths = NULL, validate = FALSE
   return(model_ls)
 }
 
-#' Build an EIO model with economic components only.
+#' Build an IO model with economic components only.
 #' @param modelname Name of the model from a config file.
 #' @param configpaths str vector, paths (including file name) of model configuration file
 #' and optional agg/disagg configuration file(s). If NULL, built-in config files are used.
-#' @return A list of EIO model with only economic components
-buildEIOModel <- function(modelname, configpaths = NULL) {
+#' @return A list of IO model with only economic components
+#' @export
+buildIOModel <- function(modelname, configpaths = NULL) {
   model <- initializeModel(modelname, configpaths)
   model <- loadIOData(model, configpaths)
   model <- loadDemandVectors(model)
@@ -314,8 +315,14 @@ buildEIOModel <- function(modelname, configpaths = NULL) {
   colnames(model$U_d) <- colnames(model$U)
   model[c("U", "U_d")] <- lapply(model[c("U", "U_d")],
                                  function(x) ifelse(is.na(x), 0, x))
-  model$U_n <- generateDirectRequirementsfromUse(model, domestic = FALSE) #normalized Use
-  model$U_d_n <- generateDirectRequirementsfromUse(model, domestic = TRUE) #normalized DomesticUse
+
+  if (model$specs$IODataSource=="stateior") {
+    model$U_n <- generate2RDirectRequirementsfromUseWithTrade(model, domestic = FALSE)
+    model$U_d_n <- generate2RDirectRequirementsfromUseWithTrade(model, domestic = TRUE)
+  } else {
+    model$U_n <- generateDirectRequirementsfromUse(model, domestic = FALSE) #normalized Use
+    model$U_d_n <- generateDirectRequirementsfromUse(model, domestic = TRUE) #normalized DomesticUse  
+  }
   model$q <- model$CommodityOutput
   model$x <- model$IndustryOutput
   model$mu <- model$InternationalTradeAdjustment

R/StateiorFunctions.R

@@ -211,6 +211,11 @@ print2RValidationResults <- function(model) {
   printValidationResults(model)
   cat("\n")
 
+  if(is.null(model$B)) {
+    # Stop validation as no satellite tables
+    return()
+  }
+
   # Creating 2-R Production Complete demand vector
   f <- model$DemandVectors$vectors[endsWith(names(model$DemandVectors$vectors), "Production_Complete")][[1]]
   f <- (f + model$DemandVectors$vectors[endsWith(names(model$DemandVectors$vectors), "Production_Complete")][[2]])

R/ValidateModel.R

@@ -313,16 +313,18 @@ printValidationResults <- function(model) {
   print(paste("Number of sectors failing:",econval$N_Fail))
   print(paste("Sectors failing:", paste(unique(econval$Failure$rownames), collapse = ", ")))
 
-  print("Validate that flow totals by commodity (E_c) can be recalculated (within 1%) using the model satellite matrix (B), market shares matrix (V_n), total requirements matrix (L), and demand vector (y) for US production")
-  modelval <- compareEandLCIResult(model, tolerance = 0.01)
-  print(paste("Number of flow totals by commodity passing:",modelval$N_Pass))
-  print(paste("Number of flow totals by commodity failing:",modelval$N_Fail))
-
-  print("Validate that flow totals by commodity (E_c) can be recalculated (within 1%) using the model satellite matrix (B), market shares matrix (V_n), total domestic requirements matrix (L_d), and demand vector (y) for US production")
-  dom_val <- compareEandLCIResult(model, use_domestic=TRUE, tolerance = 0.01)
-  print(paste("Number of flow totals by commodity passing:",dom_val$N_Pass))
-  print(paste("Number of flow totals by commodity failing:",dom_val$N_Fail))
-  print(paste("Sectors with flow totals failing:", paste(unique(dom_val$Failure$variable), collapse = ", ")))  
+  if(!is.null(model$B)) {
+    print("Validate that flow totals by commodity (E_c) can be recalculated (within 1%) using the model satellite matrix (B), market shares matrix (V_n), total requirements matrix (L), and demand vector (y) for US production")
+    modelval <- compareEandLCIResult(model, tolerance = 0.01)
+    print(paste("Number of flow totals by commodity passing:",modelval$N_Pass))
+    print(paste("Number of flow totals by commodity failing:",modelval$N_Fail))
+
+    print("Validate that flow totals by commodity (E_c) can be recalculated (within 1%) using the model satellite matrix (B), market shares matrix (V_n), total domestic requirements matrix (L_d), and demand vector (y) for US production")
+    dom_val <- compareEandLCIResult(model, use_domestic=TRUE, tolerance = 0.01)
+    print(paste("Number of flow totals by commodity passing:",dom_val$N_Pass))
+    print(paste("Number of flow totals by commodity failing:",dom_val$N_Fail))
+    print(paste("Sectors with flow totals failing:", paste(unique(dom_val$Failure$variable), collapse = ", ")))  
+  }
 
   print("Validate that commodity output are properly transformed to industry output via MarketShare")
   q_x_val <- compareCommodityOutputXMarketShareandIndustryOutputwithCPITransformation(model, tolerance = 0.01)

R/WriteModel.R

@@ -84,6 +84,9 @@ writeModeltoXLSX <- function(model, outputfolder) {
   prepareWriteDirs(model, dirs)
   writeModelMetadata(model, dirs)
   metadata_tabs <- c("demands", "flows", "indicators", "sectors")
+  if(is.null(model$SatelliteTables)){
+    metadata_tabs <- metadata_tabs[metadata_tabs != "flows"]
+  }
   if(is.null(model$Indicators)){
     metadata_tabs <- metadata_tabs[metadata_tabs != "indicators"]
   }
@@ -269,17 +272,19 @@ writeModelMetadata <- function(model, dirs) {
   utils::write.csv(sectors, paste0(dirs$model, "/sectors.csv"), na = "",
                    row.names = FALSE, fileEncoding = "UTF-8")
 
-  # Write flows to csv
-  flows <- model$SatelliteTables$flows
-  flows$ID <- apply(flows[, c("Flowable", "Context", "Unit")], 1, FUN = joinStringswithSlashes)
-  names(flows)[names(flows) == 'FlowUUID'] <- 'UUID'
-  flows <- flows[order(flows$ID),]
-  flows$Index <- c(1:nrow(flows)-1)
-  flows <- flows[, fields$flows]
-  #checkNamesandOrdering(flows$ID, rownames(model$B),
-  #                      "flows in flows.csv and rows in B matrix")
-  utils::write.csv(flows, paste0(dirs$model, "/flows.csv"), na = "",
-                   row.names = FALSE, fileEncoding = "UTF-8")
+  if(!is.null(model$SatelliteTables)) {
+    # Write flows to csv
+    flows <- model$SatelliteTables$flows
+    flows$ID <- apply(flows[, c("Flowable", "Context", "Unit")], 1, FUN = joinStringswithSlashes)
+    names(flows)[names(flows) == 'FlowUUID'] <- 'UUID'
+    flows <- flows[order(flows$ID),]
+    flows$Index <- c(1:nrow(flows)-1)
+    flows <- flows[, fields$flows]
+    #checkNamesandOrdering(flows$ID, rownames(model$B),
+    #                      "flows in flows.csv and rows in B matrix")
+    utils::write.csv(flows, paste0(dirs$model, "/flows.csv"), na = "",
+                     row.names = FALSE, fileEncoding = "UTF-8")
+  }
 
   # Write years to csv
   years <- data.frame(ID=colnames(model$Rho), stringsAsFactors = FALSE)

tests/test_model_build.R

@@ -11,6 +11,12 @@ m <- "USEEIOv2.0.1-411"
 model <- buildModel(m)
 printValidationResults(model)
 
+## USEEIOv2.0.1-411 Detail model with waste disaggregation (Economic only)
+m <- "USEEIOv2.0.1-411"
+model <- buildIOModel(m)
+printValidationResults(model)
+writeModeltoXLSX(model, ".")
+
 ## USEEIOv2.0.1-i-411 Detail, industry model with waste disaggregation
 model <- useeior:::initializeModel(m)
 model$specs$Model <- "USEEIOv2.0.1-i-411"
@@ -113,3 +119,8 @@ m <- "GAEEIOv1.0-s-WAT-12"
 cfg <- paste0("modelspecs/", m, ".yml")
 model <- buildModel(m, configpaths = file.path(cfg))
 useeior::print2RValidationResults(model)
+
+## StateEEIOv1.0 Two-region Summary model
+model <- buildIOModel(m, configpaths = file.path(cfg))
+useeior::print2RValidationResults(model)
+writeModeltoXLSX(model, ".")