Merge pull request #75 from nutriverse/cran-release-v0.2.0

CRAN release v0.2.0

Author: ernestguevarra

.Rbuildignore

@@ -26,3 +26,4 @@
 ^CODE_OF_CONDUCT\.md$
 ^codecov\.yml$
 ^_pkgdown\.yml$
+^revdep$

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: nipnTK
 Type: Package
 Title: National Information Platforms for Nutrition Anthropometric Data Toolkit
-Version: 0.1.2.9000
+Version: 0.2.0
 Authors@R: c(
     person(given = "Mark", 
            family = "Myatt", 
@@ -23,7 +23,6 @@ Depends: R (>= 2.10)
 Imports: 
     stats,
     graphics,
-    bbw,
     withr
 Suggests: 
     testthat,

NAMESPACE

@@ -25,7 +25,6 @@ export(pyramid.plot)
 export(qqNormalPlot)
 export(sexRatioTest)
 export(skewKurt)
-importFrom(bbw,recode)
 importFrom(graphics,abline)
 importFrom(graphics,axTicks)
 importFrom(graphics,axis)

NEWS.md

@@ -1,3 +1,20 @@
+# nipnTK 0.2.0
+
+## Bug fixes
+
+* Resolved issue with `ageRatioTest()` not working properly when age has
+missing values
+
+* Resolved issue with `ageRatioTest()` not providing appropriate results when
+age values are numeric
+
+## General updates
+
+* Updated general package documentation
+
+* Added CITATION entry
+
+
 # nipnTK 0.1.2.9000
 
 Third release of `nipnTK`. This is a GitHub-only development release. In this

R/ageChildren.R

@@ -1,14 +1,21 @@
 ################################################################################
 #
-#' Goodness of fit to an expected (model-based) age distribution
+#' Goodness of fit to an expected model-based age distribution
 #'
-#' @param age Vector of ages
-#' @param u5mr Under five years mortality rate as deaths / 10,000 persons / day
-#' @param groups Age groupings specified as recodes parameter in the
-#'   [bbw::recode()] function; default is
-#'   `"6:17=1; 18:29=2; 30:41=3; 42:53=4; 54:59=5"`
+#' A simple model-based method for calculating expected numbers using
+#' exponential decay in a population in which births and deaths balance each
+#' other and with a 1:1 male to female sex ratio. This function is built
+#' specifically to test goodness of fit for a sample of children aged 6-59
+#' months old grouped into four 1 year age groups and 1 half year age group
+#' (6 to less than 18 months, 18 to less than 30 months, 30 to less than 42
+#' months, 42 to less than 54 months, and 54 months to less than 60 months).
 #'
-#' @return A list of class "ageChildren" with:
+#' @param age A vector of ages. Should either be in whole months (integer) or in
+#'   calculated decimal months (numeric).
+#' @param u5mr A numeric value for under five years mortality rate expressed as
+#'   deaths / 10,000 persons / day. Default is set to 1.
+#'
+#' @returns A list of class "ageChildren" with:
 #'
 #' | **Variable** | **Description** |
 #' | :--- | :--- |
@@ -42,24 +49,46 @@
 ################################################################################
 
 ageChildren <- function(age,
-                        u5mr = 0,
-                        groups = "6:17=1; 18:29=2; 30:41=3; 42:53=4; 54:59=5") {
-  ycag <- bbw::recode(age, groups)
+                        u5mr = 1) {
+  ## If age is numeric ----
+  if (is.numeric(age)) age <- floor(age)
+
+  ## If age is integer ----
+  if (is.integer(age)) age <- age
+
+  ## If x is not numeric or integer ----
+  if (!is.numeric(age) & !is.integer(age))
+    stop("Age should be of class integer or numeric. Try again.")
+
+  ## Check that u5mr is numeric ----
+  if (!is.numeric(u5mr))
+    stop ("Under-5 mortality rate should be numeric. Try again.")
+
+  ## Create breaks ----
+  breaks <- c(6, 18, 30, 42, 54, 60)
+
+  ## Create age groupings based on breaks ----
+  ycag <- cut(
+    age, breaks = breaks, labels = seq_len(length(breaks) - 1),
+    include.lowest = TRUE, right = FALSE,
+  )
+
+  ## Model the age distribution ----
   z <- (u5mr / 10000) * 365.25
-  t <- 0:4
-  p <- exp(-z * 0:4)
+  t <- seq(from = 0, to = length(breaks) - 2, by = 1)
+  p <- exp(-z * t)
   d <- c(1, 1, 1, 1, 0.5)
   p <- d * p / sum(d * p)
   expected <- p * sum(table(ycag))
-  names(expected) <- 1:5
-  observed <- fullTable(ycag, values = 1:5)
-  X2 <- sum((observed - expected)^2 / expected)
-  pX2 <- stats::pchisq(X2, df = 4, lower.tail = FALSE)
+  names(expected) <- seq_len(length(breaks) - 1)
+  observed <- fullTable(ycag, values = seq_len(length(breaks) - 1))
+  X2 <- sum((observed - expected) ^ 2 / expected)
+  pX2 <- stats::pchisq(X2, df = length(breaks) - 2, lower.tail = FALSE)
   result <- list(u5mr = u5mr,
                  observed = observed,
                  expected = expected,
                  X2 = X2,
-                 df = 4,
+                 df = length(breaks) - 2,
                  p = pX2)
   class(result) <- "ageChildren"
   return(result)
@@ -73,7 +102,7 @@ ageChildren <- function(age,
 #' @param x Object resulting from applying [ageChildren()] function
 #' @param ... Additional [print()] arguments
 #'
-#' @return Printed output of [ageChildren()] function
+#' @returns Printed output of [ageChildren()] function
 #'
 #' @examples
 #' # Print Chi-Squared test for age of children in dp.ex02 sample dataset using
@@ -103,7 +132,7 @@ print.ageChildren <- function(x, ...) {
 #' @param x Object resulting from applying [ageChildren()] function
 #' @param ... Additional [barplot()] graphical parameters
 #'
-#' @return Bar plot comparing table of observed counts vs table of expected
+#' @returns Bar plot comparing table of observed counts vs table of expected
 #'   counts
 #'
 #' @examples

R/ageHeaping.R

@@ -7,10 +7,11 @@
 #' very common. This is a major reason why data from nutritional anthropometry
 #' surveys is often analysed and reported using broad age groups.
 #'
-#' @param x Vector of ages
+#' @param x A vector of ages. Should either be in whole months (integer) or in
+#'   calculated decimal months (numeric).
 #' @param divisor Divisor (usually 5, 6, 10, or 12); default is 12
 #'
-#' @return A list of class "ageHeaping" with:
+#' @returns A list of class "ageHeaping" with:
 #'
 #' | **Variable** | **Description** |
 #' | :--- | :--- |
@@ -38,12 +39,14 @@
 ################################################################################
 
 ageHeaping <- function(x, divisor = 12) {
+  ## If x is not numeric or integer ----
+  if (!is.numeric(x) & !is.integer(x))
+    stop("Age should be of class integer or numeric. Try again.")
+
   dataName <- deparse(substitute(x))
   r <- x %% divisor
   tab <- fullTable(r, values = 0:(divisor - 1))
-  names(dimnames(tab)) <- paste("Remainder of ",
-                                dataName, " / ",
-                                divisor, sep = "")
+  names(dimnames(tab)) <- paste0("Remainder of ", dataName, " / ", divisor)
   chiSq <- stats::chisq.test(tab)
   pct <- round(prop.table(tab) * 100, 1)
   result <- list(X2 = chiSq$statistic, df = chiSq$parameter,
@@ -60,7 +63,7 @@ ageHeaping <- function(x, divisor = 12) {
 #' @param x Object resulting from applying the [ageHeaping()] function
 #' @param ... Additional [print()] arguments
 #'
-#' @return Printed output of the [ageHeaping()] function
+#' @returns Printed output of the [ageHeaping()] function
 #'
 #' @examples
 #' # Print age heaping test on SMART survey data in Kabul, Afghanistan (dp.ex02)
@@ -93,7 +96,7 @@ print.ageHeaping <- function(x, ...) {
 #' @param cex Character expansion (numeric); default is 0.75
 #' @param ... Additional [plot()] graphical parameters
 #'
-#' @return Barplot of frequency of remainders of age when divided by a specified
+#' @returns Barplot of frequency of remainders of age when divided by a specified
 #' divisor
 #'
 #' @examples

R/ageRatioTest.R

@@ -9,7 +9,7 @@
 #' of the observed ratio to the expected ratio is then compared statistically
 #' using Chi-squared test.
 #'
-#' @param x A vector for age. Should either be in whole months (integer) or in
+#' @param x A vector of ages. Should either be in whole months (integer) or in
 #'   calculated decimal months (numeric).
 #' @param ratio Expected age ratio. Default is 0.85.
 #'
@@ -75,7 +75,7 @@ ageRatioTest <- function(x, ratio = 0.85) {
 #' @param x Object resulting from applying [ageRatioTest()] function
 #' @param ... Additional [print()] arguments
 #'
-#' @return Printed output of [ageRatioTest()] function
+#' @returns Printed output of [ageRatioTest()] function
 #'
 #' @examples
 #' # Print age-ratio test results for survey dataset from Kabul, Afghanistan

R/boxText.R

@@ -10,7 +10,7 @@
 #' @param lwd Border width
 #' @param pad Add padding to (L) and (R) ends of bounding box
 #'
-#' @return NULL
+#' @returns NULL
 #'
 #' @examples
 #' ## Use of boxtext in the ageHeaping plot function

R/digitPreference.R

@@ -17,12 +17,12 @@
 #' WHO MONICA Project e-publications No. 9, WHO, Geneva, May 1998 available
 #' from \url{https://www.thl.fi/publications/monica/bp/bpqa.htm}}
 #'
-#' @param x Numeric vector
-#' @param digits Number of decimal places in `x`. using `digits = 1`
+#' @param x Numeric vector of measurements
+#' @param digits Number of decimal places in `x`. Using `digits = 1`
 #'   (e.g.) allows 105 to be treated as 105.0
 #' @param values A vector of possible values for the final digit (default = 0:9)
 #'
-#' @return A list of class `"digitPreference"` with:
+#' @returns A list of class `"digitPreference"` with:
 #'
 #' | **Variable** | **Description** |
 #' | :--- | :--- |
@@ -70,7 +70,7 @@ digitPreference <- function(x, digits = 1, values = 0:9) {
 #' @param x Object resulting from applying the [digitPreference()] function.
 #' @param ... Additional [print()] parameters
 #'
-#' @return Printed output of [digitPreference()] function
+#' @returns Printed output of [digitPreference()] function
 #'
 #' @examples
 #' # Print output of digit preference test applied to anthropometric data from a
@@ -102,7 +102,7 @@ print.digitPreference <- function(x, ...) {
 #' @param cex Character expansion; default is 0.75
 #' @param ... Additional [plot()] parameters
 #'
-#' @return Plotted output of [digitPreference()] function comparing the
+#' @returns Plotted output of [digitPreference()] function comparing the
 #' frequencies of the various final digits
 #'
 #' @examples

R/fullTable.R

@@ -6,7 +6,7 @@
 #' @param values A vector of values to be included in a table. Default is:
 #'   `min(x, na.rm = TRUE):max(x, na.rm = TRUE)`
 #'
-#' @return A table object including zero cells
+#' @returns A table object including zero cells
 #'
 #' @examples
 #' # Generate some artificial data and then apply `fullTable()`