USEPA · MoLi7 · Nov 4, 2021 · Oct 22, 2021 · Oct 25, 2021 · Oct 26, 2021
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -3,3 +3,4 @@
 ^data-raw$
 ^build-scripts$
 ^examples$
+^inst/doc$
diff --git a/R/CompareModels.R b/R/CompareModels.R
@@ -1,17 +1,24 @@
 # Functions for comparing models
 
 #' Compare flow totals for two models
-#' @param modelA, a useeior model
+#' @param modelA a useeior model
 #' @param modelB a useeior model 
-#' @return comparison, a list with pass/fail comparison results
+#' @return a list with pass/fail comparison results
 #' @export
 compareFlowTotals <- function(modelA, modelB) {
   # Get flow totals for each model
   A <- groupandsumTbSbyFlowLoc(modelA$TbS)
   B <- groupandsumTbSbyFlowLoc(modelB$TbS)
   # Generate a comparison to see if flow totals from two models are within 1%
-  rel_diff <- (A - B)/B
+  A_B <- merge(A, B, by = 0, all = TRUE)
+  rel_diff <- (A_B$FlowAmount.x - A_B$FlowAmount.y)/A_B$FlowAmount.y
   comparison <- formatValidationResult(rel_diff, abs_diff = TRUE, tolerance = 0.01)
+  # Report flow difference in models
+  comparison[["FlowDifference"]] <- list(setdiff(rownames(A), rownames(B)),
+                                         setdiff(rownames(B), rownames(A)))
+  names(comparison[["FlowDifference"]]) <- c(paste("Flows in", modelA$specs$Model, "not in", modelB$specs$Model),
+                                             paste("Flows in", modelB$specs$Model, "not in", modelA$specs$Model))
+  # comparison[[paste("Flows in", modelB$specs$Model, "not in", modelA$specs$Model)]] <- setdiff(rownames(B), rownames(A))
   return(comparison)
 }
 

diff --git a/inst/doc/CompareModels.Rmd b/inst/doc/CompareModels.Rmd
@@ -0,0 +1,36 @@
+---
+title: "Compare `r modelname_pair[1]` and `r modelname_pair[2]` Model"
+date: "`r Sys.Date()`"
+output:
+  html_document:
+    keep_md: yes
+editor_options: 
+  chunk_output_type: console
+---
+
+This document presents comparison results of `r modelname_pair[1]` and `r modelname_pair[2]` model.
+
+#### Compare flow totals between two models
+```{r, results='markup'}
+mA <- buildModel(modelname_pair[1])
+mB <- buildModel(modelname_pair[2])
+```
+
+```{r}
+# Compare flow totals
+model_com <- compareFlowTotals(mA, mB)
+cat(paste("Number of flow totals by commodity passing:",model_com$N_Pass))
+cat(paste("Number of flow totals by commodity failing:",model_com$N_Fail))
+#cat(paste("Sectors with flow totals failing:", paste(model_com$Failure$rownames, collapse = ", ")))
+```
+
+```{r echo=FALSE}
+if (!is.null(model_com[["FlowDifference"]])) {
+  cat("There are flow differences between", mA$specs$Model, "and", mB$specs$Model, "\n\n")
+  cat(names(model_com[["FlowDifference"]])[1], "are\n\n")
+  print(unlist(model_com[["FlowDifference"]][1], use.names = FALSE))
+  cat("\n", names(model_com[["FlowDifference"]])[2], "are\n\n")
+  print(unlist(model_com[["FlowDifference"]][2], use.names = FALSE))
+}
+```
+
diff --git a/inst/doc/CompareModels_render.Rmd b/inst/doc/CompareModels_render.Rmd
@@ -0,0 +1,34 @@
+---
+output: html_document
+params:
+  modelname_pair:
+    value:
+      # - ["USEEIOv2.0", "USEEIOv2.0_nodisagg"]
+      - ["USEEIOv2.0", "USEEIOv2.0.1"]
+      - ["USEEIOv2.0.1", "USEEIOv2.1"]
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+  echo = TRUE,
+  collapse = TRUE,
+  comment = "#>",
+  results = "asis"
+)
+
+require(rmarkdown)
+require(knitr)
+require(devtools)
+```
+
+# Load the `useeior` package
+```{r loadpackage}
+devtools::load_all()
+```
+# Compare models
+```{r compare}
+for (modelname_pair in params$modelname_pair) {
+  rmarkdown::render("inst/doc/CompareModels.Rmd",
+                    output_file = paste0("Compare", modelname_pair[1], "&", modelname_pair[2], ".html"))
+}
+```
diff --git a/inst/doc/ValidateModel.Rmd b/inst/doc/ValidateModel.Rmd
@@ -0,0 +1,64 @@
+---
+title: "Validating `r modelname` Model"
+date: "`r Sys.Date()`"
+output:
+  html_document:
+    keep_md: yes
+editor_options: 
+  chunk_output_type: console
+---
+
+This document presents validation results of `r modelname` model.
+
+### Build and Calculate Model
+```{r, results='markup'}
+model <- buildModel(modelname)
+```
+
+### Validate that commodity output can be recalculated (within 1%) with the model total requirements matrix (L) and demand vector (y) for US production
+```{r}
+econval <- compareOutputandLeontiefXDemand(model, tolerance = 0.01)
+cat(paste("Number of sectors passing:",econval$N_Pass))
+cat(paste("Number of sectors failing:",econval$N_Fail))
+cat(paste("Sectors failing:", paste(econval$Failure$rownames, collapse = ", ")))
+```
+
+### Validate that commodity output can be recalculated (within 1%) with model total domestic requirements matrix (L_d) and model demand (y) for US production
+```{r}
+econval <- compareOutputandLeontiefXDemand(model,use_domestic=TRUE, tolerance = 0.01)
+cat(paste("Number of sectors passing:",econval$N_Pass))
+cat(paste("Number of sectors failing:",econval$N_Fail))
+cat(paste("Sectors failing:", paste(econval$Failure$rownames, collapse = ", ")))
+```
+
+### 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 
+```{r}
+modelval <- compareEandLCIResult(model, tolerance = 0.01)
+cat(paste("Number of flow totals by commodity passing:",modelval$N_Pass))
+cat(paste("Number of flow totals by commodity failing:",modelval$N_Fail))
+#cat(paste("Sectors failing:", paste(modelval$Failure$variable, collapse = ", ")))
+```
+
+### 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
+```{r}
+dom_val <- compareEandLCIResult(model,use_domestic=TRUE, tolerance = 0.01)
+cat(paste("Number of flow totals by commodity passing:",dom_val$N_Pass))
+cat(paste("Number of flow totals by commodity failing:",dom_val$N_Fail))
+cat(paste("Sectors with flow totals failing:", paste(dom_val$Failure$variable, collapse = ", ")))
+```
+
+### Validate that commodity output are properly transformed to industry output via MarketShare
+```{r}
+q_x_val <- compareCommodityOutputXMarketShareandIndustryOutputwithCPITransformation(model, tolerance = 0.01)
+cat(paste("Number of flow totals by commodity passing:",q_x_val$N_Pass))
+cat(paste("Number of flow totals by commodity failing:",q_x_val$N_Fail))
+cat(paste("Sectors with flow totals failing:", paste(q_x_val$Failure$rownames, collapse = ", ")))
+```
+
+### Validate that commodity output equals to domestic use plus production demand
+```{r}
+q_val <- compareCommodityOutputandDomesticUseplusProductionDemand(model, tolerance = 0.01)
+cat(paste("Number of flow totals by commodity passing:",q_val$N_Pass))
+cat(paste("Number of flow totals by commodity failing:",q_val$N_Fail))
+cat(paste("Sectors with flow totals failing:", paste(q_val$Failure$rownames, collapse = ", ")))
+```
diff --git a/inst/doc/ValidateModel_render.Rmd b/inst/doc/ValidateModel_render.Rmd
@@ -0,0 +1,34 @@
+---
+output: html_document
+params:
+  modelname:
+    - "USEEIOv2.0"
+    - "USEEIOv2.0.1"
+    - "USEEIOv2.1"
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+  echo = TRUE,
+  collapse = TRUE,
+  comment = "#>",
+  results = "asis"
+)
+
+require(rmarkdown)
+require(knitr)
+require(devtools)
+```
+
+# Load the `useeior` package
+```{r loadpackage}
+devtools::load_all()
+```
+
+# Validate model
+```{r validate}
+for (modelname in params$modelname) {
+  rmarkdown::render("inst/doc/ValidateModel.Rmd",
+                    output_file = paste0("Validate", modelname, ".html"))
+}
+```
diff --git a/man/compareFlowTotals.Rd b/man/compareFlowTotals.Rd