update tests

R/main.R

@@ -189,8 +189,15 @@ calc_ep <- function(year, index = "all"){
 
   missmatch <- setdiff(index, accepted)
 
-  warning(sprintf('ATTENTION: The indicated index %s are not available. Possible options are %s.',
-                  paste(missmatch, collapse = ", "),  paste(accepted, collapse = ", ")))
+  if (length(missmatch) == 1) {
+    warning(sprintf('ATTENTION: The indicated index %s is not available. Possible options are %s.',
+                    paste(missmatch, collapse = ", "),  paste(accepted, collapse = ", ")))
+  }
+
+  if (length(missmatch) > 1) {
+    warning(sprintf('ATTENTION: The indicated indices %s are not available. Possible options are %s.',
+                    paste(missmatch, collapse = ", "),  paste(accepted, collapse = ", ")))
+  }
 
   df <- data.frame("EP_index" = c("10%",
                                   "2M",
@@ -261,8 +268,15 @@ calc_tp <- function(year, index = "all"){
 
   missmatch <- setdiff(index, accepted)
 
-  warning(sprintf('ATTENTION: The indicated index %s are not available. Possible options are %s.',
-                  paste(missmatch, collapse = ", "),  paste(accepted, collapse = ", ")))
+  if (length(missmatch) == 1) {
+    warning(sprintf('ATTENTION: The indicated index %s is not available. Possible options are %s.',
+                    paste(missmatch, collapse = ", "),  paste(accepted, collapse = ", ")))
+  }
+
+  if (length(missmatch) > 1) {
+    warning(sprintf('ATTENTION: The indicated indices %s are not available. Possible options are %s.',
+                    paste(missmatch, collapse = ", "),  paste(accepted, collapse = ", ")))
+  }
 
   df <- data.frame("TP_index" = c("10%",
                                   "2M",

README.md

@@ -82,19 +82,19 @@ Now  the package is fully loaded and you can start using its functions.
 
 The `medusa` package  contains 3 main blocks of functions:
 
-1. To calculate distributional impacts:
+1. Module 1. Functions to calculate distributional impacts
 	- Main function: `calc_di`, `ex_shocks`, `available_var_impact` , `available_var_intersec` and `ex_var_intersec`.
 	- Auxiliary functions: `load_rawhbs`, `rename_values`, `standardize`, `add_coicop`, `elevate_hbs`, `price_shock`, `impact`, `impact_intersectional`, `basic_graph`, `intersectional_graph`, `order_var`, `adjust_wh` and `adjust_wh_is`.
 
 
-2. To calculate energy poverty indicators (coming soon)
+2. Module 2. Functions to calculate energy poverty indices
 	- Main function: `calc_ep`
-	- Auxiliary functions: `...`
+	- Auxiliary functions: `id_ep1`, `id_ep1`, `weighted.median` and `weighted.quantile`.
 
 
-3. To calculate transport poverty indicators (coming soon)
+3. Module 3. Functions to calculate transport poverty indices
 	- Main function: `calc_tp`
-	- Auxiliary functions: `...`
+	- Auxiliary functions: `id_tp`, `weighted.median` and `weighted.quantile`.
 
 
 In addition, the package includes some default input files (.Rda), that are read by the different functions. 

tests/testthat/test_inputs/EP.csv

@@ -0,0 +1,6 @@
+EP_index,2006,2007,2008,2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020,2021
+10%,0.027032908,0.021957782,0.024760976,0.034398061,0.045407252,0.054695447,0.065876207,0.068633942,0.061364559,0.05419896,0.041964422,0.042615797,0.05497083,0.051628641,0.064525321,0.063667771
+2M,0.170988647,0.159383268,0.150800951,0.160260901,0.145830694,0.1425801,0.131918595,0.138606836,0.134769887,0.134726199,0.127641005,0.129227781,0.133982456,0.130496933,0.122441338,0.1363872
+LIHC,0.063797508,0.060790134,0.054755954,0.058047613,0.058252456,0.05955011,0.054733811,0.055744459,0.056072058,0.0547218,0.054746808,0.057857992,0.061524137,0.059096906,0.053328042,0.059248746
+HEP,0.149869265,0.139873072,0.140718385,0.150376937,0.141168969,0.131677709,0.13977144,0.141728351,0.131257438,0.125839622,0.123655798,0.117796647,0.121581618,0.117783105,0.114153368,0.109484222
+HEP_LI,0.05837717,0.052611565,0.048262585,0.051480906,0.052446699,0.050607744,0.053848869,0.054817754,0.051763658,0.050396497,0.049233668,0.047705209,0.0499342,0.047530943,0.046282682,0.041368727

tests/testthat/test_inputs/TP.csv

@@ -0,0 +1,5 @@
+TP_index,2006,2007,2008,2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020,2021
+10%,0.123565212,0.114971758,0.138006536,0.111656823,0.136348999,0.163493487,0.185408942,0.18736678,0.17382534,0.143996616,0.113017047,0.129815537,0.139573551,0.138385863,0.090028314,0.133075694
+2M,0.092663596,0.100053033,0.103626279,0.107379616,0.106325437,0.113372804,0.114362775,0.113974353,0.112262502,0.110000874,0.105906937,0.105319812,0.104556852,0.111725588,0.102188668,0.095934118
+LIHC,0.030306899,0.032130201,0.033963524,0.036345546,0.037668196,0.040245108,0.039094709,0.042298933,0.037786583,0.036604601,0.035218314,0.03641745,0.038341538,0.035776064,0.029449678,0.02963505
+VTU,0.016809077,0.013508635,0.015136664,0.017463429,0.016940738,0.018833952,0.018908271,0.019388292,0.02170475,0.020486451,0.021057102,0.024224726,0.022984923,0.02379166,0.019382942,0.018495723

tests/testthat/test_medusa.R

@@ -319,3 +319,39 @@ test_that("Test15_Calculate distributional impacts for all years (intersectional
     testthat::expect_equal(test_result, test_expect)
   }
 })
+
+
+test_that("Test16_Calculate energy poverty indices", {
+  y <- seq(2006,2021,1)
+
+  test_result <- calc_ep(year = y, index = "all")
+
+  path <- file.path(rprojroot::find_root(rprojroot::is_testthat), "test_inputs")
+  test_expect <- read.csv(file = paste0(path, "/EP.csv"),
+                          # fileEncoding = "UTF-8-BOM",
+                          header = TRUE,
+                          sep = ",",
+                          dec = ".") %>%
+    dplyr::rename_with(~ sub("^X", "", .))
+
+  testthat::expect_equal(test_result, test_expect)
+
+})
+
+
+test_that("Test17_Calculate transport poverty indices", {
+  y <- seq(2006,2021,1)
+
+  test_result <- calc_tp(year = y, index = "all")
+
+  path <- file.path(rprojroot::find_root(rprojroot::is_testthat), "test_inputs")
+  test_expect <- read.csv(file = paste0(path, "/TP.csv"),
+                          fileEncoding = "UTF-8-BOM",
+                          header = TRUE,
+                          sep = ",",
+                          dec = ".") %>%
+    dplyr::rename_with(~ sub("^X", "", .))
+
+  testthat::expect_equal(test_result, test_expect)
+
+})