validation for abcd_scenario_* objects

R/fake_abcd_scenario_bonds.R

@@ -0,0 +1,84 @@
+#' Create an example `abcd_scenario_bonds` object
+#'
+#' This function creates an example `abcd_scenario_bonds` object.
+#'
+#' @param scenario_source value/s to be used for the `scenario_source` column
+#' @param scenario value/s to be used for the `scenario` column
+#' @param id_name value/s to be used for the `id_name` column
+#' @param id value/s to be used for the `id` column
+#' @param ald_company_sector_id value/s to be used for the
+#'   `ald_company_sector_id` column
+#' @param equity_market value/s to be used for the `equity_market` column
+#' @param scenario_geography value/s to be used for the `scenario_geography`
+#'   column
+#' @param ald_sector value/s to be used for the `ald_sector` column
+#' @param technology value/s to be used for the `technology` column
+#' @param year value/s to be used for the `year` column
+#' @param plan_tech_prod value/s to be used for the `plan_tech_prod` column
+#' @param plan_br_wt_factor value/s to be used for the `plan_br_wt_factor`
+#'   column
+#' @param plan_br_wt_techshare value/s to be used for the `plan_br_wt_techshare`
+#'   column
+#' @param plan_emission_factor value/s to be used for the `plan_emission_factor`
+#'   column
+#' @param scen_tech_prod value/s to be used for the `scen_tech_prod` column
+#' @param scen_br_wt_factor value/s to be used for the `scen_br_wt_factor`
+#'   column
+#' @param scen_br_wt_techshare value/s to be used for the `scen_br_wt_techshare`
+#'   column
+#' @param scen_emission_factor value/s to be used for the `scen_emission_factor`
+#'   column
+#' @param current_plan_row value/s to be used for the `current_plan_row` column
+#' @param scenario_exists value/s to be used for the `scenario_exists` column
+#'
+#' @return A data frame with the specified columns and/or their default values
+#'
+#' @export
+
+fake_abcd_scenario_bonds <-
+  function(scenario_source = "ISF2021",
+           scenario = "NZE",
+           id_name = "ar_company_id",
+           id = "10015",
+           ald_company_sector_id = "4",
+           equity_market = "DevelopedMarket",
+           scenario_geography = "Global",
+           ald_sector = "Coal",
+           technology = "Coal",
+           year = 2021,
+           plan_tech_prod = 0,
+           plan_br_wt_factor = NA_real_,
+           plan_br_wt_techshare = NA_real_,
+           plan_emission_factor = NA_real_,
+           scen_tech_prod = 0,
+           scen_br_wt_factor = NA_real_,
+           scen_br_wt_techshare = NA_real_,
+           scen_emission_factor = 0,
+           current_plan_row = 1,
+           scenario_exists = 1) {
+    `class<-`(
+      data.frame(
+        scenario_source = scenario_source,
+        scenario = scenario,
+        id_name = id_name,
+        id = id,
+        ald_company_sector_id = ald_company_sector_id,
+        equity_market = equity_market,
+        scenario_geography = scenario_geography,
+        ald_sector = ald_sector,
+        technology = technology,
+        year = year,
+        plan_tech_prod = plan_tech_prod,
+        plan_br_wt_factor = plan_br_wt_factor,
+        plan_br_wt_techshare = plan_br_wt_techshare,
+        plan_emission_factor = plan_emission_factor,
+        scen_tech_prod = scen_tech_prod,
+        scen_br_wt_factor = scen_br_wt_factor,
+        scen_br_wt_techshare = scen_br_wt_techshare,
+        scen_emission_factor = scen_emission_factor,
+        current_plan_row = current_plan_row,
+        scenario_exists = scenario_exists
+      ),
+      c("tbl", "data.frame")
+    )
+  }

R/fake_abcd_scenario_equity.R

@@ -0,0 +1,84 @@
+#' Create an example `abcd_scenario_equity` object
+#'
+#' This function creates an example `abcd_scenario_equity` object.
+#'
+#' @param scenario_source value/s to be used for the `scenario_source` column
+#' @param scenario value/s to be used for the `scenario` column
+#' @param id_name value/s to be used for the `id_name` column
+#' @param id value/s to be used for the `id` column
+#' @param ald_company_sector_id value/s to be used for the
+#'   `ald_company_sector_id` column
+#' @param equity_market value/s to be used for the `equity_market` column
+#' @param scenario_geography value/s to be used for the `scenario_geography`
+#'   column
+#' @param ald_sector value/s to be used for the `ald_sector` column
+#' @param technology value/s to be used for the `technology` column
+#' @param year value/s to be used for the `year` column
+#' @param plan_tech_prod value/s to be used for the `plan_tech_prod` column
+#' @param plan_br_wt_factor value/s to be used for the `plan_br_wt_factor`
+#'   column
+#' @param plan_br_wt_techshare value/s to be used for the `plan_br_wt_techshare`
+#'   column
+#' @param plan_emission_factor value/s to be used for the `plan_emission_factor`
+#'   column
+#' @param scen_tech_prod value/s to be used for the `scen_tech_prod` column
+#' @param scen_br_wt_factor value/s to be used for the `scen_br_wt_factor`
+#'   column
+#' @param scen_br_wt_techshare value/s to be used for the `scen_br_wt_techshare`
+#'   column
+#' @param scen_emission_factor value/s to be used for the `scen_emission_factor`
+#'   column
+#' @param current_plan_row value/s to be used for the `current_plan_row` column
+#' @param scenario_exists value/s to be used for the `scenario_exists` column
+#'
+#' @return A data frame with the specified columns and/or their default values
+#'
+#' @export
+
+fake_abcd_scenario_equity <-
+  function(scenario_source = "ISF2021",
+           scenario = "NZE",
+           id_name = "ar_company_id",
+           id = "10015",
+           ald_company_sector_id = "4",
+           equity_market = "DevelopedMarket",
+           scenario_geography = "Global",
+           ald_sector = "Coal",
+           technology = "Coal",
+           year = 2021,
+           plan_tech_prod = 0,
+           plan_br_wt_factor = NA_real_,
+           plan_br_wt_techshare = NA_real_,
+           plan_emission_factor = NA_real_,
+           scen_tech_prod = 0,
+           scen_br_wt_factor = NA_real_,
+           scen_br_wt_techshare = NA_real_,
+           scen_emission_factor = 0,
+           current_plan_row = 1,
+           scenario_exists = 1) {
+    `class<-`(
+      data.frame(
+        scenario_source = scenario_source,
+        scenario = scenario,
+        id_name = id_name,
+        id = id,
+        ald_company_sector_id = ald_company_sector_id,
+        equity_market = equity_market,
+        scenario_geography = scenario_geography,
+        ald_sector = ald_sector,
+        technology = technology,
+        year = year,
+        plan_tech_prod = plan_tech_prod,
+        plan_br_wt_factor = plan_br_wt_factor,
+        plan_br_wt_techshare = plan_br_wt_techshare,
+        plan_emission_factor = plan_emission_factor,
+        scen_tech_prod = scen_tech_prod,
+        scen_br_wt_factor = scen_br_wt_factor,
+        scen_br_wt_techshare = scen_br_wt_techshare,
+        scen_emission_factor = scen_emission_factor,
+        current_plan_row = current_plan_row,
+        scenario_exists = scenario_exists
+      ),
+      c("tbl", "data.frame")
+    )
+  }

R/validate_abcd_scenario_bonds.R

@@ -0,0 +1,170 @@
+#' Validate a `abcd_scenario_bonds` object
+#'
+#' This function validates that an object is a valid `abcd_scenario_bonds` dataset.
+#'
+#' @param data An object (typically a data frame)
+#'
+#' @return `TRUE` if the object is valid, otherwise an error with a message
+#'   explaining the failed assertions
+#'
+#' @export
+
+validate_abcd_scenario_bonds <-
+  function(data) {
+    coll <- checkmate::makeAssertCollection()
+
+    checkmate::assert_data_frame(data, add = coll)
+
+    if (checkmate::test_data_frame(data)) {
+      checkmate::assert_false(dplyr::is_grouped_df(data), add = coll)
+
+      assert_columns_exists(
+        data,
+        col_names = c(
+          "scenario_source",
+          "scenario",
+          "id_name",
+          "id",
+          "ald_company_sector_id",
+          "equity_market",
+          "scenario_geography",
+          "ald_sector",
+          "technology",
+          "year",
+          "plan_tech_prod",
+          "plan_br_wt_factor",
+          "plan_br_wt_techshare",
+          "plan_emission_factor",
+          "scen_tech_prod",
+          "scen_br_wt_factor",
+          "scen_br_wt_techshare",
+          "scen_emission_factor",
+          "current_plan_row",
+          "scenario_exists"),
+        add = coll
+      )
+
+      # `scenario_source` column
+      col_name <- "scenario_source"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        checkmate::assert_character(data[[col_name]], any.missing = FALSE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `scenario` column
+      col_name <- "scenario"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        checkmate::assert_character(data[[col_name]], any.missing = FALSE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `id_name` column
+      col_name <- "id_name"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        checkmate::assert_character(data[[col_name]], any.missing = FALSE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `id` column
+      col_name <- "id"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        assert_valid_ai_company_id(data[[col_name]], any.missing = FALSE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `ald_company_sector_id` column
+      col_name <- "ald_company_sector_id"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        checkmate::assert_character(data[[col_name]], any.missing = FALSE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `equity_market` column
+      col_name <- "equity_market"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        assert_valid_equity_market(data[[col_name]], any.missing = FALSE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `scenario_geography` column
+      col_name <- "scenario_geography"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        assert_valid_scenario_geography(data[[col_name]], any.missing = FALSE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `ald_sector` column
+      col_name <- "ald_sector"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        assert_valid_sector(data[[col_name]], any.missing = FALSE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `technology` column
+      col_name <- "technology"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        assert_valid_technology(data[[col_name]], any.missing = FALSE, add = coll, .var.name = paste0("data$", col_name))
+        assert_valid_technology_for_sector(data[[col_name]], data[["ald_sector"]], any.missing = FALSE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `year` column
+      col_name <- "year"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        checkmate::assert_integerish(data[[col_name]], any.missing = FALSE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `plan_tech_prod` column
+      col_name <- "plan_tech_prod"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        checkmate::assert_double(data[[col_name]], lower = 0, any.missing = FALSE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `plan_br_wt_factor` column
+      col_name <- "plan_br_wt_factor"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        checkmate::assert_double(data[[col_name]], lower = 0, any.missing = TRUE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `plan_br_wt_techshare` column
+      col_name <- "plan_br_wt_techshare"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        checkmate::assert_double(data[[col_name]], lower = 0, any.missing = TRUE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `plan_emission_factor` column
+      col_name <- "plan_emission_factor"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        checkmate::assert_double(data[[col_name]], lower = 0, any.missing = TRUE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `scen_tech_prod` column
+      col_name <- "scen_tech_prod"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        checkmate::assert_double(data[[col_name]], lower = 0, any.missing = FALSE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `scen_br_wt_factor` column
+      col_name <- "scen_br_wt_factor"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        checkmate::assert_double(data[[col_name]], lower = 0, any.missing = TRUE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `scen_br_wt_techshare` column
+      col_name <- "scen_br_wt_techshare"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        checkmate::assert_double(data[[col_name]], lower = 0, any.missing = TRUE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `scen_emission_factor` column
+      col_name <- "scen_emission_factor"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        checkmate::assert_double(data[[col_name]], lower = 0, any.missing = TRUE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `current_plan_row` column
+      col_name <- "current_plan_row"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        checkmate::assert_integerish(data[[col_name]], lower = 0, any.missing = FALSE, add = coll, .var.name = paste0("data$", col_name))
+      }
+
+      # `scenario_exists` column
+      col_name <- "scenario_exists"
+      if (checkmate::test_names(names(data), must.include = col_name)) {
+        checkmate::assert_integerish(data[[col_name]], lower = 0, upper = 1, any.missing = FALSE, add = coll, .var.name = paste0("data$", col_name))
+      }
+    }
+
+    checkmate::reportAssertions(coll)
+  }