tests/testthat/test-formatEstimateValue.R

In visOmopResults: Graphs and Tables for OMOP Results

test_that("formatEstimateValue", {
  result <- mockSummarisedResult()
  # default decimal input ----
  result_output <- formatEstimateValue(result,
                                       decimals = c(
                                         integer = 0, numeric = 2, percentage = 1,
                                         proportion = 3
                                       ),
                                       decimalMark = "@",
                                       bigMark = "=")
  ## Test big Mark ----
  counts_in  <- result$estimate_value[result_output$estimate_type == "integer"]
  counts_out <- result_output$estimate_value[result_output$estimate_type == "integer"]

  zeroMarks_out <- base::paste(counts_out[base::nchar(counts_in) < 4], collapse = "")
  zeroMarks_out <- nchar(zeroMarks_out) - nchar(gsub("=", "", zeroMarks_out))

  oneMark_in  <- sum(base::nchar(counts_in) < 7 & base::nchar(counts_in) > 3)
  oneMark_out <- base::paste(counts_out[base::nchar(counts_in) < 7 & base::nchar(counts_in) > 3], collapse = "")
  oneMark_out <- nchar(oneMark_out) - nchar(gsub("=", "", oneMark_out))

  twoMarks_in  <- sum(base::nchar(counts_in) == 7)*2
  twoMarks_out <- base::paste(counts_out[base::nchar(counts_in) == 7], collapse = "")
  twoMarks_out <- nchar(twoMarks_out) - nchar(gsub("=", "", twoMarks_out))

  # check nummber of marks
  expect_equal(0, zeroMarks_out)
  expect_equal(oneMark_in, oneMark_out)
  expect_equal(twoMarks_in, twoMarks_out)
  # check type of mark
  expect_identical(as.integer(counts_in), as.integer(base::gsub("=", "", counts_out)))

  ## Test decimals (default input) ----
  # check estimate types
  expect_equal(result_output |>
                    dplyr::filter(grepl("@", .data$estimate_value)) |>
                    dplyr::distinct(estimate_type) |>
                    dplyr::pull(),
                    c("numeric", "percentage"))

  # check number of decimals
  ## numeric
  numeric <- result_output$estimate_value[result_output$estimate_type == "numeric"]
  if (length(numeric) > 0) {
    expect_true(lapply(strsplit(numeric, "@"), function(x) {x[[2]]}) |>
                  unlist() |> nchar() |> mean() == 2)
  }
  ## percentage
  percentage <- result_output$estimate_value[result_output$estimate_type == "percentage"]
  if (length(percentage) > 0) {
    expect_true(lapply(strsplit(percentage, "@"), function(x) {x[[2]]}) |>
                  unlist() |> nchar() |> mean() == 1)
  }

  # Test decimals ----
  result_output <- formatEstimateValue(result,
                                       decimals = c(
                                         integer = 3, numeric = 0
                                       ),
                                       decimalMark = "_",
                                       bigMark = "%")
  # check estimate types
  expect_true(result_output |>
                    dplyr::filter(grepl("_", .data$estimate_value)) |>
                    dplyr::distinct(estimate_type) |>
                    dplyr::pull() == "integer")

  # check number of decimals
  ## integer
  integer <- result_output$estimate_value[result_output$estimate_type == "integer"]
  if (length(integer) > 0) {
    expect_true(lapply(strsplit(integer, "_"), function(x) {x[[2]]}) |>
                  unlist() |> nchar() |> mean() == 3)
  }
  ## numeric
  numeric <- result_output$estimate_value[result_output$estimate_type == "numeric"]
  if (length(numeric) > 0) {
    expect_false(all(grepl("_", numeric)))
  }
  ## percentage
  expect_identical(result_output$estimate_value[result_output$estimate_type == "percentage"],
                   result$estimate_value[result$estimate_type == "percentage"])

  # Test decimals ----
  result_output <- formatEstimateValue(result,
                                       decimals = 4,
                                       decimalMark = "_",
                                       bigMark = "%")
  # check estimate types
  expect_true(all(result_output |>
                    dplyr::filter(grepl("_", .data$estimate_value)) |>
                    dplyr::distinct(estimate_type) |>
                    dplyr::pull() ==
                    unique(result$estimate_type)))

  # check number of decimals
    expect_true(lapply(strsplit(result_output$estimate_value, "_"), function(x) {x[[2]]}) |>
                  unlist() |> nchar() |> mean() == 4)


    # Estimate name input ----
    result_output <- formatEstimateValue(result,
                                         decimals = c(mean = 2, sd = 3, count = 0))

    # check number of decimals
    ## mean
    mean <- result_output$estimate_value[result_output$estimate_name == "mean"]
    if (length(mean) > 0) {
      expect_true(lapply(strsplit(mean, ".", fixed = TRUE), function(x) {x[[2]]}) |>
                    unlist() |> nchar() |> mean() == 2)
    }
    ## sd
    sd <- result_output$estimate_value[result_output$estimate_name == "sd"]
    if (length(sd) > 0) {
      expect_true(lapply(strsplit(sd, ".", fixed = TRUE), function(x) {x[[2]]}) |>
                    unlist() |> nchar() |> mean() == 3)
    }
    ## count
    count <- result_output$estimate_value[result_output$estimate_name == "count"]
    if (length(count) > 0) {
      expect_false(all(grepl(".", count, fixed = TRUE)))
    }
    ## percentage
    expect_identical(result_output$estimate_value[result_output$estimate_name == "percentage"],
                     result$estimate_value[result$estimate_name == "percentage"])

    # Hierarchy ----
    result_output <- formatEstimateValue(result,
                                         decimals = c(numeric = 2, mean = 3))
    mean <- result_output$estimate_value[result_output$estimate_name == "mean"]
    if (length(mean) > 0) {
      expect_true(lapply(strsplit(mean, ".", fixed = TRUE), function(x) {x[[2]]}) |>
                    unlist() |> nchar() |> mean() == 3)
    }
    numeric <- result_output$estimate_value[result_output$estimate_type == "numeric" & result_output$estimate_name != "mean"]
    if (length(numeric) > 0) {
      expect_true(lapply(strsplit(numeric, ".", fixed = TRUE), function(x) {x[[2]]}) |>
                    unlist() |> nchar() |> mean() == 2)
    }

    ## Test NULL decimals ----
    result_output <- formatEstimateValue(result,
                                         decimals = NULL,
                                         decimalMark = "..",
                                         bigMark = ",")

    ## count
    counts_in  <- result$estimate_value[result_output$estimate_type == "integer"]
    counts_out <- result_output$estimate_value[result_output$estimate_type == "integer"]

    zeroMarks_out <- base::paste(counts_out[base::nchar(counts_in) < 4], collapse = "")
    zeroMarks_out <- nchar(zeroMarks_out) - nchar(gsub("=", "", zeroMarks_out))

    oneMark_in  <- sum(base::nchar(counts_in) < 7 & base::nchar(counts_in) > 3)
    oneMark_out <- base::paste(counts_out[base::nchar(counts_in) < 7 & base::nchar(counts_in) > 3], collapse = "")
    oneMark_out <- nchar(oneMark_out) - nchar(gsub("=", "", oneMark_out))

    twoMarks_in  <- sum(base::nchar(counts_in) == 7)*2
    twoMarks_out <- base::paste(counts_out[base::nchar(counts_in) == 7], collapse = "")
    twoMarks_out <- nchar(twoMarks_out) - nchar(gsub("=", "", twoMarks_out))

    if (length(counts_out) > 0) {
      expect_false(all(grepl("..", counts_out, fixed = TRUE)))
    }
    ## mean
    mean_in <- result$estimate_value[result$estimate_name == "mean"]
    mean_out <- result_output$estimate_value[result_output$estimate_name == "mean"]
    if (length(mean) > 0) {
      expect_equal(mean_out, base::format(as.numeric(mean_in), decimal.mark = "..", trim = TRUE, justify = "none"))
    }
    ## sd
    sd_in <- result$estimate_value[result$estimate_name == "sd"]
    sd_out <- result_output$estimate_value[result_output$estimate_name == "sd"]
    if (length(sd) > 0) {
      expect_equal(sd_out, base::format(as.numeric(sd_in), decimal.mark = "..", trim = TRUE, justify = "none"))
    }

    ## Test NULL bigMark ----
    result_output <- formatEstimateValue(result,
                                         decimals = 0,
                                         decimalMark = ".",
                                         bigMark = NULL)
    expect_equal(result_output$estimate_value[result_output$estimate_name == "count"],
                 result$estimate_value[result$estimate_name == "count"])

    ## Test NULL decimals + NULL bigMark ----
    result_output <- formatEstimateValue(result,
                                         decimals = NULL,
                                         decimalMark = ".",
                                         bigMark = NULL)
    expect_equal(result_output$estimate_value[result_output$estimate_name == "count"],
                 result$estimate_value[result$estimate_name == "count"])
    ## mean
    mean_in <- result$estimate_value[result$estimate_name == "mean"]
    mean_out <- result_output$estimate_value[result_output$estimate_name == "mean"]
    if (length(mean) > 0) {
      expect_equal(mean_out, base::format(as.numeric(mean_in), decimal.mark = ".", trim = TRUE, justify = "none"))
    }
    ## sd
    sd_in <- result$estimate_value[result$estimate_name == "sd"]
    sd_out <- result_output$estimate_value[result_output$estimate_name == "sd"]
    if (length(sd) > 0) {
      expect_equal(sd_out, base::format(as.numeric(sd_in), decimal.mark = ".", trim = TRUE, justify = "none"))
    }

    # no warning when estimate value is NA
    result <- mockSummarisedResult() |>
      dplyr::union_all(dplyr::tibble(
        "result_id" = as.integer(1),
        "cdm_name" = "mock",
        "group_name" = "cohort_name",
        "group_level" = "cohort3",
        "strata_name" = rep(c(
          "overall", rep("age_group &&& sex", 4), rep("sex", 2), rep("age_group", 2)
        ), 2),
        "strata_level" = rep(c(
          "overall", "<40 &&& Male", ">=40 &&& Male", "<40 &&& Female",
          ">=40 &&& Female", "Male", "Female", "<40", ">=40"
        ), 2),
        "variable_name" = "number subjects",
        "variable_level" = NA_character_,
        "estimate_name" = "count",
        "estimate_type" = "integer",
        "estimate_value" = NA_character_,
        "additional_name" = "overall",
        "additional_level" = "overall"
      ))

    expect_no_warning(formatEstimateValue(result,
                                         decimals = 2,
                                         decimalMark = ".",
                                         bigMark = ","))

    # Wroing input ----
    expect_error(formatEstimateValue(result,
                                     decimals = NA,
                                     decimalMark = "_",
                                     bigMark = "%"))
    expect_error(formatEstimateValue(result,
                                     decimals = c("hola" = 0),
                                     decimalMark = "_",
                                     bigMark = "%"))
    expect_error(formatEstimateValue(result,
                                     decimals = 2,
                                     decimalMark = NA,
                                     bigMark = "%"))
    expect_error(formatEstimateValue(result,
                                     decimals = c(count = 1, lala = 0)),
                 "lala do not correspond to estimate_type or estimate_name values.")
    expect_error(formatEstimateValue(result,
                                     decimals = 1,
                                     decimalMark = NULL,
                                     bigMark = ","))
    expect_error(formatEstimateValue(result |> dplyr::select(-estimate_value)))

})

test_that("formatEstimateValue, dates", {
  result <- dplyr::tibble(
    "result_id" = as.integer(1),
    "cdm_name" = "mock",
    "group_name" = "cohort_name",
    "group_level" = c(rep("cohort1", 9), rep("cohort2", 9)),
    "strata_name" = rep(c(
      "overall", rep("age_group &&& sex", 4), rep("sex", 2), rep("age_group", 2)
    ), 2),
    "strata_level" = rep(c(
      "overall", "<40 &&& Male", ">=40 &&& Male", "<40 &&& Female",
      ">=40 &&& Female", "Male", "Female", "<40", ">=40"
    ), 2),
    "variable_name" = "number subjects",
    "variable_level" = NA_character_,
    "estimate_name" = "count",
    "estimate_type" = "integer",
    "estimate_value" = round(10000000*stats::runif(18)) |> as.character(),
    "additional_name" = "overall",
    "additional_level" = "overall"
  ) |>
    dplyr::union_all(
      dplyr::tibble(
        "result_id" = as.integer(1),
        "cdm_name" = "mock",
        "group_name" = "cohort_name",
        "group_level" = c(rep("cohort1", 9), rep("cohort2", 9)),
        "strata_name" = rep(c(
          "overall", rep("age_group &&& sex", 4), rep("sex", 2), rep("age_group", 2)
        ), 2),
        "strata_level" = rep(c(
          "overall", "<40 &&& Male", ">=40 &&& Male", "<40 &&& Female",
          ">=40 &&& Female", "Male", "Female", "<40", ">=40"
        ), 2),
        "variable_name" = "start date",
        "variable_level" = NA_character_,
        "estimate_name" = "date",
        "estimate_type" = "date",
        "estimate_value" = as.Date("2020-10-01") |> as.character(),
        "additional_name" = "overall",
        "additional_level" = "overall"
      )
    ) |>
    omopgenerics::newSummarisedResult(
      settings = dplyr::tibble(
        "result_id" = as.integer(1),
        "result_type" = "mock_summarised_result",
        "package_name" = "visOmopResults",
        "package_version" = utils::packageVersion("visOmopResults") |>
          as.character()
      )
    )
  expect_no_error(result_out <- formatEstimateValue(result, decimals = 0))
  expect_true(class(as.Date(result_out |> dplyr::filter(estimate_type == "date") |> dplyr::pull(estimate_value))) == "Date")

  expect_warning(result_out <- formatEstimateValue(result, decimals = c(date = 1)))
  expect_true(class(as.Date(result_out |> dplyr::filter(estimate_type == "date") |> dplyr::pull(estimate_value))) == "Date")
})