From d2fa20c7620bb9f4d3d2e3a5032c5304ff7ee2d5 Mon Sep 17 00:00:00 2001 From: Ernest Guevarra Date: Thu, 26 Dec 2024 12:07:06 +0000 Subject: [PATCH] refactor coverage classifier functions; fix #64 --- NAMESPACE | 4 +- R/03-classify_coverage.R | 139 ++++++++++++--------- man/classify_coverage.Rd | 40 ------ man/lqas_classify.Rd | 47 +++++++ pkgdown/_pkgdown.yml | 3 +- tests/testthat/test-03-classify_coverage.R | 29 +++-- 6 files changed, 153 insertions(+), 109 deletions(-) delete mode 100644 man/classify_coverage.Rd create mode 100644 man/lqas_classify.Rd diff --git a/NAMESPACE b/NAMESPACE index af68a7d..f90db71 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,13 +2,15 @@ S3method(plot,lqasSim) S3method(print,lqasClass) -export(classify_coverage) export(get_n_cases) export(get_n_clusters) export(get_sample_d) export(get_sample_n) export(get_sampling_clusters) export(get_sampling_list) +export(lqas_classify) +export(lqas_classify_) +export(lqas_classify_coverage) export(lqas_get_class_prob) export(lqas_simulate_population) export(lqas_simulate_run) diff --git a/R/03-classify_coverage.R b/R/03-classify_coverage.R index 3e27a5b..a868c4b 100644 --- a/R/03-classify_coverage.R +++ b/R/03-classify_coverage.R @@ -1,96 +1,123 @@ #' -#' Classify coverage results +#' LQAS classifier #' -#' @param n_in Number (integer) of cases found in the programme -#' @param n_total Number (integer) of children under 5 years sampled -#' @param standard Decision rule standard/s. Should be between 0 and 1. At -#' least one standard should be provided for a two-tier coverage classifier. -#' Two standards should be provided for a three-tier coverage classifier. -#' Default is a three-tier classifier with rule set at 0.2 and 0.5. +#' @param n Number of cases found. +#' @param n_total Number sampled. +#' @param threshold Decision rule threshold/s. Should be between 0 and 1. At +#' least one threshold should be provided for a two-tier classifier. Two +#' thresholds should be provided for a three-tier classifier. Default is a +#' three-tier classifier with rule set at 0.2 and 0.5. #' -#' @return A character value or vector indicating coverage classification. If -#' `standard` is a single value, returns **"Satisfactory"** if coverage is -#' above `standard` and **"Not satisfactory"** if coverage is below or -#' equal to `standard`. If `standard` is two values, returns **"Low"** if -#' coverage is below or equal to lower standard, **"High"** if coverage is -#' above the higher standard, and **"Moderate"** for all other coverage -#' values. +#' @returns A character value or vector indicating classification. If +#' `threshold` is a single value, the generic function returns *1* if `n` is +#' greater than the threshold else *0*. The coverage classifier +#' function returns **"Satisfactory"** if `n` is greater than the threshold +#' else **"Not satisfactory"**. If `threshold` is two values, the generic +#' function returns *1* if `n` is greater than the first threshold and *2* if +#' `n` is greater than the second threshold else *0*. The CMAM coverage +#' classifier returns **"Low"** if `n` is below or equal to lower threshold, +#' **"High"** if `n` is above the higher threshold, and **"Moderate"** for +#' all other values of `n`. #' #' @author Ernest Guevarra #' #' @examples -#' classify_coverage(n_in = 6, n_total = 40) -#' with(survey_data, -#' classify_coverage(n_in = in_cases, n_total = n) -#' ) +#' lqas_classify_coverage(n = 6, n_total = 40) +#' with(survey_data, lqas_classify_coverage(n = in_cases, n_total = n)) #' #' @export +#' @rdname lqas_classify #' -classify_coverage <- function(n_in, n_total, standard = c(0.2, 0.5)) { - coverage_class <- Map( - f = classify_coverage_, - n_in = as.list(n_in), - n_total = as.list(n_total), - standard = rep(list(standard), length(n_in)) - ) - - unlist(coverage_class) -} - -#' -#' @noRd -#' - -classify_coverage_ <- function(n_in, n_total, standard = c(0.2, 0.5)) { - ## Check that standard/s is/are numeric - if (!all(is.numeric(standard))) { +lqas_classify_ <- function(n, n_total, threshold = c(0.2, 0.5)) { + ## Check that threshold/s is/are numeric + if (!all(is.numeric(threshold))) { stop( - "Standard/s should be numeric. Check your values.", call. = TRUE + "Threshold/s should be numeric. Check your values.", call. = TRUE ) } - + ## Sort rule to ensure that first value is the smaller value - standard <- sort(standard) - - ## Check that standard is between 0 and 1 - if (any(standard < 0 | standard > 1)) { + threshold <- sort(threshold) + + ## Check that threshold is between 0 and 1 + if (any(threshold < 0 | threshold > 1)) { stop( - "Standard/s should be between 0 and 1. Check your values.", call. = TRUE + "Threshold/s should be between 0 and 1. Check your values.", + call. = TRUE ) } - - ## Check that difference between standards is at least 0.3 - if (length(standard) == 2) { - if ((standard[2] - standard[1]) < 0.3) { + + ## Check that difference between thresholds is at least 0.3 + if (length(threshold) == 2) { + if ((threshold[2] - threshold[1]) < 0.3) { warning( - "Difference between lower and upper standards is less than 0.3. ", + "Difference between lower and upper thresholds is less than 0.3. ", "This may cause gross mis-classification.", call. = TRUE ) } } - + ## Get d - d <- n_total * standard - + d <- n_total * threshold + ## Two-tier classification if (length(d) == 1) { - coverage_class <- ifelse(n_in > d, "Satisfactory", "Not satisfactory") + coverage_class <- ifelse(n > d, 1, 0) } - + ## Three-tier classification if (length(d) == 2) { coverage_class <- ifelse( - n_in > d[2], "High", + n > d[2], 2, ifelse( - n_in <= d[1], "Low", "Moderate" + n <= d[1], 0, 1 ) ) } - + coverage_class } +#' +#' @export +#' @rdname lqas_classify +#' + +lqas_classify <- function(n, n_total, threshold = c(0.2, 0.5)) { + Map( + f = lqas_classify_, + n = as.list(n), + n_total = as.list(n_total), + threshold = rep(list(threshold), length(n)) + ) |> + unlist() +} +#' +#' @export +#' @rdname lqas_classify +#' + +lqas_classify_coverage <- function(n, n_total, threshold = c(0.2, 0.5)) { + coverage_class <- lqas_classify( + n = n, n_total = n_total, threshold = threshold + ) + if (length(threshold) == 1) { + coverage_label <- ifelse( + coverage_class == 1, "Satisfactory", "Not satisfactory" + ) + } else { + coverage_label <- ifelse( + coverage_class == 0, "Low", + ifelse( + coverage_class == 1, "Moderate", "High" + ) + ) + } + + ## Return coverage_label ---- + coverage_label +} diff --git a/man/classify_coverage.Rd b/man/classify_coverage.Rd deleted file mode 100644 index a38d926..0000000 --- a/man/classify_coverage.Rd +++ /dev/null @@ -1,40 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/03-classify_coverage.R -\name{classify_coverage} -\alias{classify_coverage} -\title{Classify coverage results} -\usage{ -classify_coverage(n_in, n_total, standard = c(0.2, 0.5)) -} -\arguments{ -\item{n_in}{Number (integer) of cases found in the programme} - -\item{n_total}{Number (integer) of children under 5 years sampled} - -\item{standard}{Decision rule standard/s. Should be between 0 and 1. At -least one standard should be provided for a two-tier coverage classifier. -Two standards should be provided for a three-tier coverage classifier. -Default is a three-tier classifier with rule set at 0.2 and 0.5.} -} -\value{ -A character value or vector indicating coverage classification. If -\code{standard} is a single value, returns \strong{"Satisfactory"} if coverage is -above \code{standard} and \strong{"Not satisfactory"} if coverage is below or -equal to \code{standard}. If \code{standard} is two values, returns \strong{"Low"} if -coverage is below or equal to lower standard, \strong{"High"} if coverage is -above the higher standard, and \strong{"Moderate"} for all other coverage -values. -} -\description{ -Classify coverage results -} -\examples{ -classify_coverage(n_in = 6, n_total = 40) -with(survey_data, - classify_coverage(n_in = in_cases, n_total = n) -) - -} -\author{ -Ernest Guevarra -} diff --git a/man/lqas_classify.Rd b/man/lqas_classify.Rd new file mode 100644 index 0000000..f4e8112 --- /dev/null +++ b/man/lqas_classify.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/03-classify_coverage.R +\name{lqas_classify_} +\alias{lqas_classify_} +\alias{lqas_classify} +\alias{lqas_classify_coverage} +\title{LQAS classifier} +\usage{ +lqas_classify_(n, n_total, threshold = c(0.2, 0.5)) + +lqas_classify(n, n_total, threshold = c(0.2, 0.5)) + +lqas_classify_coverage(n, n_total, threshold = c(0.2, 0.5)) +} +\arguments{ +\item{n}{Number of cases found.} + +\item{n_total}{Number sampled.} + +\item{threshold}{Decision rule threshold/s. Should be between 0 and 1. At +least one threshold should be provided for a two-tier classifier. Two +thresholds should be provided for a three-tier classifier. Default is a +three-tier classifier with rule set at 0.2 and 0.5.} +} +\value{ +A character value or vector indicating classification. If +\code{threshold} is a single value, the generic function returns \emph{1} if \code{n} is +greater than the threshold else \emph{0}. The coverage classifier +function returns \strong{"Satisfactory"} if \code{n} is greater than the threshold +else \strong{"Not satisfactory"}. If \code{threshold} is two values, the generic +function returns \emph{1} if \code{n} is greater than the first threshold and \emph{2} if +\code{n} is greater than the second threshold else \emph{0}. The CMAM coverage +classifier returns \strong{"Low"} if \code{n} is below or equal to lower threshold, +\strong{"High"} if \code{n} is above the higher threshold, and \strong{"Moderate"} for +all other values of \code{n}. +} +\description{ +LQAS classifier +} +\examples{ +lqas_classify_coverage(n = 6, n_total = 40) +with(survey_data, lqas_classify_coverage(n = in_cases, n_total = n)) + +} +\author{ +Ernest Guevarra +} diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index c5ed2d7..940499d 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -51,7 +51,8 @@ reference: - starts_with("get_sampling") - title: Coverage classifier - contents: classify_coverage + contents: + - starts_with("lqas_classify") - title: Tests for SLEAC classifier performance contents: diff --git a/tests/testthat/test-03-classify_coverage.R b/tests/testthat/test-03-classify_coverage.R index 37e8b15..82a63e6 100644 --- a/tests/testthat/test-03-classify_coverage.R +++ b/tests/testthat/test-03-classify_coverage.R @@ -1,31 +1,38 @@ - +# Tests for lqas_classify functions -------------------------------------------- test_that("output is character", { - expect_type(classify_coverage(n_in = 6, n_total = 40), "character") + expect_type(lqas_classify_coverage(n = 6, n_total = 40), "character") + expect_type( - classify_coverage( - n_in = survey_data$in_cases, n_total = survey_data$n + lqas_classify_coverage( + n = survey_data$in_cases, n_total = survey_data$n ), "character" ) + expect_type( - classify_coverage(n_in = 6, n_total = 40, standard = 0.5), "character" + lqas_classify_coverage(n = 6, n_total = 40, threshold = 0.5), + "character" ) + expect_type( - classify_coverage( - n_in = survey_data$in_cases, n_total = survey_data$n, standard = 0.5 - ), "character" + lqas_classify_coverage( + n = survey_data$in_cases, n_total = survey_data$n, threshold = 0.5 + ), + "character" ) }) test_that("errors and warnings show correctly", { expect_warning( - classify_coverage(n_in = 6, n_total = 40, standard = c(0.4, 0.5)) + lqas_classify_coverage(n = 6, n_total = 40, threshold = c(0.4, 0.5)) ) + expect_error( - classify_coverage(n_in = 6, n_total = 40, standard = c("0.4", "0.5")) + lqas_classify_coverage(n = 6, n_total = 40, threshold = c("0.4", "0.5")) ) + expect_error( - classify_coverage(n_in = 6, n_total = 40, standard = c(0.4, 1.2)) + lqas_classify_coverage(n = 6, n_total = 40, threshold = c(0.4, 1.2)) ) })