Skip to content

Commit 8a9b730

Browse files
Merge pull request #57 from nutriverse/dev
refactor `ageRatioTest()` function
2 parents bdc57be + 5d24a56 commit 8a9b730

File tree

4 files changed

+107
-14
lines changed

4 files changed

+107
-14
lines changed

R/ageRatioTest.R

Lines changed: 26 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -2,12 +2,18 @@
22
#
33
#' Age ratio test
44
#'
5-
#' Age Ratio Test is an age-related test of survey and data quality.
5+
#' Age ratio test is an age-related test of survey and data quality. In this
6+
#' test, the ratio of the number of children aged from 6 to 29 months to the
7+
#' number of children aged from 30 to 59 months is calculated. This ratio is
8+
#' then compared to an expected ratio (usually set at 0.85). The difference
9+
#' of the observed ratio to the expected ratio is then compared statistically
10+
#' using Chi-squared test.
611
#'
7-
#' @param x Numeric vector (age)
8-
#' @param ratio Expected age ratio
12+
#' @param x A vector for age. Should either be in whole months (integer) or in
13+
#' calculated decimal months (numeric).
14+
#' @param ratio Expected age ratio. Default is 0.85.
915
#'
10-
#' @return A lit of class `"ageRatioTest"` with:
16+
#' @returns A lit of class `"ageRatioTest"` with:
1117
#'
1218
#' | **Variable** | **Description** |
1319
#' | :--- | :--- |
@@ -20,7 +26,7 @@
2026
#' | *p* | `p-value` for Chi-squared test |
2127
#'
2228
#' @examples
23-
#' # Age-ratio test on survey dataset from Kabul, Afghanistan (dp.ex02)
29+
#' # Age-ratio test on survey dataset from Kabul, Afghanistan (`dp.ex02`)
2430
#' # with an age ratio of 0.85
2531
#' svy <- dp.ex02
2632
#' ageRatioTest(svy$age, ratio = 0.85)
@@ -34,11 +40,22 @@
3440
################################################################################
3541

3642
ageRatioTest <- function(x, ratio = 0.85) {
37-
g <- recode(x, "6:29=1; 30:59=2")
43+
## If x is numeric ----
44+
if (is.numeric(x)) x <- floor(x)
45+
46+
## If x is integer ----
47+
if (is.integer(x)) x <- x
48+
49+
## If x is not numeric or integer ----
50+
if (!is.numeric(x) & !is.integer(x))
51+
stop("Age should be of class integer or numeric. Try again.")
52+
53+
## Calculate age ratio ----
54+
g <- ifelse(x < 30, 1, 2)
3855
expectedP <- ratio / (ratio + 1)
39-
observedP <- sum(g == 1)/ sum(table(g))
56+
observedP <- sum(g == 1, na.rm = TRUE)/ sum(table(g))
4057
observedR <- observedP / (1 - observedP)
41-
X2 <- prop.test(sum(g == 1), sum(table(g)), p = expectedP)
58+
X2 <- prop.test(sum(g == 1, na.rm = TRUE), sum(table(g)), p = expectedP)
4259
result <- list(expectedR = ratio,
4360
expectedP = expectedP,
4461
observedR = observedR,
@@ -61,7 +78,7 @@ ageRatioTest <- function(x, ratio = 0.85) {
6178
#' @return Printed output of [ageRatioTest()] function
6279
#'
6380
#' @examples
64-
#' # Print age-ratio test results for survey dataset from Kabul, Afghanistan (dp.ex02)
81+
#' # Print age-ratio test results for survey dataset from Kabul, Afghanistan
6582
#' svy <- dp.ex02
6683
#' print(ageRatioTest(svy$age, ratio = 0.85))
6784
#'

man/ageRatioTest.Rd

Lines changed: 10 additions & 4 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

man/print.ageRatioTest.Rd

Lines changed: 1 addition & 1 deletion
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

tests/testthat/test_ageRatioTest.R

Lines changed: 70 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,3 +25,73 @@ test_that("names of art", {
2525
test_that("print(art) message exists", {
2626
expect_output(print(art))
2727
})
28+
29+
## Test that function works when age has NAs
30+
31+
svy <- dp.ex02
32+
33+
svy$age[sample(seq_len(length(svy$age)), 5)] <- NA_integer_
34+
35+
art <- ageRatioTest(svy$age, ratio = 0.85)
36+
37+
test_that("art is ageRatioTest", {
38+
expect_is(art, "ageRatioTest")
39+
})
40+
41+
test_that("art is list", {
42+
expect_true(is.list(art))
43+
})
44+
45+
test_that("names of art", {
46+
expect_equal(names(art)[1], "expectedR")
47+
expect_equal(names(art)[2], "expectedP")
48+
expect_equal(names(art)[3], "observedR")
49+
expect_equal(names(art)[4], "observedP")
50+
expect_equal(names(art)[5], "X2")
51+
expect_equal(names(art)[6], "df")
52+
expect_equal(names(art)[7], "p")
53+
})
54+
55+
test_that("print(art) message exists", {
56+
expect_output(print(art))
57+
})
58+
59+
## Test that function works when age is numeric value
60+
61+
svy <- dp.ex02
62+
63+
svy$age <- as.numeric(svy$age)
64+
65+
art <- ageRatioTest(svy$age, ratio = 0.85)
66+
67+
test_that("art is ageRatioTest", {
68+
expect_is(art, "ageRatioTest")
69+
})
70+
71+
test_that("art is list", {
72+
expect_true(is.list(art))
73+
})
74+
75+
test_that("names of art", {
76+
expect_equal(names(art)[1], "expectedR")
77+
expect_equal(names(art)[2], "expectedP")
78+
expect_equal(names(art)[3], "observedR")
79+
expect_equal(names(art)[4], "observedP")
80+
expect_equal(names(art)[5], "X2")
81+
expect_equal(names(art)[6], "df")
82+
expect_equal(names(art)[7], "p")
83+
})
84+
85+
test_that("print(art) message exists", {
86+
expect_output(print(art))
87+
})
88+
89+
90+
## Test that function works when age is character value
91+
92+
svy <- dp.ex02
93+
94+
svy$age <- as.character(svy$age)
95+
96+
expect_error(ageRatioTest(svy$age))
97+

0 commit comments

Comments
 (0)