diff --git a/.Rbuildignore b/.Rbuildignore index d8995f4..59e790d 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -26,3 +26,4 @@ ^CODE_OF_CONDUCT\.md$ ^codecov\.yml$ ^_pkgdown\.yml$ +^revdep$ diff --git a/DESCRIPTION b/DESCRIPTION index 2f29ec2..295844c 100644 --- a/DESCRIPTION +++ b/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, diff --git a/NAMESPACE b/NAMESPACE index 4b3685f..9e3b4c8 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index 3a7e983..b95a0ea 100644 --- a/NEWS.md +++ b/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 diff --git a/R/ageChildren.R b/R/ageChildren.R index bba696f..17a7501 100644 --- a/R/ageChildren.R +++ b/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 diff --git a/R/ageHeaping.R b/R/ageHeaping.R index 2d028c6..3d72f42 100644 --- a/R/ageHeaping.R +++ b/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 diff --git a/R/ageRatioTest.R b/R/ageRatioTest.R index f7a16b6..6a5e365 100644 --- a/R/ageRatioTest.R +++ b/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 diff --git a/R/boxText.R b/R/boxText.R index 0b954e9..2e25675 100644 --- a/R/boxText.R +++ b/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 diff --git a/R/digitPreference.R b/R/digitPreference.R index d45f50f..2a84454 100644 --- a/R/digitPreference.R +++ b/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 diff --git a/R/fullTable.R b/R/fullTable.R index e3c699e..312693a 100644 --- a/R/fullTable.R +++ b/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()` diff --git a/R/greensIndex.R b/R/greensIndex.R index 9163fa2..7417567 100644 --- a/R/greensIndex.R +++ b/R/greensIndex.R @@ -25,7 +25,7 @@ #' coded with 1 = case #' @param replicates Number of bootstrap replicates (default is 9999) #' -#' @return A list of class `GI` with names: +#' @returns A list of class `GI` with names: #' #' | **Variable** | **Description** | #' | :--- | :--- | @@ -92,7 +92,7 @@ greensIndex <- function(data, psu, case, replicates = 999) { #' @param x Object resulting from applying the [greensIndex()] function #' @param ... Additional [print()] parameters #' -#' @return Printed output of [greensIndex()] function +#' @returns Printed output of [greensIndex()] function #' #' @examples #' # Apply Green's Index using anthropometric data from a SMART survey in Sudan diff --git a/R/histNormal.R b/R/histNormal.R index 858003e..6f9e4cc 100644 --- a/R/histNormal.R +++ b/R/histNormal.R @@ -10,7 +10,7 @@ #' @param breaks Passed to [hist()] function (`?hist` for details) #' @param ylim `y-axis` limits #' -#' @return NULL +#' @returns NULL #' #' @examples #' # histNormal() with data from a SMART survey in Kabul, Afghanistan diff --git a/R/national.SMART.R b/R/national.SMART.R index 53b16e2..46171b7 100644 --- a/R/national.SMART.R +++ b/R/national.SMART.R @@ -7,7 +7,7 @@ #' @param strata Name of column in `x` that defines the strata #' @param indices Names of columns in `x` containing indices #' -#' @return A data.frame with same structure as `x` with a `flagSMART` +#' @returns A data.frame with same structure as `x` with a `flagSMART` #' column added. This column is coded using sums of powers of two #' #' @examples diff --git a/R/nipnTK.R b/R/nipnTK.R index c6910a9..4787ce4 100644 --- a/R/nipnTK.R +++ b/R/nipnTK.R @@ -2,8 +2,13 @@ # #' NiPN data quality toolkit #' -#' This is a library of R functions for assessing data-quality in nutritional -#' anthropometry surveys. +#' An implementation of the National Information Platforms for Nutrition or +#' NiPN's analytic methods for assessing quality of anthropometric datasets that +#' include measurements of weight, height or length, middle upper arm +#' circumference, sex and age. The focus is on anthropometric status but many of +#' the presented methods could be applied to other variables. This is a library +#' of R functions for assessing data-quality in nutritional anthropometry +#' surveys. #' #' @docType package #' @name nipnTK @@ -12,13 +17,10 @@ #' prop.test qqline qqnorm quantile sd var #' @importFrom graphics abline axTicks axis barplot hist lines par plot rect #' strheight strwidth text -#' @importFrom bbw recode #' @importFrom withr local_par #' # ################################################################################ "_PACKAGE" -## quiets concerns of R CMD check re: the psus and THRESHOLD that appear in bbw -#if(getRversion() >= "2.15.1") utils::globalVariables(c("psu", "THRESHOLD")) diff --git a/R/outliersMD.R b/R/outliersMD.R index ce50550..b11afc8 100644 --- a/R/outliersMD.R +++ b/R/outliersMD.R @@ -4,14 +4,17 @@ #' #' @param x Numeric vector #' @param y Numeric vector -#' @param alpha Critical `alpha` value to detect and outlier (defaults to +#' @param alpha Critical `alpha` value to detect an outlier (defaults to #' 0.001) -#' @return A logical vector (TRUE for an outlier at `p < alpha`) +#' +#' @returns A logical vector (TRUE for an outlier at `p < alpha`) +#' #' @examples #' # Use outliersMD() to detect outliers in an anthropometric data from #' # a SMART survey from the Democratic Republic of Congo (sp.ex01) #' svy <- sp.ex01 #' svy[outliersMD(svy$height,svy$weight), ] +#' #' @export #' # diff --git a/R/outliersUV.R b/R/outliersUV.R index 2ab6691..d7767b8 100644 --- a/R/outliersUV.R +++ b/R/outliersUV.R @@ -5,7 +5,7 @@ #' @param x Numeric vector #' @param fence `IQR` multiplier (defaults to 1.5) #' -#' @return A logical vector (TRUE for an outlier) +#' @returns A logical vector (TRUE for an outlier) #' #' @examples #' # Use outliersUV() to detect univariate outliers in an anthropometric diff --git a/R/pyramid.plot.R b/R/pyramid.plot.R index 80cec4f..62a4889 100644 --- a/R/pyramid.plot.R +++ b/R/pyramid.plot.R @@ -13,7 +13,7 @@ #' colours allocated on a `checkerboard` basis to each bar #' @param ... Other graphical parameters #' -#' @return A table of `x` by `g` (invisible) +#' @returns A table of `x` by `g` (invisible) #' #' @examples #' # Use pyramid.plot() on anthropometric data from a SMART survey in diff --git a/R/qqNormalPlot.R b/R/qqNormalPlot.R index 0c10062..89b82b2 100644 --- a/R/qqNormalPlot.R +++ b/R/qqNormalPlot.R @@ -4,7 +4,7 @@ #' #' @param x A numeric vector #' -#' @return NULL +#' @returns NULL #' #' @examples #' # qqNormalPlot() with data from a SMART survey in Kabul, Afghanistan diff --git a/R/sexRatioTest.R b/R/sexRatioTest.R index fd6ec1c..b9f932a 100644 --- a/R/sexRatioTest.R +++ b/R/sexRatioTest.R @@ -2,11 +2,11 @@ # #' Sex Ratio Test #' -#' @param sex Numeric vector (`sex`) +#' @param sex A vector of values that indicate sex #' @param codes Codes used to identify males and females (in that order) #' @param pop Relative populations of males and females (in that order) #' -#' @return A list of class `"sexRatioTest"` with: +#' @returns A list of class `"sexRatioTest"` with: #' #' | **Variable** | **Description** | #' | :--- | :--- | @@ -53,7 +53,7 @@ sexRatioTest <- function(sex, codes = c(1, 2), pop = c(1, 1)) { #' @param x Output resulting from applying the [sexRatioTest()] function #' @param ... Additional [print()] parameters #' -#' @return Printed output of [sexRatioTest()] function +#' @returns Printed output of [sexRatioTest()] function #' #' @examples #' # Use sexRatioTest() on household roster data from a survey in Tanzania diff --git a/R/skewKurt.R b/R/skewKurt.R index e9e721a..18d9bf4 100644 --- a/R/skewKurt.R +++ b/R/skewKurt.R @@ -4,7 +4,7 @@ #' #' @param x Numeric vector #' -#' @return A list of class "skewKurt" with: +#' @returns A list of class "skewKurt" with: #' #' | **Variable** | **Description** | #' | :--- | :--- | @@ -54,7 +54,7 @@ skewKurt <- function(x) { #' @param x Object resulting from applying the [skewKurt()] function #' @param ... Additional [print()] parameters #' -#' @return Printed output of [skewKurt()] function +#' @returns Printed output of [skewKurt()] function #' #' @examples #' # Use skewKurt() on an anthropometric data from a SMART survey in diff --git a/README.Rmd b/README.Rmd index e9c1cd0..9bff1c0 100644 --- a/README.Rmd +++ b/README.Rmd @@ -23,7 +23,7 @@ library(nipnTK) [![Project Status: Active – The project has reached a stable, usable state and is being actively developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active) [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) [![CRAN](https://img.shields.io/cran/v/nipnTK.svg)](https://cran.r-project.org/package=nipnTK) -[![cran checks](https://cranchecks.info/badges/summary/nipnTK)](https://cran.r-project.org/web/checks/check_results_nipnTK.html) +[![cran checks](https://badges.cranchecks.info/worst/nipnTK.svg)](https://cran.r-project.org/web/checks/check_results_nipnTK.html) [![CRAN](https://img.shields.io/cran/l/nipnTK.svg)](https://CRAN.R-project.org/package=nipnTK) [![CRAN](http://cranlogs.r-pkg.org/badges/nipnTK)](https://cran.r-project.org/package=nipnTK) [![CRAN](http://cranlogs.r-pkg.org/badges/grand-total/nipnTK)](https://cran.r-project.org/package=nipnTK) @@ -34,17 +34,11 @@ library(nipnTK) [![DOI](https://zenodo.org/badge/118171028.svg)](https://zenodo.org/badge/latestdoi/118171028) -[National Information Platforms for Nutrition (NiPN)](http://www.nipn-nutrition-platforms.org) is an initiative of the European Commission to provide support to countries to strengthen their information systems for nutrition and to improve the analysis of data so as to better inform the strategic decisions they are faced with to prevent malnutrition and its consequences. +[National Information Platforms for Nutrition (NiPN)](https://www.nipn-nutrition-platforms.org) is an initiative of the European Commission to provide support to countries to strengthen their information systems for nutrition and to improve the analysis of data so as to better inform the strategic decisions they are faced with to prevent malnutrition and its consequences. -As part of this mandate, [NiPN](http://www.nipn-nutrition-platforms.org) has commissioned work on the development of a toolkit to assess the quality of various nutrition-specific and nutrition-related data. This is a companion R package to the toolkit of practical analytical methods that can be applied to variables in datasets to assess their quality. +As part of this mandate, [NiPN](https://www.nipn-nutrition-platforms.org) has commissioned work on the development of a toolkit to assess the quality of various nutrition-specific and nutrition-related data. This is a companion R package to the toolkit of practical analytical methods that can be applied to variables in datasets to assess their quality. -The focus of the toolkit is on data required to assess anthropometric status such as measurements of weight, height or length, MUAC, sex and age. The focus is on anthropometric status but many of presented methods could be applied to other types of data. [NiPN](http://www.nipn-nutrition-platforms.org) may commission additional toolkits to examine other variables or other types of variables. - -## Requirements - -* [R](https://cran.r-project.org) version 3.4 or higher - -Extensive use is made of the [R](https://cran.r-project.org) language and environment for statistical computing. This is a free and powerful data analysis system. [R](https://cran.r-project.org) provides a very extensive language for working with data. This companion package has been written using only a small subset of the [R](https://cran.r-project.org) language. Many of the data quality activities described in the toolkit are supported by [R](https://cran.r-project.org) functions included in this package that have been written specifically for this purpose. These simplify the assessment of the quality of data related to anthropometry and anthropometric indices. +The focus of the toolkit is on data required to assess anthropometric status such as measurements of weight, height or length, MUAC, sex and age. The focus is on anthropometric status but many of presented methods could be applied to other types of data. [NiPN](https://www.nipn-nutrition-platforms.org) may commission additional toolkits to examine other variables or other types of variables. ## Installation diff --git a/README.md b/README.md index 06000d4..442bb9d 100644 --- a/README.md +++ b/README.md @@ -12,7 +12,7 @@ developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.re stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) [![CRAN](https://img.shields.io/cran/v/nipnTK.svg)](https://cran.r-project.org/package=nipnTK) [![cran -checks](https://cranchecks.info/badges/summary/nipnTK)](https://cran.r-project.org/web/checks/check_results_nipnTK.html) +checks](https://badges.cranchecks.info/worst/nipnTK.svg)](https://cran.r-project.org/web/checks/check_results_nipnTK.html) [![CRAN](https://img.shields.io/cran/l/nipnTK.svg)](https://CRAN.R-project.org/package=nipnTK) [![CRAN](http://cranlogs.r-pkg.org/badges/nipnTK)](https://cran.r-project.org/package=nipnTK) [![CRAN](http://cranlogs.r-pkg.org/badges/grand-total/nipnTK)](https://cran.r-project.org/package=nipnTK) @@ -25,42 +25,27 @@ coverage](https://codecov.io/gh/nutriverse/nipnTK/branch/main/graph/badge.svg)]( [National Information Platforms for Nutrition -(NiPN)](http://www.nipn-nutrition-platforms.org) is an initiative of the -European Commission to provide support to countries to strengthen their -information systems for nutrition and to improve the analysis of data so -as to better inform the strategic decisions they are faced with to -prevent malnutrition and its consequences. - -As part of this mandate, [NiPN](http://www.nipn-nutrition-platforms.org) -has commissioned work on the development of a toolkit to assess the -quality of various nutrition-specific and nutrition-related data. This -is a companion R package to the toolkit of practical analytical methods -that can be applied to variables in datasets to assess their quality. +(NiPN)](https://www.nipn-nutrition-platforms.org) is an initiative of +the European Commission to provide support to countries to strengthen +their information systems for nutrition and to improve the analysis of +data so as to better inform the strategic decisions they are faced with +to prevent malnutrition and its consequences. + +As part of this mandate, +[NiPN](https://www.nipn-nutrition-platforms.org) has commissioned work +on the development of a toolkit to assess the quality of various +nutrition-specific and nutrition-related data. This is a companion R +package to the toolkit of practical analytical methods that can be +applied to variables in datasets to assess their quality. The focus of the toolkit is on data required to assess anthropometric status such as measurements of weight, height or length, MUAC, sex and age. The focus is on anthropometric status but many of presented methods could be applied to other types of data. -[NiPN](http://www.nipn-nutrition-platforms.org) may commission +[NiPN](https://www.nipn-nutrition-platforms.org) may commission additional toolkits to examine other variables or other types of variables. -## Requirements - -- [R](https://cran.r-project.org) version 3.4 or higher - -Extensive use is made of the [R](https://cran.r-project.org) language -and environment for statistical computing. This is a free and powerful -data analysis system. [R](https://cran.r-project.org) provides a very -extensive language for working with data. This companion package has -been written using only a small subset of the -[R](https://cran.r-project.org) language. Many of the data quality -activities described in the toolkit are supported by -[R](https://cran.r-project.org) functions included in this package that -have been written specifically for this purpose. These simplify the -assessment of the quality of data related to anthropometry and -anthropometric indices. - ## Installation You can install `nipnTK` from [CRAN](https://cran.r-project.org): @@ -118,21 +103,20 @@ citation provided by a call to the `citation` function as follows: ``` r citation("nipnTK") -#> #> To cite nipnTK in publications use: #> -#> Mark Myatt and Ernest Guevarra (2023). nipnTK: National Information -#> Platforms for Nutrition (NiPN) Data Quality Toolkit R package version -#> 0.1.1.9000 URL https://nutriverse.io/nipnTK/ DOI -#> 10.5281/zenodo.4297897 +#> Mark Myatt, Ernest Guevarra (2024). _nipnTK: National Information +#> Platforms for Nutrition (NiPN) Data Quality Toolkit_. +#> doi:10.5281/zenodo.4297897 , +#> R package version 0.2.0, . #> #> A BibTeX entry for LaTeX users is #> #> @Manual{, #> title = {nipnTK: National Information Platforms for Nutrition (NiPN) Data Quality Toolkit}, #> author = {{Mark Myatt} and {Ernest Guevarra}}, -#> year = {2023}, -#> note = {R package version 0.1.1.9000}, +#> year = {2024}, +#> note = {R package version 0.2.0}, #> url = {https://nutriverse.io/nipnTK/}, #> doi = {10.5281/zenodo.4297897}, #> } diff --git a/cran-comments.md b/cran-comments.md index 205da74..f77f546 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,37 +1,30 @@ -## Resubmission -This is a resubmission. In this version I have: - -* I have removed the `dontrun{}` wrap around the example for `boxText()` - function and edited the example to be able to run - -* I have used `withr::local_par` to be able to change `par` settings within a - function and then revert back to original `par` settings. I am more familiar - with using this approach as I have used it before compared to using `on.exit` - as suggested by CRAN reviewer. I think the same output is achieved. I will - learn the `on.exit` function for future use. Thank you for the suggestion. - -* I have removed the `set.seed(0)` in the `greensIndex()` function and then in - the example I show that I apply `set.seed(0)` before using the `greensIndex()` - function. +## Release summary + +Second CRAN release of `nipnTK`. In this release: + +* 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 + +* Updated general package documentation + +* Added CITATION entry ## Test environments -* local R installation, R 4.0.3 -* ubuntu 20.04 (on GitHub Actions), R 4.0.3 -* ubuntu 20.04 (on GitHub Actions), R devel -* windows latest (on GitHub Actions), R 4.0.3 -* macOS latest (on GitHub Actions), R 4.0.3 -* win-builder (devel, release, old-release) +* local ubuntu 22.04 install, R 4.3.3 +* macos-latest (on GitHub Actions), release +* windows-latest (on GitHub Actions), release +* ubuntu-latest (on GitHub Actions), release, devel, and oldrelease +* mac-builder (release) +* win-builder (devel, release, oldrelease) * rhub (windows-devel, fedora-devel, ubuntu-release) ## R CMD check results -0 errors | 0 warnings | 1 note - -* This is a new release. +0 errors | 0 warnings | 0 notes -* Possibly mis-spelled words in DESCRIPTION: - Anthropometric (3:13) - NiPN (3:8) - anthropometric (17:59, 19:49) - - - These are not mis-spelled. +## Reverse dependencies +`nipnTK` doesn't have any downstream / reverse dependencies +(see https://github.com/nutriverse/nipnTK/tree/main/revdep/cran.md) diff --git a/inst/CITATION b/inst/CITATION index 103e681..453895d 100644 --- a/inst/CITATION +++ b/inst/CITATION @@ -1,18 +1,10 @@ -citHeader("To cite nipnTK in publications use:") - -citEntry( - entry = "Manual", +bibentry( + bibtype = "Manual", + header = "To cite nipnTK in publications use:", title = "nipnTK: National Information Platforms for Nutrition (NiPN) Data Quality Toolkit", author = c(person("Mark Myatt"), person("Ernest Guevarra")), - year = "2023", - note = "R package version 0.1.1.9000", + year = "2024", + note = "R package version 0.2.0", url = "https://nutriverse.io/nipnTK/", - doi = "10.5281/zenodo.4297897", - textVersion = paste( - "Mark Myatt and Ernest Guevarra (2023).", - "nipnTK: National Information Platforms for Nutrition (NiPN) Data Quality Toolkit", - "R package version 0.1.1.9000", - "URL https://nutriverse.io/nipnTK/", - "DOI 10.5281/zenodo.4297897" - ) + doi = "10.5281/zenodo.4297897" ) diff --git a/man/ageChildren.Rd b/man/ageChildren.Rd index 86dc867..11a0f59 100644 --- a/man/ageChildren.Rd +++ b/man/ageChildren.Rd @@ -2,22 +2,16 @@ % Please edit documentation in R/ageChildren.R \name{ageChildren} \alias{ageChildren} -\title{Goodness of fit to an expected (model-based) age distribution} +\title{Goodness of fit to an expected model-based age distribution} \usage{ -ageChildren( - age, - u5mr = 0, - groups = "6:17=1; 18:29=2; 30:41=3; 42:53=4; 54:59=5" -) +ageChildren(age, u5mr = 1) } \arguments{ -\item{age}{Vector of ages} +\item{age}{A vector of ages. Should either be in whole months (integer) or in +calculated decimal months (numeric).} -\item{u5mr}{Under five years mortality rate as deaths / 10,000 persons / day} - -\item{groups}{Age groupings specified as recodes parameter in the -\code{\link[bbw:recode]{bbw::recode()}} function; default is -\code{"6:17=1; 18:29=2; 30:41=3; 42:53=4; 54:59=5"}} +\item{u5mr}{A numeric value for under five years mortality rate expressed as +deaths / 10,000 persons / day. Default is set to 1.} } \value{ A list of class "ageChildren" with:\tabular{ll}{ @@ -31,7 +25,13 @@ A list of class "ageChildren" with:\tabular{ll}{ } } \description{ -Goodness of fit to an expected (model-based) age distribution +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). } \examples{ # Chi-Squared test for age of children in dp.ex02 sample dataset using an diff --git a/man/ageHeaping.Rd b/man/ageHeaping.Rd index c3597d8..41ad5c1 100644 --- a/man/ageHeaping.Rd +++ b/man/ageHeaping.Rd @@ -7,7 +7,8 @@ ageHeaping(x, divisor = 12) } \arguments{ -\item{x}{Vector of ages} +\item{x}{A vector of ages. Should either be in whole months (integer) or in +calculated decimal months (numeric).} \item{divisor}{Divisor (usually 5, 6, 10, or 12); default is 12} } diff --git a/man/ageRatioTest.Rd b/man/ageRatioTest.Rd index ef00e87..a218fc1 100644 --- a/man/ageRatioTest.Rd +++ b/man/ageRatioTest.Rd @@ -7,7 +7,7 @@ ageRatioTest(x, ratio = 0.85) } \arguments{ -\item{x}{A vector for age. Should either be in whole months (integer) or in +\item{x}{A vector of ages. Should either be in whole months (integer) or in calculated decimal months (numeric).} \item{ratio}{Expected age ratio. Default is 0.85.} diff --git a/man/digitPreference.Rd b/man/digitPreference.Rd index 7cca32b..0736e7a 100644 --- a/man/digitPreference.Rd +++ b/man/digitPreference.Rd @@ -7,9 +7,9 @@ digitPreference(x, digits = 1, values = 0:9) } \arguments{ -\item{x}{Numeric vector} +\item{x}{Numeric vector of measurements} -\item{digits}{Number of decimal places in \code{x}. using \code{digits = 1} +\item{digits}{Number of decimal places in \code{x}. Using \code{digits = 1} (e.g.) allows 105 to be treated as 105.0} \item{values}{A vector of possible values for the final digit (default = 0:9)} diff --git a/man/nipnTK.Rd b/man/nipnTK.Rd index 6be25d3..5527c1e 100644 --- a/man/nipnTK.Rd +++ b/man/nipnTK.Rd @@ -6,8 +6,13 @@ \alias{nipnTK} \title{NiPN data quality toolkit} \description{ -This is a library of R functions for assessing data-quality in nutritional -anthropometry surveys. +An implementation of the National Information Platforms for Nutrition or +NiPN's analytic methods for assessing quality of anthropometric datasets that +include measurements of weight, height or length, middle upper arm +circumference, sex and age. The focus is on anthropometric status but many of +the presented methods could be applied to other variables. This is a library +of R functions for assessing data-quality in nutritional anthropometry +surveys. } \seealso{ Useful links: diff --git a/man/outliersMD.Rd b/man/outliersMD.Rd index 9fd7e05..80c923d 100644 --- a/man/outliersMD.Rd +++ b/man/outliersMD.Rd @@ -11,7 +11,7 @@ outliersMD(x, y, alpha = 0.001) \item{y}{Numeric vector} -\item{alpha}{Critical \code{alpha} value to detect and outlier (defaults to +\item{alpha}{Critical \code{alpha} value to detect an outlier (defaults to 0.001)} } \value{ @@ -25,4 +25,5 @@ Mahalanobis distance to detect bivariate outliers # a SMART survey from the Democratic Republic of Congo (sp.ex01) svy <- sp.ex01 svy[outliersMD(svy$height,svy$weight), ] + } diff --git a/man/sexRatioTest.Rd b/man/sexRatioTest.Rd index 25a2545..559042d 100644 --- a/man/sexRatioTest.Rd +++ b/man/sexRatioTest.Rd @@ -7,7 +7,7 @@ sexRatioTest(sex, codes = c(1, 2), pop = c(1, 1)) } \arguments{ -\item{sex}{Numeric vector (\code{sex})} +\item{sex}{A vector of values that indicate sex} \item{codes}{Codes used to identify males and females (in that order)} diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index 54156ef..fedfb89 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -1,24 +1,23 @@ title: nipnTK + url: https://nutriverse.io/nipnTK/ + +development: + mode: auto + template: bootstrap: 5 bootswatch: cosmo theme: haddock ganalytics: G-HD17FR1JE1 + navbar: bg: success type: light structure: - left: - - home - - intro - - reference - - articles - - news - right: - - mastodon - - linkedin - - github + left: [home, intro, reference, articles, news] + right: [mastodon, linkedin, github] + components: articles: text: Articles @@ -45,70 +44,85 @@ navbar: linkedin: icon: fab fa-linkedin fa-lg href: https://www.linkedin.com/company/katilingban/ + home: + sidebar: + structure: [links, license, community, citation, authors, dev] + links: - text: Read more about NiPN - href: http://www.nipn-nutrition-platforms.org + href: https://www.nipn-nutrition-platforms.org + reference: -- title: Description - contents: nipnTK -- title: Checking ranges and legal values - contents: - - outliersUV - - rl.ex01 -- title: Using scatterplots to identify outliers - contents: - - outliersMD - - sp.ex01 - - sp.ex02 -- title: Identifying outliers using flags - contents: - - national.SMART - - flag.ex01 - - flag.ex02 - - flag.ex03 -- title: Distribution of variable and indices - contents: - - histNormal - - qqNormalPlot - - skewKurt - - print.skewKurt - - dist.ex01 -- title: Digit preference - contents: - - fullTable - - digitPreference - - plot.digitPreference - - print.digitPreference - - dp.ex01 -- title: Age heaping - contents: - - ageHeaping - - plot.ageHeaping - - print.ageHeaping - - dp.ex02 - - ah.ex01 -- title: Sex ratio - contents: - - sexRatioTest - - print.sexRatioTest - - dp.ex02 -- title: Age and sex distributions - contents: - - ageChildren - - plot.ageChildren - - print.ageChildren - - ageRatioTest - - print.ageRatioTest - - sexRatioTest - - pyramid.plot - - as.ex01 - - as.ex02 - - dp.ex02 - - dp.ex03 -- title: Utility - contents: - - boxText - - greensIndex - - print.greensIndex + - title: Description + contents: + - nipnTK + + - title: Checking ranges and legal values + contents: + - outliersUV + - rl.ex01 + + - title: Using scatterplots to identify outliers + contents: + - outliersMD + - sp.ex01 + - sp.ex02 + + - title: Identifying outliers using flags + contents: + - national.SMART + - flag.ex01 + - flag.ex02 + - flag.ex03 + + - title: Distribution of variable and indices + contents: + - histNormal + - qqNormalPlot + - skewKurt + - print.skewKurt + - dist.ex01 + + - title: Digit preference + contents: + - fullTable + - digitPreference + - plot.digitPreference + - print.digitPreference + - dp.ex01 + + - title: Age heaping + contents: + - ageHeaping + - plot.ageHeaping + - print.ageHeaping + - dp.ex02 + - ah.ex01 + + - title: Sex ratio + contents: + - sexRatioTest + - print.sexRatioTest + - dp.ex02 + + - title: Age and sex distributions + contents: + - ageChildren + - plot.ageChildren + - print.ageChildren + - ageRatioTest + - print.ageRatioTest + - sexRatioTest + - pyramid.plot + - as.ex01 + - as.ex02 + - dp.ex02 + - dp.ex03 + + - title: Utility + contents: + - boxText + - greensIndex + - print.greensIndex diff --git a/revdep/.gitignore b/revdep/.gitignore new file mode 100644 index 0000000..111ab32 --- /dev/null +++ b/revdep/.gitignore @@ -0,0 +1,7 @@ +checks +library +checks.noindex +library.noindex +cloud.noindex +data.sqlite +*.html diff --git a/revdep/README.md b/revdep/README.md new file mode 100644 index 0000000..7943bc7 --- /dev/null +++ b/revdep/README.md @@ -0,0 +1,24 @@ +# Platform + +|field |value | +|:--------|:----------------------------------------------------------------------------| +|version |R version 4.3.3 (2024-02-29) | +|os |Pop!_OS 22.04 LTS | +|system |x86_64, linux-gnu | +|ui |RStudio | +|language |en | +|collate |en_GB.UTF-8 | +|ctype |en_GB.UTF-8 | +|tz |Europe/London | +|date |2024-04-06 | +|rstudio |2023.12.1+402 Ocean Storm (desktop) | +|pandoc |3.1.1 @ /usr/lib/rstudio/resources/app/bin/quarto/bin/tools/ (via rmarkdown) | + +# Dependencies + +|package |old |new |Δ | +|:-------|:---|:-----|:--| +|nipnTK |NA |0.2.0 |* | + +# Revdeps + diff --git a/revdep/checks/libraries.csv b/revdep/checks/libraries.csv new file mode 100644 index 0000000..bae3577 --- /dev/null +++ b/revdep/checks/libraries.csv @@ -0,0 +1,2 @@ +package,old,new,delta +nipnTK,NA,0.2.0,* diff --git a/revdep/cran.md b/revdep/cran.md new file mode 100644 index 0000000..33114b6 --- /dev/null +++ b/revdep/cran.md @@ -0,0 +1,7 @@ +## revdepcheck results + +We checked 0 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. + + * We saw 0 new problems + * We failed to check 0 packages + diff --git a/revdep/data.sqlite b/revdep/data.sqlite new file mode 100644 index 0000000..3a62f04 Binary files /dev/null and b/revdep/data.sqlite differ diff --git a/revdep/failures.md b/revdep/failures.md new file mode 100644 index 0000000..9a20736 --- /dev/null +++ b/revdep/failures.md @@ -0,0 +1 @@ +*Wow, no problems at all. :)* \ No newline at end of file diff --git a/revdep/library/nipnTK/new/nipnTK/CITATION b/revdep/library/nipnTK/new/nipnTK/CITATION new file mode 100644 index 0000000..453895d --- /dev/null +++ b/revdep/library/nipnTK/new/nipnTK/CITATION @@ -0,0 +1,10 @@ +bibentry( + bibtype = "Manual", + header = "To cite nipnTK in publications use:", + title = "nipnTK: National Information Platforms for Nutrition (NiPN) Data Quality Toolkit", + author = c(person("Mark Myatt"), person("Ernest Guevarra")), + year = "2024", + note = "R package version 0.2.0", + url = "https://nutriverse.io/nipnTK/", + doi = "10.5281/zenodo.4297897" +) diff --git a/revdep/library/nipnTK/new/nipnTK/DESCRIPTION b/revdep/library/nipnTK/new/nipnTK/DESCRIPTION new file mode 100644 index 0000000..cd36784 --- /dev/null +++ b/revdep/library/nipnTK/new/nipnTK/DESCRIPTION @@ -0,0 +1,42 @@ +Package: nipnTK +Type: Package +Title: National Information Platforms for Nutrition Anthropometric Data + Toolkit +Version: 0.2.0 +Authors@R: c( + person(given = "Mark", + family = "Myatt", + comment = c(ORCID = "0000-0003-1119-1474"), + email = "mark@brixtonhealth.com", + role = "aut"), + person(given = "Ernest", + family = "Guevarra", + comment = c(ORCID = "0000-0002-4887-4415"), + email = "ernest@guevarra.io", + role = c("aut", "cre"))) +Description: An implementation of the National Information Platforms for + Nutrition or NiPN's analytic methods for assessing quality of anthropometric + datasets that include measurements of weight, height or length, middle upper + arm circumference, sex and age. The focus is on anthropometric status but + many of the presented methods could be applied to other variables. +License: GPL-3 +Depends: R (>= 2.10) +Imports: stats, graphics, withr +Suggests: testthat, knitr, rmarkdown, tufte, spelling, covr, kableExtra +Encoding: UTF-8 +Language: en-GB +LazyData: true +RoxygenNote: 7.3.1 +Roxygen: list(markdown = TRUE) +URL: https://nutriverse.io/nipnTK/, + https://github.com/nutriverse/nipnTK +BugReports: https://github.com/nutriverse/nipnTK/issues +VignetteBuilder: knitr +RemoteType: local +RemoteUrl: /home/ernestguevarra/Documents/GitHub/nipnTK +NeedsCompilation: no +Packaged: 2024-04-06 21:36:26 UTC; ernestguevarra +Author: Mark Myatt [aut] (), + Ernest Guevarra [aut, cre] () +Maintainer: Ernest Guevarra +Built: R 4.3.3; ; 2024-04-06 21:36:26 UTC; unix diff --git a/revdep/library/nipnTK/new/nipnTK/INDEX b/revdep/library/nipnTK/new/nipnTK/INDEX new file mode 100644 index 0000000..0260751 --- /dev/null +++ b/revdep/library/nipnTK/new/nipnTK/INDEX @@ -0,0 +1,64 @@ +ageChildren Goodness of fit to an expected model-based age + distribution +ageHeaping Age-heaping analysis +ageRatioTest Age ratio test +ah.ex01 Example dataset for age heaping function +as.ex01 Example dataset for age and sex distributions + function +as.ex02 Example dataset for age and sex distributions + function +boxText Plot text in a coloured bounding box. +digitPreference Digit preference test +dist.ex01 Example dataset for distributions of variables + and indices +dp.ex01 Example dataset for digit preference function +dp.ex02 Example dataset for digit preference function +dp.ex03 Example dataset for digit preference +flag.ex01 Example dataset for identifying outliers using + flags +flag.ex02 Example dataset for identifying outliers using + flags +flag.ex03 Example dataset for identifying outliers using + flags +fullTable Fill out a one-dimensional table to include a + specified range of values +greensIndex Green's Index of Dispersion +histNormal Histogram with normal curve superimposed to + help with “by-eye” assessments of normality of + distribution +national.SMART Add SMART flags to a stratified sample survey + (e.g. MICS, DHS, national SMART) +outliersMD Mahalanobis distance to detect bivariate + outliers +outliersUV IQR to detect univariate outliers +plot.ageChildren Plot helper function for 'ageChildren()' + function +plot.ageHeaping 'plot()' helper functions for 'ageHeaping()' + functions +plot.digitPreference 'plot()' helper function for + 'digitPreference()' function +print.ageChildren 'print()' helper function for 'ageChildren()' + function +print.ageHeaping 'print()' helper functions for 'ageHeaping()' + functions +print.ageRatioTest 'print()' helper function for 'ageRatioTest()' + function +print.digitPreference 'print()' helper function for + 'digitPreference()' function +print.greensIndex 'print()' helper function for + 'print.greensIndex()' function +print.sexRatioTest 'print()' helper function for 'sexRatioTest()' + function +print.skewKurt 'print()' helper function for 'skewKurt()' + function +pyramid.plot Pyramid plot function for creating population + pyramids. +qqNormalPlot Normal quantile-quantile plot +rl.ex01 Example dataset for checking ranges and legal + values +sexRatioTest Sex Ratio Test +skewKurt Skew and kurtosis +sp.ex01 Example dataset for using scatterplots to + identify outliers +sp.ex02 Example dataset for using scatterplots to + identify outliers diff --git a/revdep/library/nipnTK/new/nipnTK/Meta/Rd.rds b/revdep/library/nipnTK/new/nipnTK/Meta/Rd.rds new file mode 100644 index 0000000..427ca2c Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/Meta/Rd.rds differ diff --git a/revdep/library/nipnTK/new/nipnTK/Meta/data.rds b/revdep/library/nipnTK/new/nipnTK/Meta/data.rds new file mode 100644 index 0000000..fe0686a Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/Meta/data.rds differ diff --git a/revdep/library/nipnTK/new/nipnTK/Meta/features.rds b/revdep/library/nipnTK/new/nipnTK/Meta/features.rds new file mode 100644 index 0000000..ab57f2b Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/Meta/features.rds differ diff --git a/revdep/library/nipnTK/new/nipnTK/Meta/hsearch.rds b/revdep/library/nipnTK/new/nipnTK/Meta/hsearch.rds new file mode 100644 index 0000000..590620d Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/Meta/hsearch.rds differ diff --git a/revdep/library/nipnTK/new/nipnTK/Meta/links.rds b/revdep/library/nipnTK/new/nipnTK/Meta/links.rds new file mode 100644 index 0000000..16cab9d Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/Meta/links.rds differ diff --git a/revdep/library/nipnTK/new/nipnTK/Meta/nsInfo.rds b/revdep/library/nipnTK/new/nipnTK/Meta/nsInfo.rds new file mode 100644 index 0000000..02dad93 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/Meta/nsInfo.rds differ diff --git a/revdep/library/nipnTK/new/nipnTK/Meta/package.rds b/revdep/library/nipnTK/new/nipnTK/Meta/package.rds new file mode 100644 index 0000000..b448e53 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/Meta/package.rds differ diff --git a/revdep/library/nipnTK/new/nipnTK/NAMESPACE b/revdep/library/nipnTK/new/nipnTK/NAMESPACE new file mode 100644 index 0000000..9e3b4c8 --- /dev/null +++ b/revdep/library/nipnTK/new/nipnTK/NAMESPACE @@ -0,0 +1,54 @@ +# Generated by roxygen2: do not edit by hand + +S3method(plot,ageChildren) +S3method(plot,ageHeaping) +S3method(plot,digitPreference) +S3method(print,ageChildren) +S3method(print,ageHeaping) +S3method(print,ageRatioTest) +S3method(print,digitPreference) +S3method(print,greensIndex) +S3method(print,sexRatioTest) +S3method(print,skewKurt) +export(ageChildren) +export(ageHeaping) +export(ageRatioTest) +export(boxText) +export(digitPreference) +export(fullTable) +export(greensIndex) +export(histNormal) +export(national.SMART) +export(outliersMD) +export(outliersUV) +export(pyramid.plot) +export(qqNormalPlot) +export(sexRatioTest) +export(skewKurt) +importFrom(graphics,abline) +importFrom(graphics,axTicks) +importFrom(graphics,axis) +importFrom(graphics,barplot) +importFrom(graphics,hist) +importFrom(graphics,lines) +importFrom(graphics,par) +importFrom(graphics,plot) +importFrom(graphics,rect) +importFrom(graphics,strheight) +importFrom(graphics,strwidth) +importFrom(graphics,text) +importFrom(stats,IQR) +importFrom(stats,chisq.test) +importFrom(stats,cov) +importFrom(stats,dnorm) +importFrom(stats,mahalanobis) +importFrom(stats,na.omit) +importFrom(stats,pchisq) +importFrom(stats,pnorm) +importFrom(stats,prop.test) +importFrom(stats,qqline) +importFrom(stats,qqnorm) +importFrom(stats,quantile) +importFrom(stats,sd) +importFrom(stats,var) +importFrom(withr,local_par) diff --git a/revdep/library/nipnTK/new/nipnTK/NEWS.md b/revdep/library/nipnTK/new/nipnTK/NEWS.md new file mode 100644 index 0000000..b95a0ea --- /dev/null +++ b/revdep/library/nipnTK/new/nipnTK/NEWS.md @@ -0,0 +1,66 @@ +# 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 +release: + +## 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 + +* added `pkgdown` GitHub Actions workflow to deploy website via `gh-pages` +branch + +* updated documentation for `ageRatioTest()` + + +# nipnTK 0.1.1.9000 + +Second release of `nipnTK`. This is a GitHub-only development release. In this +release: + +## General updates + +* remove `appveyor.yml` and the Appveyor ci/cd workflow + +* update GitHub Actions workflow to latest 5 system standard check + +* update GitHub Actions workflow for coverage testing + +* change default git branch name from master to main + +* add CITATION + +* update CONTRIBUTOR guidelines + +* upgrade website to bootstrap 5 + +* edit typo in vignette + + +# nipnTK 0.1.0 + +This is the first [CRAN](https://cran.r-project.org) release of `nipnTK`. + diff --git a/revdep/library/nipnTK/new/nipnTK/R/nipnTK b/revdep/library/nipnTK/new/nipnTK/R/nipnTK new file mode 100644 index 0000000..6686156 --- /dev/null +++ b/revdep/library/nipnTK/new/nipnTK/R/nipnTK @@ -0,0 +1,27 @@ +# File share/R/nspackloader.R +# Part of the R package, https://www.R-project.org +# +# Copyright (C) 1995-2012 The R Core Team +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# A copy of the GNU General Public License is available at +# https://www.r-project.org/Licenses/ + +local({ + info <- loadingNamespaceInfo() + pkg <- info$pkgname + ns <- .getNamespace(as.name(pkg)) + if (is.null(ns)) + stop("cannot find namespace environment for ", pkg, domain = NA); + dbbase <- file.path(info$libname, pkg, "R", pkg) + lazyLoad(dbbase, ns, filter = function(n) n != ".__NAMESPACE__.") +}) diff --git a/revdep/library/nipnTK/new/nipnTK/R/nipnTK.rdb b/revdep/library/nipnTK/new/nipnTK/R/nipnTK.rdb new file mode 100644 index 0000000..9105f70 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/R/nipnTK.rdb differ diff --git a/revdep/library/nipnTK/new/nipnTK/R/nipnTK.rdx b/revdep/library/nipnTK/new/nipnTK/R/nipnTK.rdx new file mode 100644 index 0000000..79551ad Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/R/nipnTK.rdx differ diff --git a/revdep/library/nipnTK/new/nipnTK/WORDLIST b/revdep/library/nipnTK/new/nipnTK/WORDLIST new file mode 100644 index 0000000..d0c9780 --- /dev/null +++ b/revdep/library/nipnTK/new/nipnTK/WORDLIST @@ -0,0 +1,94 @@ +Anthro +AnthroPlus +Appveyor +BAZ +BMI +CMD +CodeFactor +Codecov +DHS +DPS +Dadaab +Demispan +ENA +EpiInfo +GI +Garissa +HAZ +HW +HelpAge +Hense +Kuulasmaa +LCL +Lifecycle +MADs +MUAC +NCHS +NiPN +NiPN's +ORCID +PSU +PSUs +RAnalyticFlow +RStudio +Rhistory +STATA +Tolonen +WAZ +WHZ +Wilk +XQuartz +adults’ +ageChildren +ageHeaping +ageMonths +agro +baz +bp +bpqa +cd +cex +ci +cran +csv +demispan +df +dist +dp +dps +eM +expectedP +expectedR +fi +frac +haz +ht +htm +kgs +kwashiorkor +mads +minGI +monica +mr +muac +observedP +observedR +org +pM +pct +psu +sd +se +skewKurt +survey’s +thl +toolkits +u +undernutrition +waz +whz +www +xquartz +years’ +zt +β diff --git a/revdep/library/nipnTK/new/nipnTK/data/Rdata.rdb b/revdep/library/nipnTK/new/nipnTK/data/Rdata.rdb new file mode 100644 index 0000000..0c0e11a Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/data/Rdata.rdb differ diff --git a/revdep/library/nipnTK/new/nipnTK/data/Rdata.rds b/revdep/library/nipnTK/new/nipnTK/data/Rdata.rds new file mode 100644 index 0000000..995b864 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/data/Rdata.rds differ diff --git a/revdep/library/nipnTK/new/nipnTK/data/Rdata.rdx b/revdep/library/nipnTK/new/nipnTK/data/Rdata.rdx new file mode 100644 index 0000000..0348745 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/data/Rdata.rdx differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/AnIndex b/revdep/library/nipnTK/new/nipnTK/help/AnIndex new file mode 100644 index 0000000..3981441 --- /dev/null +++ b/revdep/library/nipnTK/new/nipnTK/help/AnIndex @@ -0,0 +1,40 @@ +nipnTK-package nipnTK +ageChildren ageChildren +ageHeaping ageHeaping +ageRatioTest ageRatioTest +ah.ex01 ah.ex01 +as.ex01 as.ex01 +as.ex02 as.ex02 +boxText boxText +digitPreference digitPreference +dist.ex01 dist.ex01 +dp.ex01 dp.ex01 +dp.ex02 dp.ex02 +dp.ex03 dp.ex03 +flag.ex01 flag.ex01 +flag.ex02 flag.ex02 +flag.ex03 flag.ex03 +fullTable fullTable +greensIndex greensIndex +histNormal histNormal +national.SMART national.SMART +nipnTK nipnTK +outliersMD outliersMD +outliersUV outliersUV +plot.ageChildren plot.ageChildren +plot.ageHeaping plot.ageHeaping +plot.digitPreference plot.digitPreference +print.ageChildren print.ageChildren +print.ageHeaping print.ageHeaping +print.ageRatioTest print.ageRatioTest +print.digitPreference print.digitPreference +print.greensIndex print.greensIndex +print.sexRatioTest print.sexRatioTest +print.skewKurt print.skewKurt +pyramid.plot pyramid.plot +qqNormalPlot qqNormalPlot +rl.ex01 rl.ex01 +sexRatioTest sexRatioTest +skewKurt skewKurt +sp.ex01 sp.ex01 +sp.ex02 sp.ex02 diff --git a/revdep/library/nipnTK/new/nipnTK/help/aliases.rds b/revdep/library/nipnTK/new/nipnTK/help/aliases.rds new file mode 100644 index 0000000..4c3ff74 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/aliases.rds differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage1b-1.png b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage1b-1.png new file mode 100644 index 0000000..a266d01 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage1b-1.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage2b-1.png b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage2b-1.png new file mode 100644 index 0000000..ea2b1c9 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage2b-1.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage2d-1.png b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage2d-1.png new file mode 100644 index 0000000..896e416 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage2d-1.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage2f-1.png b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage2f-1.png new file mode 100644 index 0000000..82b19c3 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage2f-1.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage4b-1.png b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage4b-1.png new file mode 100644 index 0000000..8380421 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage4b-1.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage4b-2.png b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage4b-2.png new file mode 100644 index 0000000..2908771 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage4b-2.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage4b-3.png b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage4b-3.png new file mode 100644 index 0000000..187eb9b Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage4b-3.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage4b-4.png b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage4b-4.png new file mode 100644 index 0000000..ab5a6fa Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage4b-4.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage5d-1.png b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage5d-1.png new file mode 100644 index 0000000..9d6af60 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/README-usage5d-1.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/asFigure1.png b/revdep/library/nipnTK/new/nipnTK/help/figures/asFigure1.png new file mode 100644 index 0000000..27abe91 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/asFigure1.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/asTable.png b/revdep/library/nipnTK/new/nipnTK/help/figures/asTable.png new file mode 100644 index 0000000..9d0c2c4 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/asTable.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/flagging1.png b/revdep/library/nipnTK/new/nipnTK/help/figures/flagging1.png new file mode 100644 index 0000000..300ff12 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/flagging1.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/logo.png b/revdep/library/nipnTK/new/nipnTK/help/figures/logo.png new file mode 100644 index 0000000..4691ffa Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/logo.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/mahalanobis.png b/revdep/library/nipnTK/new/nipnTK/help/figures/mahalanobis.png new file mode 100644 index 0000000..1c7181f Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/mahalanobis.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/nipnWorkflow.png b/revdep/library/nipnTK/new/nipnTK/help/figures/nipnWorkflow.png new file mode 100644 index 0000000..b849fd1 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/nipnWorkflow.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/oldMUAC.png b/revdep/library/nipnTK/new/nipnTK/help/figures/oldMUAC.png new file mode 100644 index 0000000..c7a170a Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/oldMUAC.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/pyramidPlot.png b/revdep/library/nipnTK/new/nipnTK/help/figures/pyramidPlot.png new file mode 100644 index 0000000..3d06f05 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/pyramidPlot.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/figures/qqNormalPlot.png b/revdep/library/nipnTK/new/nipnTK/help/figures/qqNormalPlot.png new file mode 100644 index 0000000..a5b64f2 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/figures/qqNormalPlot.png differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/nipnTK.rdb b/revdep/library/nipnTK/new/nipnTK/help/nipnTK.rdb new file mode 100644 index 0000000..e241be0 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/nipnTK.rdb differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/nipnTK.rdx b/revdep/library/nipnTK/new/nipnTK/help/nipnTK.rdx new file mode 100644 index 0000000..377ba4a Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/nipnTK.rdx differ diff --git a/revdep/library/nipnTK/new/nipnTK/help/paths.rds b/revdep/library/nipnTK/new/nipnTK/help/paths.rds new file mode 100644 index 0000000..1856650 Binary files /dev/null and b/revdep/library/nipnTK/new/nipnTK/help/paths.rds differ diff --git a/revdep/library/nipnTK/new/nipnTK/html/00Index.html b/revdep/library/nipnTK/new/nipnTK/html/00Index.html new file mode 100644 index 0000000..72bf2a8 --- /dev/null +++ b/revdep/library/nipnTK/new/nipnTK/html/00Index.html @@ -0,0 +1,104 @@ + + +R: National Information Platforms for Nutrition Anthropometric Data +Toolkit + + + +
+

National Information Platforms for Nutrition Anthropometric Data +Toolkit + +

+
+
+[Up] +[Top] +

Documentation for package ‘nipnTK’ version 0.2.0

+ + + +

Help Pages

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ageChildrenGoodness of fit to an expected model-based age distribution
ageHeapingAge-heaping analysis
ageRatioTestAge ratio test
ah.ex01Example dataset for age heaping function
as.ex01Example dataset for age and sex distributions function
as.ex02Example dataset for age and sex distributions function
boxTextPlot text in a coloured bounding box.
digitPreferenceDigit preference test
dist.ex01Example dataset for distributions of variables and indices
dp.ex01Example dataset for digit preference function
dp.ex02Example dataset for digit preference function
dp.ex03Example dataset for digit preference
flag.ex01Example dataset for identifying outliers using flags
flag.ex02Example dataset for identifying outliers using flags
flag.ex03Example dataset for identifying outliers using flags
fullTableFill out a one-dimensional table to include a specified range of values
greensIndexGreen's Index of Dispersion
histNormalHistogram with normal curve superimposed to help with “by-eye” assessments of normality of distribution
national.SMARTAdd SMART flags to a stratified sample survey (e.g. MICS, DHS, national SMART)
outliersMDMahalanobis distance to detect bivariate outliers
outliersUVIQR to detect univariate outliers
plot.ageChildrenPlot helper function for 'ageChildren()' function
plot.ageHeaping'plot()' helper functions for 'ageHeaping()' functions
plot.digitPreference'plot()' helper function for 'digitPreference()' function
print.ageChildren'print()' helper function for 'ageChildren()' function
print.ageHeaping'print()' helper functions for 'ageHeaping()' functions
print.ageRatioTest'print()' helper function for 'ageRatioTest()' function
print.digitPreference'print()' helper function for 'digitPreference()' function
print.greensIndex'print()' helper function for 'print.greensIndex()' function
print.sexRatioTest'print()' helper function for 'sexRatioTest()' function
print.skewKurt'print()' helper function for 'skewKurt()' function
pyramid.plotPyramid plot function for creating population pyramids.
qqNormalPlotNormal quantile-quantile plot
rl.ex01Example dataset for checking ranges and legal values
sexRatioTestSex Ratio Test
skewKurtSkew and kurtosis
sp.ex01Example dataset for using scatterplots to identify outliers
sp.ex02Example dataset for using scatterplots to identify outliers
+
diff --git a/revdep/library/nipnTK/new/nipnTK/html/R.css b/revdep/library/nipnTK/new/nipnTK/html/R.css new file mode 100644 index 0000000..c228909 --- /dev/null +++ b/revdep/library/nipnTK/new/nipnTK/html/R.css @@ -0,0 +1,130 @@ +@media screen { + .container { + padding-right: 10px; + padding-left: 10px; + margin-right: auto; + margin-left: auto; + max-width: 900px; + } +} + +.rimage img { /* from knitr - for examples and demos */ + width: 96%; + margin-left: 2%; +} + +.katex { font-size: 1.1em; } + +code { + color: inherit; + background: inherit; +} + +body { + line-height: 1.4; + background: white; + color: black; +} + +a:link { + background: white; + color: blue; +} + +a:visited { + background: white; + color: rgb(50%, 0%, 50%); +} + +h1 { + background: white; + color: rgb(55%, 55%, 55%); + font-family: monospace; + font-size: 1.4em; /* x-large; */ + text-align: center; +} + +h2 { + background: white; + color: rgb(40%, 40%, 40%); + font-family: monospace; + font-size: 1.2em; /* large; */ + text-align: center; +} + +h3 { + background: white; + color: rgb(40%, 40%, 40%); + font-family: monospace; + font-size: 1.2em; /* large; */ +} + +h4 { + background: white; + color: rgb(40%, 40%, 40%); + font-family: monospace; + font-style: italic; + font-size: 1.2em; /* large; */ +} + +h5 { + background: white; + color: rgb(40%, 40%, 40%); + font-family: monospace; +} + +h6 { + background: white; + color: rgb(40%, 40%, 40%); + font-family: monospace; + font-style: italic; +} + +img.toplogo { + width: 4em; + vertical-align: middle; +} + +img.arrow { + width: 30px; + height: 30px; + border: 0; +} + +span.acronym { + font-size: small; +} + +span.env { + font-family: monospace; +} + +span.file { + font-family: monospace; +} + +span.option{ + font-family: monospace; +} + +span.pkg { + font-weight: bold; +} + +span.samp{ + font-family: monospace; +} + +div.vignettes a:hover { + background: rgb(85%, 85%, 85%); +} + +tr { + vertical-align: top; +} + +span.rlang { + font-family: Courier New, Courier; + color: #666666; +} + diff --git a/revdep/problems.md b/revdep/problems.md new file mode 100644 index 0000000..9a20736 --- /dev/null +++ b/revdep/problems.md @@ -0,0 +1 @@ +*Wow, no problems at all. :)* \ No newline at end of file diff --git a/tests/testthat/test_ageChildren.R b/tests/testthat/test_ageChildren.R index 4e8e5f2..ecadcc7 100644 --- a/tests/testthat/test_ageChildren.R +++ b/tests/testthat/test_ageChildren.R @@ -29,3 +29,29 @@ test_that("plot(ac) is matrix", { test_that("print(ac) message exists", { expect_output(print(ac)) }) + +## Test error messages ---- + +svy <- dp.ex02 + +expect_error(ageChildren(svy$age, u5mr = "1")) +expect_error(ageChildren(as.character(svy$age), u5mr = 1)) + +ac <- ageChildren(as.integer(svy$age), u5mr = 1) + +test_that("ac is class ageChildren", { + expect_is(ac, "ageChildren") +}) + +test_that("ac is list", { + expect_true(is.list(ac)) +}) + +test_that("names of elements of ac", { + expect_match(names(ac[1]), "u5mr") + expect_match(names(ac[2]), "observed") + expect_match(names(ac[3]), "expected") + expect_match(names(ac[4]), "X2") + expect_match(names(ac[5]), "df") + expect_match(names(ac[6]), "p") +}) diff --git a/tests/testthat/test_ageRatioTest.R b/tests/testthat/test_ageRatioTest.R index afe222e..7e3e769 100644 --- a/tests/testthat/test_ageRatioTest.R +++ b/tests/testthat/test_ageRatioTest.R @@ -86,6 +86,36 @@ test_that("print(art) message exists", { expect_output(print(art)) }) +## Test that function works when age is integer ---- + +svy <- dp.ex02 + +svy$age <- as.integer(svy$age) + +art <- ageRatioTest(svy$age, ratio = 0.85) + +test_that("art is ageRatioTest", { + expect_is(art, "ageRatioTest") +}) + +test_that("art is list", { + expect_true(is.list(art)) +}) + +test_that("names of art", { + expect_equal(names(art)[1], "expectedR") + expect_equal(names(art)[2], "expectedP") + expect_equal(names(art)[3], "observedR") + expect_equal(names(art)[4], "observedP") + expect_equal(names(art)[5], "X2") + expect_equal(names(art)[6], "df") + expect_equal(names(art)[7], "p") +}) + +test_that("print(art) message exists", { + expect_output(print(art)) +}) + ## Test that function works when age is character value diff --git a/tests/testthat/test_pyramid.plot.R b/tests/testthat/test_pyramid.plot.R index eaed76e..01f974d 100644 --- a/tests/testthat/test_pyramid.plot.R +++ b/tests/testthat/test_pyramid.plot.R @@ -7,3 +7,9 @@ pyplot <- pyramid.plot(svy$age, svy$sex) test_that("pyplot is table", { expect_is(pyplot, "table") }) + +pyplot <- pyramid.plot(svy$age, svy$sex, col = c("red", "blue")) + +test_that("pyplot is table", { + expect_is(pyplot, "table") +}) diff --git a/tests/testthat/test_skewKurt.R b/tests/testthat/test_skewKurt.R index eea4553..8cc9b2a 100644 --- a/tests/testthat/test_skewKurt.R +++ b/tests/testthat/test_skewKurt.R @@ -12,4 +12,8 @@ test_that("str(sk) is list", { expect_true(is.list(sk)) }) +test_that("print(sk) message exists", { + expect_output(print(sk)) +}) + diff --git a/vignettes/as.Rmd b/vignettes/as.Rmd index 4db7785..1769310 100644 --- a/vignettes/as.Rmd +++ b/vignettes/as.Rmd @@ -12,7 +12,6 @@ knitr::opts_chunk$set( ```{r setup, echo = FALSE} library(nipnTK) -library(bbw) library(knitr) library(kableExtra) ``` @@ -40,10 +39,15 @@ The dataset `dp.ex02` is a comma-separated-value (CSV) file containing anthropom ### Tabulation and visualisation -The NiPN data quality toolkit provides an R language function called `recode()` that makes it easy to recode and group data. We will use the `recode()` function to group the data in the age variable (age in months) into year-centred age-groups. +We will use the base R function `cut()` to group the data in the age variable (age in months) into year-centred age-groups. ```{r as2, echo = TRUE, eval = TRUE} -svy$ycag <- recode(svy$age, "6:17=1; 18:29=2; 30:41=3; 42:53=4; 54:59=5") +svy$ycag <- cut( + svy$age, + breaks = c(6, 18, 30, 42, 54, 60), + labels = 1:5, + include.lowest = TRUE, right = FALSE +) head(svy) ``` @@ -134,19 +138,7 @@ pyramid.plot(svy$ycag, svy$sex, The `pyramid.plot()` function uses the values of the grouped age variable as y-axis value labels. -We can assign descriptive text values using the `recode()` function. For example: - -```{r as7, echo = TRUE, eval = TRUE, fig.align = "center"} -svy$ageLabel <- recode(svy$age, "6:29='< 30 months'; 30:hi='30 month or older'") - -pyramid.plot(svy$ageLabel, - svy$sex, - main = "Distribution of age by sex", - xlab = "Frequency (Males | Females)", - ylab = "Age-group") -``` - -We can also use a factor type variable. This type of variable allows labels to be specified: +We can use a factor type variable. This type of variable allows labels to be specified: ```{r as7a, echo = TRUE, eval = TRUE, fig.align = "center"} svy$ageLabel <- factor(svy$ycag, @@ -214,7 +206,7 @@ p This yields the following survival probabilities: -```{r as9a, echo = TRUE, eval = TRUE} +```{r as9a, echo = FALSE, eval = TRUE} z <- (1 / 10000) * 365.25 t <- 0:4 @@ -321,7 +313,7 @@ In this example the age distribution is significantly different from expected nu Note that we specify the degrees of freedom (`df`) for the Chi-Squared test as the number of age-groups minus one. As we have five age-groups we specify `df = 4`. The degrees of freedom (`df`) that we need to specify will depend on the number of age-groups that we use. It is always the number of age-groups minus one. If, for example, there are ten age-groups we would need to specify `df = 9`. -The NiPN data quality toolkit provides an R function called `ageChildren()` that performs the model- based Chi-Squared test: +The NiPN data quality toolkit provides an R function called `ageChildren()` that performs the model-based Chi-Squared test specifically for a sample of children aged 6-59 months: ```{r as10, echo = TRUE, eval = FALSE} ageChildren(svy$age, u5mr = 1) @@ -420,7 +412,6 @@ females <- c(564103, 523046, 499895, 482923, 467949) df <- data.frame(age, both, males, females) kable(x = df, - booktabs = TRUE, col.names = c("Age", "Both Sexes", "Males", "Females")) %>% kable_styling(bootstrap_options = c("striped"), full_width = FALSE) ``` @@ -493,10 +484,16 @@ The age ratio is defined as: $$ \text{Age ratio} ~ = ~ \frac{\text{number of children aged between 6 and 29 months}}{\text{number of children aged between 30 and 59 months}} $$ -We will use the `recode()` function from NiPN data quality toolkit to create the relevant age-groups: +We will use the base R `cut()` function to create the relevant age-groups: ```{r as20, echo = TRUE, eval = TRUE} -svy$ageGroup <- recode(svy$age, "6:29=1; 30:59=2") +svy$ageGroup <- cut( + svy$age, + breaks = c(6, 30, 60), + labels = 1:2, + include.lowest = TRUE, + right = FALSE +) head(svy) ```