-
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
refactor coverage classifier functions; fix #64
- Loading branch information
1 parent
0224366
commit d2fa20c
Showing
6 changed files
with
153 additions
and
109 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 | ||
} |
This file was deleted.
Oops, something went wrong.
Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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)) | ||
) | ||
}) |