Descriptive analysis of products per company (#15)

* Add .Rmd file

* refactor

* refactor

NAMESPACE

@@ -2,7 +2,9 @@
 
 export(calculate_co2_descriptive_analysis_per_benchmark)
 export(calculate_trs_descriptive_analysis_per_tr_benchmark)
+export(example_emission_ep_product_des_analysis)
 export(example_emission_product_co2_des_analysis)
+export(example_sector_ep_product_des_analysis)
 export(example_transition_risk_product_trs_des_analysis)
 export(show_reduction_targets_for_tilt_subsectors_per_scenario_year)
 importFrom(dplyr,distinct)

R/example_data.R

@@ -10,6 +10,8 @@
 #' @examples
 #' example_emission_product_co2_des_analysis()
 #' example_transition_risk_product_trs_des_analysis()
+#' example_emission_ep_product_des_analysis()
+#' example_sector_ep_product_des_analysis()
 example_emission_product_co2_des_analysis <- function() {
   tribble(
   # styler: off
@@ -51,3 +53,39 @@ example_transition_risk_product_trs_des_analysis <- function() {
     # styler: on
   )
 }
+
+#' @export
+#' @rdname example_emission_product_co2_des_analysis
+example_emission_ep_product_des_analysis <- function() {
+  tribble(
+    # styler: off
+  ~companies_id, ~ep_product, ~emission_profile, ~profile_ranking,
+       "comp_1",         "a",            "high",                1,
+       "comp_1",         "b",            "high",                4,
+       "comp_1",         "c",            "high",                9,
+       "comp_1",         "d",     NA_character_,         NA_real_,
+       "comp_1",         "e",     NA_character_,         NA_real_,
+       "comp_2",         "a",            "high",                1,
+       "comp_2",         "b",            "high",                2,
+       "comp_2",         "c",            "high",                4
+  # styler: on
+  )
+}
+
+#' @export
+#' @rdname example_emission_product_co2_des_analysis
+example_sector_ep_product_des_analysis <- function() {
+  tribble(
+    # styler: off
+    ~companies_id, ~ep_product, ~sector_profile, ~reduction_targets,
+         "comp_1",         "a",          "high",                  1,
+         "comp_1",         "b",          "high",                  4,
+         "comp_1",         "c",          "high",                  9,
+         "comp_1",         "d",   NA_character_,           NA_real_,
+         "comp_1",         "e",   NA_character_,           NA_real_,
+         "comp_2",         "a",          "high",                  1,
+         "comp_2",         "b",          "high",                  2,
+         "comp_2",         "c",          "high",                  4
+    # styler: on
+  )
+}

vignettes/articles/descriptive-analysis-products.Rmd

@@ -0,0 +1,160 @@
+---
+title: "Descriptive analysis of products"
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>"
+)
+```
+
+This article shows how to calculate the descriptive analysis of products for 
+emission and sector profile.
+
+```{r setup}
+library(dplyr)
+library(tiltDataAnalysis)
+library(knitr)
+options(readr.show_col_types = FALSE)
+```
+
+### Example subset of product-level output of emissions profile.
+
+```{r}
+emission_product_example <- example_emission_ep_product_des_analysis()
+kable(emission_product_example)
+```
+
+### Example subset of product-level output of sector profile.
+
+```{r}
+sector_product_example <- example_sector_ep_product_des_analysis()
+kable(sector_product_example)
+```
+
+### Distinct products of emission and sector profile
+
+```{r, results='asis'}
+cat("Distinct products of emission profile:", n_distinct(emission_product_example$ep_product))
+cat("Distinct products of sector profile:", n_distinct(sector_product_example$ep_product))
+```
+
+### Matched distinct products of emission and sector profile
+
+```{r}
+matched_distinct_products <- function(data, profile) {
+  result <- data |>
+    select(all_of(c("ep_product", profile))) |>
+    distinct() |>
+    filter(!is.na(.data[[profile]]))
+  
+  n_distinct(result$ep_product)
+}
+```
+
+```{r, results='asis'}
+cat("Matched distinct products of emission profile:", matched_distinct_products(emission_product_example, "emission_profile"))
+cat("Matched distinct products of sector profile:", matched_distinct_products(sector_product_example, "sector_profile"))
+```
+
+### Average amount of distinct products per company for emission and sector profile
+
+```{r}
+avg_distinct_products_per_company <- function(data) {
+  result <- data |>
+    select(all_of(c("companies_id", "ep_product"))) |>
+    distinct() |>
+    filter(!is.na(ep_product))
+  
+  n_distinct(result$ep_product) / n_distinct(result$companies_id)
+}
+```
+
+```{r, results='asis'}
+cat("Average amount of distinct products per company for emission profile:", avg_distinct_products_per_company(emission_product_example))
+cat("Average amount of distinct products per company for sector profile:", avg_distinct_products_per_company(sector_product_example))
+```
+
+### Distinct products without a risk category for emission and sector profile
+
+```{r}
+distinct_products_without_risk_category <- function(data, profile) {
+  result <- data |>
+    select(all_of(c("ep_product", profile))) |>
+    distinct() |>
+    filter(!is.na(ep_product) & is.na(.data[[profile]]))
+  
+  n_distinct(result$ep_product)
+}
+```
+
+```{r, results='asis'}
+cat("Distinct products without a risk category for emission profile:", distinct_products_without_risk_category(emission_product_example, "emission_profile"))
+cat("Distinct products without a risk category for sector profile:", distinct_products_without_risk_category(sector_product_example, "sector_profile"))
+```
+
+### Average profile ranking of all products
+
+```{r, results='asis'}
+result <- emission_product_example |>
+  select(all_of(c("ep_product", "profile_ranking"))) |>
+  distinct()
+
+avg_profile_ranking_all_products <- sum(result$profile_ranking, na.rm = TRUE)/ n_distinct(result$ep_product)
+cat("Average profile ranking of all products:", avg_profile_ranking_all_products)
+```
+
+### Average reduction targets of all products
+
+```{r, results='asis'}
+result <- sector_product_example |>
+  select(all_of(c("ep_product", "reduction_targets"))) |>
+  distinct()
+
+avg_reduction_targets_all_products <- sum(result$reduction_targets, na.rm = TRUE)/ n_distinct(result$ep_product)
+cat("Average reduction targets of all products:", avg_reduction_targets_all_products)
+```
+
+### Average transition risk scores of all products
+
+```{r}
+result <- product_transition_risk |>
+  select(all_of(c("product", "transition_risk_score"))) |>
+  filter(product %in% c("tent", "camper patios")) |>
+  distinct()
+kable(result)
+```
+
+```{r, results='asis'}
+avg_transition_risk_score_all_products <- sum(result$transition_risk_score, na.rm = TRUE)/ n_distinct(result$product)
+cat("Average transition risk scores of all products:", avg_transition_risk_score_all_products)
+```
+
+### Average NA share per company with atleast one matched product for emission profile
+
+Companies with atleast one matched product
+
+```{r}
+companies_atleast_one_matched_product <- product_emission |>
+  select(all_of(c("companies_id", "ep_product", "emission_profile"))) |>
+  distinct() |>
+  filter(!is.na(emission_profile)) |>
+  head(5)
+kable(companies_atleast_one_matched_product)
+```
+
+Average NA share per company which have atleast one matched product
+
+```{r}
+result <- company_transition_risk |>
+  select(all_of(c("companies_id", "emission_category_NA"))) |>
+  distinct() |>
+  filter(companies_id %in% companies_atleast_one_matched_product$companies_id)
+kable(result)
+```
+
+```{r, results='asis'}
+average_result <- sum(result$emission_category_NA) / n_distinct(result$companies_id)
+cat("Average NA share per company with atleast one matched product for emission profile:", average_result)
+```