# library(lissyrtools)
# context("Functions for computing estimates")
#
# set.seed(4)
#
# .run_local_tests <- (Sys.info()[["effective_user"]] == "josep" && Sys.info()[["nodename"]] == "DEVV-CT01")
#
#
# if(.run_local_tests){
#
# options(JULIA_HOME = "/home/josep/.local/bin/julia/bin/")
#
# }
#
# # compute_percentiles -----------------------------------------------------
#
# # ** default arguments ----------------------------------------------------
#
# test_that("compute_percentiles works well with minimum specified arguments", {
#
# file_ <- tibble::tibble(var_ = c(seq(0, 10)))
#
# expect_equal(compute_percentiles(file = file_,
# file_name = "aa55i",
# variable = "var_")[["value"]],
# seq(0, 10))
#
# })
#
#
# # ** user-specified arguments ---------------------------------------------
#
# test_that("compute_percentiles works well without with na.rm specified to TRUE", {
#
# file_ <- tibble::tibble(var_ = c(seq(0, 10)))
#
# expect_equal(compute_percentiles(file = file_,
# file_name = "aa55i",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# na.rm = TRUE)[["value"]],
# seq(0, 10))
#
# })
#
#
#
# test_that("compute_percentiles ignores NAs in variable if na.rm = TRUE", {
#
# file_ <- tibble::tibble(var_ = c(NA, seq(0, 10), NA))
#
# expect_equal(compute_percentiles(file = file_,
# file_name = "aa55i",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# na.rm = TRUE)[["value"]],
# seq(0, 10))
#
# expect_equal(compute_percentiles(file = file_,
# file_name = "aa55i",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# na.rm = TRUE)[["percentile"]],
# seq(0, 1, 0.1))
#
# })
#
#
# test_that("compute_percentiles works well with specified weight variable", {
#
# file_ <- tibble::tibble(var_ = c(50, seq(0, 10)), my_weight = c(0, rep(1, 11)))
#
# expect_equal(compute_percentiles(file_,
# file_name = "aa55i",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# weight = "my_weight",
# na.rm = TRUE)[["value"]],
# seq(0, 10))
#
# })
#
#
# test_that("compute_percentiles ignores NAs in weight if na.rm = TRUE and weight is specified", {
#
# file_ <- tibble::tibble(var_ = c(50, seq(0, 10)),
# pwgt = c(NA, rep(1, 11)))
#
# expect_equal(compute_percentiles(file = file_,
# file_name = "aa55i",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# weight = "pwgt",
# na.rm = TRUE)[["value"]],
# seq(0, 10))
#
# })
#
#
# test_that("compute_percentiles works well when weights are small or don't have mean equal to 1", {
#
# file_1_a <- tibble::tibble(var_ = seq(0, 10),
# my_weight = c(seq(1, 11)))
# file_1_b <- tibble::tibble(var_ = seq(0, 10),
# my_weight = c(seq(1, 11))*0.00001)
# file_1_c <- tibble::tibble(var_ = seq(0, 10),
# my_weight = c(seq(1, 11))*10000)
#
# expect_equal(compute_percentiles(file_1_a,
# file_name = "aa55i",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# weight = "my_weight",
# na.rm = TRUE)[["value"]],
# compute_percentiles(file_1_b,
# file_name = "aa55i",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# weight = "my_weight",
# na.rm = TRUE)[["value"]])
#
# expect_equal(compute_percentiles(file_1_a,
# file_name = "aa55i",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# weight = "my_weight",
# na.rm = TRUE)[["value"]],
# compute_percentiles(file_1_c,
# file_name = "aa55i",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# weight = "my_weight",
# na.rm = TRUE)[["value"]])
#
# })
#
#
# # ** missing values -------------------------------------------------------
#
# test_that("compute_percentiles throws a warning and returns NAs if there are NAs and na.rm = FALSE", {
#
# file_1 <- tibble::tibble(var_ = c(NA, seq(0,10), NA))
#
# file_2 <- tibble::tibble(var_ = seq(0,10),
# pwgt = c(NA, rep(1, 10)))
#
#
# expect_warning(compute_percentiles(file_1,
# file_name = "aa55i",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# na.rm = FALSE),
# "'var_' in 'aa55i' contains NAs. Use na.rm = TRUE to ignore them.",
# fixed = TRUE)
#
# expect_warning(compute_percentiles(file_2,
# file_name = "aa55i",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# weight = "pwgt",
# na.rm = FALSE),
# "There are NAs in the weighting variable 'pwgt' in 'aa55i'. Use na.rm = TRUE to ignore them.")
#
#
# expect_equal(suppressWarnings(compute_percentiles(file_1,
# file_name = "aa55i",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# na.rm = FALSE)),
# structure(list(percentile = c(0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6,
# 0.7, 0.8, 0.9, 1), value = c(NA, NA, NA, NA, NA, NA, NA, NA,
# NA, NA, NA)),
# class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -11L)))
#
# suppressWarnings({
# expect_equal(
#
# compute_percentiles(file_2,
# file_name = "aa55i",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# weight = "pwgt",
# na.rm = FALSE),
# structure(list(percentile = c(0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6,
# 0.7, 0.8, 0.9, 1),
# value = c(NA, NA, NA, NA, NA, NA, NA, NA,
# NA, NA, NA)),
# class = c("tbl_df", "tbl", "data.frame"),
# row.names = c(NA, -11L))
# )
# })
#
# })
#
#
#
# # ** wrong or missing parameters ------------------------------------------
#
# test_that("compute_percentiles throws an error if 'variable' is a character vector", {
#
# file_1 <- tibble::tibble(var_ = c(NA, letters[1:10], NA), hwgt = 1)
# file_2 <- tibble::tibble(var_ = letters[1:10], hwgt = 1)
#
# expect_error(compute_percentiles(file = file_1,
# file_name = "aa55i",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# na.rm = FALSE),
# "The argument 'variable' needs to be numeric. 'var_' in 'aa55i' is not numeric.",
# fixed = TRUE)
#
# expect_error(compute_percentiles(file = file_2,
# file_name = "aa55i",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# na.rm = FALSE),
# "The argument 'variable' needs to be numeric. 'var_' in 'aa55i' is not numeric.",
# fixed = TRUE)
#
# })
#
#
#
# test_that("compute_percentiles throws error if 'file' is an empty data frame with 0 rows", {
#
# file_ <- tibble::tibble(var_ = numeric(0), hwgt = numeric(0))
#
# expect_error(compute_percentiles(file = file_,
# file_name = "aa55i",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# na.rm = FALSE),
# regexp = "Argument 'file' in 'aa55i' should be have 1 or more rows.",
# fixed = TRUE)
#
# })
#
#
#
# test_that("compute_percentiles fails when 'variable' or 'weight' are not in dataset", {
#
# file_1 <- tibble::tibble(hwgt = rep(1, times = 3))
#
# file_2 <- tibble::tibble(var_ = c(seq(0,10)))
#
# expect_error(compute_percentiles(file_1,
# file_name = "aa55ih",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# na.rm = FALSE),
# regexp = "'var_' was not found in 'aa55ih'.",
# fixed = TRUE)
#
# expect_error(compute_percentiles(file_2,
# file_name = "aa55ih",
# variable = "var_",
# breaks = seq(0, 1, 0.1),
# weight = "hwgt",
# na.rm = FALSE),
# regexp = "'hwgt' was not found in 'aa55ih'.",
# fixed = TRUE)
#
# })
#
#
#
# test_that("compute_percentiles throws an eror NA if all values in 'weight' are NAs or 0s", {
#
# file_1 <- tibble::tibble(var_ = seq(0, 10), hwgt = rep(NA, 11))
#
# file_2 <- tibble::tibble(var_ = seq(0, 10), hwgt = rep(0, 11))
#
# expect_error(
# compute_percentiles(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = TRUE),
# "The variable for weights ('hwgt') contains only NAs and/or 0s. The equivalised percentiles could not be computed.",
# fixed = TRUE)
#
# expect_error(
# compute_percentiles(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = FALSE),
# "The variable for weights ('hwgt') contains only NAs and/or 0s. The equivalised percentiles could not be computed.",
# fixed = TRUE)
#
# expect_error(
# compute_percentiles(file = file_2,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = TRUE),
# "The variable for weights ('hwgt') contains only NAs and/or 0s. The equivalised percentiles could not be computed.",
# fixed = TRUE)
#
# })
#
#
# # compute_gini ------------------------------------------------------------
#
# # ** default arguments ----------------------------------------------------
#
# test_that("compute_gini works well with minimum specified arguments", {
#
# expect_equal(compute_gini(file = mock_dataset,
# file_name = "zz55i",
# variable = "mock_variable"),
# 0.3339987,
# tolerance = 0.001)
#
# })
#
#
# # ** user-specified arguments ---------------------------------------------
#
# test_that("compute_gini works well without with na.rm specified to TRUE", {
#
# file_ <- tibble::tibble(var_ = c(seq(0, 10)))
#
# expect_equal(compute_gini(file = mock_dataset,
# file_name = "zz55i",
# variable = "mock_variable_NAs",
# na.rm = TRUE),
# 0.3332986,
# tolerance = 0.001)
#
# })
#
#
#
#
# # add to test:
# # more breaks than data points?
#
# # https://github.com/tidyverse/dplyr/blob/master/tests/testthat/test-rank.R
# # test_that("ntile() does not overflow (#4186)", {
# # res <- tibble(a = 1:1e5) %>%
# # mutate(b = ntile(n = 1e5)) %>%
# # count(b) %>%
# # pull()
# #
# # expect_true(all(res == 1L))
# # })
#
#
# # puts large groups first
# # with a warning!
#
#
#
# ## test that compute_lorenz_curve works well when there are repeated quantiles (e.g. fr84)
#
#
# # compute_lorenz_curve ----------------------------------------------------
# #
# # test_that("compute_lorenz returns the expected result for a simple vector with no NAs nor repeated percentiles", {
# #
# # expect_equal(compute_lorenz_curve(file = mock_dataset,
# # file_name = "zz55",
# # variable = "mock_variable",
# # n_percentiles = 100,
# # na.rm = FALSE)[["lorenz_curve_values"]],
# # results_mock_dataset_100)
# #
# # expect_equal(compute_lorenz_curve(file = mock_dataset,
# # file_name = "zz55",
# # variable = "mock_variable",
# # n_percentiles = 50,
# # na.rm = FALSE)[["lorenz_curve_values"]],
# # results_mock_dataset_50)
# #
# # })
#
#
# #
# # test_that("compute_lorenz properly deals with leading 0s in percentiles", {
# #
# # expect_equal(compute_lorenz_curve(file = mock_dataset,
# # file_name = "zz55",
# # variable = "mock_variable_leading_0s",
# # n_percentiles = 100,
# # na.rm = FALSE)[1:5,"lorenz_curve_values", drop = TRUE],
# # c(rep(0, 5))
# # )
# #
# # expect_equal(compute_lorenz_curve(file = mock_dataset,
# # file_name = "zz55",
# # variable = "mock_variable_leading_0s",
# # n_percentiles = 50,
# # na.rm = FALSE)[1:2,"lorenz_curve_values", drop = TRUE],
# # c(rep(0, 2))
# # )
# #
# # })
#
#
# # test_that("compute_lorenz returns properly deals with repeated percentiles in negative values", {
# #
# #
# # })
#
#
#
# # test_that("compute_lorenz returns NA if there are missing variables and na.rm = FALSE", {
# #
# # expect_equal(compute_lorenz_curve(file = mock_dataset,
# # file_name = "zz55",
# # variable = "mock_variable_NAs",
# # n_percentiles = 100,
# # na.rm = FALSE), NA
# # )
# #
# # expect_warning(compute_lorenz_curve(file = mock_dataset,
# # file_name = "zz55",
# # variable = "mock_variable_NAs",
# # n_percentiles = 50,
# # na.rm = FALSE)
# # )
# # })
#
#
#
# ## TO DO: thest that compute_lorenz_curve computes the requested number of percentiles
#
#
#
# # Compute standard indicators ---------------------------------------------
#
#
# # ** compute_mean ---------------------------------------------------------
#
# test_that("compute_mean returns the correct output when weight argument is NULL", {
#
# file_1 <- tibble::tibble(var_ = seq(0, 10), hwgt = 1)
#
# expect_equal(compute_mean(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# na.rm = FALSE),
# 5)
#
# expect_equal(compute_mean(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = NULL,
# na.rm = FALSE),
# 5)
#
# })
#
#
# test_that("compute_mean throws an error when weight variable is missing", {
#
# file_1 <- tibble::tibble(var_ = seq(0, 10))
#
# expect_error(compute_mean(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = FALSE),
# "'hwgt' was not found in 'zz55i'.",
# fixed = TRUE)
#
# })
#
#
# test_that("compute_mean throws an error when 'variable' is missing", {
#
# file_1 <- tibble::tibble(var2_ = seq(0, 10))
#
# expect_error(compute_mean(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# na.rm = FALSE),
# "'var_' was not found in 'zz55i'.",
# fixed = TRUE)
#
# })
#
#
# test_that("compute_mean returns the correct output when weights are constant and not constant", {
#
# file_1 <- tibble::tibble(var_ = seq(0, 10), hwgt = 1)
# file_2 <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(2, 0.5, 2, 0.5,
# 2, 1, 2, 0.5,
# 2, 0.5, 2))
# file_3 <- tibble::tibble(var_ = seq(0, 10),
# pwgt = c(2, 0.5, 2, 0.5, # change name of weight variable
# 2, 1, 2, 0.5,
# 2, 0.5, 2))
# file_4 <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(rep(1, 6), rep(2, 5)))
#
# expect_equal(compute_mean(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE),
# 5)
#
# expect_equal(compute_mean(file = file_2,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE),
# 5)
#
# expect_equal(compute_mean(file = file_3,
# file_name = "zz55i",
# weight = "pwgt",
# variable = "var_",
# na.rm = FALSE),
# 5)
#
# expect_equal(compute_mean(file = file_4,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE),
# 5.9375)
#
# })
#
#
# test_that("compute_mean works well when weights are small or don't have mean equal to 1", {
#
# file_1 <- tibble::tibble(var_ = seq(0, 10), hwgt = 1*0.0000001)
# file_2 <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(2, 0.5, 2, 0.5,
# 2, 1, 2, 0.5,
# 2, 0.5, 2)*0.00000001)
# file_3 <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(rep(1, 6), rep(2, 5))*0.00000001)
#
# expect_equal(compute_mean(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE),
# 5)
#
# expect_equal(compute_mean(file = file_2,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE),
# 5)
#
# expect_equal(compute_mean(file = file_3,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE),
# 5.9375)
#
# })
#
#
# test_that("compute_mean returns NA if there are missing variables and na.rm = FALSE", {
#
# file_1 <- tibble::tibble(var_ = c(NA, seq(1, 10)), hwgt = 1)
# file_2 <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(NA, rep(1, 10)))
# file_3 <- tibble::tibble(var_ = c(NA, seq(1, 10)),
# hwgt = c(NA, rep(1, 10)))
#
# expect_equal(compute_mean(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE),
# NA_real_)
#
# expect_equal(compute_mean(file = file_2,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE),
# NA_real_)
#
# expect_equal(compute_mean(file = file_3,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE),
# NA_real_)
#
# expect_equal(compute_mean(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = TRUE),
# 5.5)
#
# expect_equal(compute_mean(file = file_2,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = TRUE),
# 5.5)
#
# expect_equal(compute_mean(file = file_3,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = TRUE),
# 5.5)
#
# })
#
#
# # ** compute_median -------------------------------------------------------
#
# test_that("compute_median returns the correct output when weight argument is NULL", {
#
# file_1 <- tibble::tibble(var_ = seq(0, 10), hwgt = 1)
#
# expect_equal(compute_median(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# na.rm = FALSE),
# 5)
#
# expect_equal(compute_median(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = NULL,
# na.rm = FALSE),
# 5)
#
# })
#
#
# test_that("compute_median throws an error when weight variable is missing", {
#
# file_1 <- tibble::tibble(var_ = seq(0, 10))
#
# expect_error(compute_median(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = FALSE),
# "'hwgt' was not found in 'zz55i'.",
# fixed = TRUE)
#
# })
#
#
# test_that("compute_median throws an error when 'variable' is missing", {
#
# file_1 <- tibble::tibble(var2_ = seq(0, 10))
#
# expect_error(compute_median(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# na.rm = FALSE),
# "'var_' was not found in 'zz55i'.",
# fixed = TRUE)
#
# })
#
# test_that("compute_median returns the correct numeric output when weights are constant and not constant", {
#
# file_1 <- tibble::tibble(var_ = seq(0, 10), hwgt = 1)
# file_2 <- tibble::tibble(var_ = seq(0, 10), pwgt = 1)
# file_3 <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(2, 0.5, 2, 0.5,
# 2, 1, 2, 0.5,
# 2, 0.5, 2))
# file_4 <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(rep(1, 6), rep(2, 5)))
#
# expect_equal(compute_median(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE),
# 5)
#
# expect_equal(compute_median(file = file_2,
# file_name = "zz55i",
# weight = "pwgt",
# variable = "var_",
# na.rm = FALSE),
# 5)
#
# expect_equal(compute_median(file = file_3,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE),
# 5)
#
# expect_equal(compute_median(file = file_4,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE),
# 6.5)
#
# })
#
#
# test_that("compute_median returns NA if there are missing variables and na.rm = FALSE", {
#
# file_1 <- tibble::tibble(var_ = c(NA, seq(1, 10)),
# hwgt = 1)
# file_2 <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(NA, rep(1, 10)))
# file_3 <- tibble::tibble(var_ = c(NA, seq(1, 10)),
# hwgt = c(NA, rep(1, 10)))
#
# expect_equal(compute_median(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE),
# NA)
#
# expect_equal(compute_median(file = file_2,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE),
# NA)
#
# expect_equal(compute_median(file = file_3,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE),
# NA)
#
# expect_equal(compute_median(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = TRUE),
# 5.5)
#
# expect_equal(compute_median(file = file_2,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = TRUE),
# 5.5)
#
# expect_equal(compute_median(file = file_3,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = TRUE),
# 5.5)
#
# })
#
#
# test_that("compute_median works well when weights are small or don't have mean equal to 1", {
#
# file_1_a <- tibble::tibble(var_ = seq(0, 10), hwgt = 1)
# file_1_b <- tibble::tibble(var_ = seq(0, 10), hwgt = 1*0.0000001)
#
# file_2_a <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(2, 0.5, 2, 0.5,
# 2, 1, 2, 0.5,
# 2, 0.5, 2))
# file_2_b <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(2, 0.5, 2, 0.5,
# 2, 1, 2, 0.5,
# 2, 0.5, 2)*0.00000001)
#
# file_3_a <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(rep(1, 6), rep(2, 5)))
# file_3_b <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(rep(1, 6), rep(2, 5))*0.00000001)
#
# expect_equal(compute_median(file = file_1_a,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE),
# compute_median(file = file_1_b,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# na.rm = FALSE))
#
# expect_equal(compute_median(file = file_2_a,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = FALSE),
# compute_median(file = file_2_b,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = FALSE))
#
# expect_equal(compute_median(file = file_3_a,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = FALSE),
# compute_median(file = file_3_b,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = FALSE))
#
# })
#
#
# # compute_ratio --------------------------------------------------------
#
# # ** default arguments ----------------------------------------------------
#
# test_that("compute_ratio returns the correct output when weight argument is NULL", {
#
# file_1 <- tibble::tibble(var_ = seq(0, 10), hwgt = 1)
#
# expect_equal(compute_ratio(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# ratio = c(0.9, 0.1),
# na.rm = FALSE),
# 9/1)
#
# expect_equal(compute_ratio(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = NULL,
# ratio = c(0.9, 0.1),
# na.rm = FALSE),
# 9/1)
#
# })
#
#
# test_that("compute_ratio returns the correct output when ratio is not specified", {
#
# file_1 <- tibble::tibble(var_ = seq(0, 10), hwgt = 1)
#
# expect_equal(compute_ratio(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# na.rm = FALSE),
# 9/1)
#
# expect_equal(compute_ratio(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = NULL,
# na.rm = FALSE),
# 9/1)
#
# })
#
#
# # ** user-specified arguments ---------------------------------------------
#
# test_that("compute_ratio returns the correct numeric output when weights are constant and not constant", {
#
# file_1 <- tibble::tibble(var_ = seq(0, 10), hwgt = 1)
# file_2 <- tibble::tibble(var_ = seq(0, 10), pwgt = 1)
# file_3 <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(2, 0.5, 2, 0.5,
# 2, 1, 2, 0.5,
# 2, 0.5, 2))
# file_4 <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(rep(1, 6), rep(2, 5)))
#
# expect_equal(compute_ratio(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# ratio = c(0.9, 0.1),
# na.rm = FALSE),
# 9/1)
#
# expect_equal(compute_ratio(file = file_2,
# file_name = "zz55i",
# weight = "pwgt",
# variable = "var_",
# ratio = c(0.9, 0.1),
# na.rm = FALSE),
# 9/1)
#
# expect_equal(compute_ratio(file = file_3,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# ratio = c(0.9, 0.5),
# na.rm = FALSE),
# 1.666667,
# tolerance = 0.001)
#
# expect_equal(compute_ratio(file = file_4,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# ratio = c(0.9, 0.5),
# na.rm = FALSE),
# 1.428571,
# tolerance = 0.001)
#
# })
#
#
# test_that("compute_ratio works well when weights are small or don't have mean equal to 1", {
#
# file_1_a <- tibble::tibble(var_ = seq(0, 10), hwgt = 1)
# file_1_b <- tibble::tibble(var_ = seq(0, 10), hwgt = 1*0.0000001)
#
# file_2_a <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(2, 0.5, 2, 0.5,
# 2, 1, 2, 0.5,
# 2, 0.5, 2))
# file_2_b <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(2, 0.5, 2, 0.5,
# 2, 1, 2, 0.5,
# 2, 0.5, 2)*0.00000001)
# file_2_c <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(2, 0.5, 2, 0.5,
# 2, 1, 2, 0.5,
# 2, 0.5, 2)*1000000)
#
# file_3_a <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(rep(1, 6), rep(2, 5)))
# file_3_b <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(rep(1, 6), rep(2, 5))*0.00000001)
#
# expect_equal(compute_ratio(file = file_1_a,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# ratio = c(0.9, 0.5),
# na.rm = FALSE),
# compute_ratio(file = file_1_b,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# ratio = c(0.9, 0.5),
# na.rm = FALSE),
# tolerance = 0.001)
#
# expect_equal(compute_ratio(file = file_2_a,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# ratio = c(0.9, 0.5),
# na.rm = FALSE),
# compute_ratio(file = file_2_b,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# ratio = c(0.9, 0.5),
# na.rm = FALSE),
# tolerance = 0.001)
#
#
# expect_equal(compute_ratio(file = file_2_a,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# ratio = c(0.9, 0.5),
# na.rm = FALSE),
# compute_ratio(file = file_2_c,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# ratio = c(0.9, 0.5),
# na.rm = FALSE),
# tolerance = 0.001)
#
# expect_equal(compute_ratio(file = file_3_a,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# ratio = c(0.9, 0.5),
# na.rm = FALSE),
# compute_ratio(file = file_3_b,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# ratio = c(0.9, 0.5),
# na.rm = FALSE),
# tolerance = 0.001)
#
# })
#
#
# # ** missing values -------------------------------------------------------
#
# test_that("compute_ratio throws a warning and returns NAs if there are NAs in variable and na.rm = FALSE (default)", {
#
# file_1 <- tibble::tibble(var_ = c(NA, seq(1, 10)),
# hwgt = c(2, 0.5, 2, 0.5,
# 2, 1, 2, 0.5,
# 2, 0.5, 2))
#
# expect_warning(
# compute_ratio(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = FALSE),
# "'var_' in 'zz55i' contains NAs. Use na.rm = TRUE to ignore them."
# )
#
# expect_equal(compute_ratio(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = FALSE), NA)
#
#
# })
#
#
# test_that("compute_ratio throws a warning and returns NAs if there are NAs in weights and na.rm = FALSE", {
#
# file_1 <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(NA, 0.5, 2, 0.5,
# 2, 1, 2, 0.5,
# 2, 0.5, 2))
#
# expect_warning(
# compute_ratio(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = FALSE),
# "There are NAs in the weighting variable 'hwgt' in 'zz55i'. Use na.rm = TRUE to ignore them."
# )
#
# expect_equal(compute_ratio(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = FALSE), NA)
#
# })
#
#
# test_that("compute_ratio excludes NAs in variable when na.rm = TRUE", {
#
# file_1 <- tibble::tibble(var_ = c(NA, seq(0, 10)), hwgt = 1)
#
# expect_equal(
# compute_ratio(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = TRUE),
# 9)
# })
#
#
# test_that("compute_ratio excludes NAs in weights when na.rm = TRUE", {
#
# file_1 <- tibble::tibble(var_ = c(999, seq(0, 10)), hwgt = c(NA, rep(1, 11)))
#
# expect_equal(
# compute_ratio(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = TRUE),
# 9)
# })
#
#
# test_that("compute_ratio returns NA if all values in 'variable' are NAs", {
#
# file_1 <- tibble::tibble(var_ = rep(NA_real_, 10), hwgt = 1)
#
# expect_equal(
# compute_ratio(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = TRUE),
# NA_real_)
#
# })
#
# test_that("compute_ratio throws an eror NA if all values in 'weight' are NAs or 0s", {
#
# file_1 <- tibble::tibble(var_ = seq(0, 10), hwgt = rep(NA, 11))
#
# file_2 <- tibble::tibble(var_ = seq(0, 10), hwgt = rep(0, 11))
#
# expect_error(
# compute_ratio(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = TRUE),
# "The variable for weights ('hwgt') contains only NAs and/or 0s. The equivalised percentiles could not be computed.",
# fixed = TRUE)
#
# expect_error(
# compute_ratio(file = file_2,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# na.rm = TRUE),
# "The variable for weights ('hwgt') contains only NAs and/or 0s. The equivalised percentiles could not be computed.",
# fixed = TRUE)
#
# })
#
#
# # ** wrong or missing parameters ------------------------------------------
#
# test_that("compute_ratio throws an error when weight variable is missing", {
#
# file_1 <- tibble::tibble(var_ = seq(0, 10))
#
# expect_error(compute_ratio(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# weight = "hwgt",
# ratio = c(0.9, 0.1),
# na.rm = FALSE),
# "'hwgt' was not found in 'zz55i'.",
# fixed = TRUE)
#
# })
#
#
# test_that("compute_ratio throws an error when 'variable' is missing", {
#
# file_1 <- tibble::tibble(var2_ = seq(0, 10))
#
# expect_error(compute_ratio(file = file_1,
# file_name = "zz55i",
# variable = "var_",
# ratio = c(0.9, 0.1),
# na.rm = FALSE),
# "'var_' was not found in 'zz55i'.",
# fixed = TRUE)
#
# })
#
#
# test_that("compute_ratio throws an error if values of ratio are incorrect", {
#
# file_1 <- tibble::tibble(var_ = seq(0, 10), hwgt = 1)
#
# expect_error(
# compute_ratio(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# ratio = c(0.9),
# na.rm = FALSE),
# "'ratio' should be a vector with length 2."
# )
#
# expect_error(compute_ratio(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# ratio = c(1.1, 0.5),
# na.rm = FALSE),
# "Values in 'ratio' must be between 0 and 1.")
#
# })
#
#
# # compute_atkinson -----------------------------------------------------
#
# # ** default arguments ----------------------------------------------------
#
# test_that("compute_atkinson works well with minimum specified arguments", {
#
# file_ <- tibble::tibble(var_ = c(seq(1, 100)))
#
# # epsilon < 1
# expect_equal(compute_atkinson(file = file_,
# file_name = "aa55i",
# variable = "var_",
# epsilon = 0.9),
# 0.2164242,
# tolerance = 0.0001)
#
# # epsilon == 1
# expect_equal(compute_atkinson(file = file_,
# file_name = "aa55i",
# variable = "var_",
# epsilon = 1),
# 0.2476695,
# tolerance = 0.0001)
#
# # epsilon > 1
# expect_equal(compute_atkinson(file = file_,
# file_name = "aa55i",
# variable = "var_",
# epsilon = 1.1),
# 0.2805721,
# tolerance = 0.0001)
#
# })
#
#
# test_that("compute_atkinson returns the correct output when variable includes 0s and negative values", {
#
# file_1 <- tibble::tibble(var_ = c(seq(0, 500)))
#
# # epsilon < 1
# expect_equal(compute_atkinson(file = file_1,
# file_name = "aa55i",
# variable = "var_",
# epsilon = 0.9),
# 0.2395666,
# tolerance = 0.0001)
#
# # epsilon == 1
# expect_equal(compute_atkinson(file = file_1,
# file_name = "aa55i",
# variable = "var_",
# epsilon = 1),
# 0.2597727,
# tolerance = 0.0001)
#
# # epsilon > 1
# expect_equal(compute_atkinson(file = file_1,
# file_name = "aa55i",
# variable = "var_",
# epsilon = 1.1),
# 0.2961865,
# tolerance = 0.0001)
# })
#
#
# test_that("compute_atkinson throws a warning if 0s are included in the variable and epsilon >= 1", {
#
# file_ <- tibble::tibble(var_ = c(seq(0, 100)))
#
# # epsilon == 1
# expect_warning(compute_atkinson(file = file_,
# file_name = "aa55i",
# variable = "var_",
# epsilon = 1),
# "0s in 'var_' were removed before computing the Atkinson index for 'aa55i'. 0s are not allowed if epsilon >= 1")
#
# # epsilon > 1
# expect_warning(compute_atkinson(file = file_,
# file_name = "aa55i",
# variable = "var_",
# epsilon = 1.1),
# "0s in 'var_' were removed before computing the Atkinson index for 'aa55i'. 0s are not allowed if epsilon >= 1")
#
# })
#
#
#
#
# # ** user-specified arguments ---------------------------------------------
#
# # weights
#
#
#
# # ** missing values -------------------------------------------------------
#
# test_that("compute_atkinson throws a warning and returns NAs if there are NAs in variable and na.rm = FALSE (default)", {
#
# file_1 <- tibble::tibble(var_ = c(NA, seq(1, 10)),
# hwgt = c(2, 0.5, 2, 0.5,
# 2, 1, 2, 0.5,
# 2, 0.5, 2))
#
# expect_equal(compute_atkinson(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# epsilon = 1,
# na.rm = FALSE),
# NA_real_)
#
# expect_equal(compute_atkinson(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# epsilon = 1),
# NA_real_)
#
# expect_warning(compute_atkinson(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# epsilon = 1,
# na.rm = FALSE),
# "'var_' in 'zz55i' contains NAs. Use na.rm = TRUE to ignore them.")
#
# expect_warning(compute_atkinson(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# epsilon = 1),
# "'var_' in 'zz55i' contains NAs. Use na.rm = TRUE to ignore them.")
#
#
# })
#
#
# test_that("throws a warning and returns NAs if there are NAs in weights and na.rm = FALSE",{
#
# file_1 <- tibble::tibble(var_ = seq(0, 10),
# hwgt = c(NA, 0.5, 2, 0.5,
# 2, 1, 2, 0.5,
# 2, 0.5, 2))
#
# expect_equal(compute_atkinson(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# epsilon = 1,
# na.rm = FALSE),
# NA_real_)
#
# expect_equal(compute_atkinson(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# epsilon = 1),
# NA_real_)
#
# expect_warning(compute_atkinson(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# epsilon = 1,
# na.rm = FALSE),
# "There are NAs in the weighting variable 'hwgt' in 'zz55i'. Use na.rm = TRUE to ignore them.")
#
# expect_warning(compute_atkinson(file = file_1,
# file_name = "zz55i",
# weight = "hwgt",
# variable = "var_",
# epsilon = 1),
# "There are NAs in the weighting variable 'hwgt' in 'zz55i'. Use na.rm = TRUE to ignore them.")
# })
#
#
# # ** wrong or missing parameters ------------------------------------------
#
# test_that("throws an error if there are negative values in variable",{
#
# file_1 <- tibble::tibble(var_ = c(seq(-5, 500)))
#
# # epsilon < 1
# expect_error(compute_atkinson(file = file_1,
# file_name = "aa55i",
# variable = "var_",
# epsilon = 0.9),
# "There were negative values in 'var_' 'aa55i'. Negative values are not allowed in 'compute_atkinson()'.",
# fixed = TRUE)
#
# # epsilon == 1
# expect_error(compute_atkinson(file = file_1,
# file_name = "aa55i",
# variable = "var_",
# epsilon = 1),
# "There were negative values in 'var_' 'aa55i'. Negative values are not allowed in 'compute_atkinson()'.",
# fixed = TRUE)
#
# # epsilon > 1
# expect_error(compute_atkinson(file = file_1,
# file_name = "aa55i",
# variable = "var_",
# epsilon = 1.1),
# "There were negative values in 'var_' 'aa55i'. Negative values are not allowed in 'compute_atkinson()'.",
# fixed = TRUE)
#
# })
#
#
# test_that("throws an error if epsilon is 0 or negative",{
#
# file_ <- tibble::tibble(var_ = c(seq(-5, 500)))
#
# expect_error(compute_atkinson(file = file_,
# file_name = "aa55i",
# variable = "var_",
# epsilon = 0),
# "'epsilon' needs to be larger than 0.",
# fixed = TRUE)
#
# expect_error(compute_atkinson(file = file_,
# file_name = "aa55i",
# variable = "var_",
# epsilon = -0.1),
# "'epsilon' needs to be larger than 0.",
# fixed = TRUE)
#
# })
#
# # TO DO: KEEP COPYING TESTS FROM compute_percentiles and compute_ratio!
# # throws a warning if there are negative values in variable
#
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.