Merge pull request #35 from nutriverse/v0.1.1

address CRAN feedback

.Rbuildignore

@@ -22,3 +22,4 @@
 ^\.github$
 ^pkgdown$
 ^cran-comments\.md$
+^CRAN-RELEASE$

DESCRIPTION

@@ -23,7 +23,8 @@ Depends: R (>= 2.10)
 Imports: 
     stats,
     graphics,
-    bbw
+    bbw,
+    withr
 Suggests: 
     testthat,
     knitr,

NAMESPACE

@@ -52,3 +52,4 @@ importFrom(stats,qqnorm)
 importFrom(stats,quantile)
 importFrom(stats,sd)
 importFrom(stats,var)
+importFrom(withr,local_par)

R/ageChildren.R

@@ -103,7 +103,8 @@ 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 counts
+#' @return Bar plot comparing table of observed counts vs table of expected
+#'   counts
 #'
 #' @examples
 #' # Plot Chi-Squared test for age of children in dp.ex02 sample dataset using
@@ -119,7 +120,7 @@ print.ageChildren <- function(x, ...) {
 
 plot.ageChildren <- function(x, ...) {
   YLIM = c(0, max(max(x$observed), max(x$expected)))
-  par(mfcol = c(1, 2))
+  withr::local_par(mfcol = c(1, 2))
   graphics::barplot(x$observed, main = "Observed", ylim = YLIM)
   graphics::barplot(x$expected, main = "Expected", ylim = YLIM)
 }

R/ageHeaping.R

@@ -41,10 +41,13 @@ ageHeaping <- function(x, divisor = 12) {
   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)) <- paste("Remainder of ",
+                                dataName, " / ",
+                                divisor, sep = "")
   chiSq <- stats::chisq.test(tab)
   pct <- round(prop.table(tab) * 100, 1)
-  result <- list(X2 = chiSq$statistic, df = chiSq$parameter, p = chiSq$p.value, tab = tab, pct = pct)
+  result <- list(X2 = chiSq$statistic, df = chiSq$parameter,
+                 p = chiSq$p.value, tab = tab, pct = pct)
   class(result) <- "ageHeaping"
   return(result)
 }

R/ageRatioTest.R

@@ -27,6 +27,7 @@
 #'
 #' # The age ratio test applied to data for each sex separately
 #' by(svy$age, svy$sex, ageRatioTest, ratio = 0.85)
+#'
 #' @export
 #'
 #

R/boxText.R

@@ -13,13 +13,16 @@
 #' @return NULL
 #'
 #' @examples
-#' \dontrun{
-#'   boxText(x = sum(par("usr")[1:2]) / 2,
-#'           y = max(x$tab) * 0.1,
-#'           labels = "(numbers on bars represent the proportions in each class)",
-#'           cex = cex,
-#'           pad = TRUE)
-#' }
+#' ## Use of boxtext in the ageHeaping plot function
+#' svy <- dp.ex02
+#' ah12 <- ageHeaping(svy$age)
+#'
+#' plot.new()
+#' boxText(x = as.numeric(names(ah12$tab)),
+#'         y = max(ah12$tab) * 0.1,
+#'         labels = paste(sprintf(fmt = "%3.1f", ah12$pct), "%", sep = ""),
+#'         cex = 0.5,
+#'         pad = TRUE)
 #'
 #' @export
 #'
@@ -34,9 +37,10 @@ boxText <- function(x,
                     border = FALSE,
                     lwd = 0.5,
                     pad = TRUE) {
-  w <- strwidth(labels, cex = cex)
-  w <- ifelse(pad, w + strwidth("w", cex = cex), w)
-  h <- 2 * strheight(labels, cex = cex)
-  rect(x - w / 2, y - h / 2, x + w / 2, y + h / 2, col = col, border = border, lwd = lwd)
-  text(x, y, labels = labels, cex = cex)
+  w <- graphics::strwidth(labels, cex = cex)
+  w <- ifelse(pad, w + graphics::strwidth("w", cex = cex), w)
+  h <- 2 * graphics::strheight(labels, cex = cex)
+  graphics::rect(x - w / 2, y - h / 2, x + w / 2, y + h / 2,
+                 col = col, border = border, lwd = lwd)
+  graphics::text(x, y, labels = labels, cex = cex)
 }

R/digitPreference.R

@@ -47,9 +47,11 @@ digitPreference <- function(x, digits = 1, values = 0:9) {
   finalDigit <- substr(x, nchar(x), nchar(x))
   tab <- fullTable(finalDigit, values = values)
   names(dimnames(tab)) <- dataName
-  chiSq <- chisq.test(tab)
+  chiSq <- stats::chisq.test(tab)
   pct <- round(prop.table(tab) * 100, 1)
-  dps <- round(100 * sqrt(chiSq$statistic / (sum(chiSq$observed) * chiSq$parameter)), 2)
+  dps <- round(
+    100 * sqrt(chiSq$statistic / (sum(chiSq$observed) * chiSq$parameter)), 2
+  )
   dpsClass <- ifelse(dps < 8, "Excellent",
                 ifelse(dps < 12, "Good",
                   ifelse(dps < 20, "Acceptable", "Problematic")))
@@ -121,11 +123,10 @@ plot.digitPreference <- function(x,
                                  ylab = "Frequency",
                                  cex = 0.75,
                                  ...) {
-
   main <- ifelse(main == "", names(dimnames(x$tab)), main)
   main <- paste(main, " (DPS = ", x$dps, " : ", x$dpsClass, ")", sep = "")
   plot(x$tab, main = main, xlab = xlab, ylab = ylab, frame.plot = FALSE, lwd = 3)
-  abline(h = sum(x$tab) / length(x$tab), lty = 3)
+  graphics::abline(h = sum(x$tab) / length(x$tab), lty = 3)
   boxText(as.numeric(names(x$tab)), rep(max(x$tab) * 0.2, length(x$tab)),
           paste(sprintf(fmt = "%3.1f", x$pct), "%", sep = ""),
           cex = cex, pad = FALSE)

R/greensIndex.R

@@ -40,11 +40,17 @@
 #' # (flag.ex01)
 #' svy <- flag.ex01
 #' svy$flag <- 0
-#' svy$flag <- ifelse(!is.na(svy$haz) & (svy$haz < -6 | svy$haz > 6), svy$flag + 1, svy$flag)
-#' svy$flag <- ifelse(!is.na(svy$whz) & (svy$whz < -5 | svy$whz > 5), svy$flag + 2, svy$flag)
-#' svy$flag <- ifelse(!is.na(svy$waz) & (svy$waz < -6 | svy$waz > 5), svy$flag + 4, svy$flag)
+#' svy$flag <- ifelse(!is.na(svy$haz) & (svy$haz < -6 | svy$haz > 6),
+#'                    svy$flag + 1, svy$flag)
+#' svy$flag <- ifelse(!is.na(svy$whz) & (svy$whz < -5 | svy$whz > 5),
+#'                    svy$flag + 2, svy$flag)
+#' svy$flag <- ifelse(!is.na(svy$waz) & (svy$waz < -6 | svy$waz > 5),
+#'                    svy$flag + 4, svy$flag)
 #' svy <- svy[svy$flag == 0, ]
 #' svy$stunted <- ifelse(svy$haz < -2, 1, 2)
+#'
+#' ## set seed to 0 to replicate results
+#' set.seed(0)
 #' greensIndex(data = svy, psu = "psu", case = "stunted")
 #'
 #' @export
@@ -54,15 +60,18 @@
 
 greensIndex <- function(data, psu, case, replicates = 999) {
   caseCounts <- table(data[[psu]], data[[case]])[ ,"1"]
-  set.seed(0)
+
   boot <- NULL
 
   for(i in 1:replicates) {
     counts <- sample(x = caseCounts, replace = TRUE)
     boot <- c(boot, (var(counts) / mean(counts) - 1) / (sum(counts) - 1))
   }
 
-  GI <- round(stats::quantile(boot, probs = c(0.5, 0.025, 0.975), na.rm = TRUE), 4)
+  GI <- round(stats::quantile(boot,
+                              probs = c(0.5, 0.025, 0.975),
+                              na.rm = TRUE), 4)
+
   p <- 1 - sum(boot > 0, na.rm = TRUE) / sum(!is.na(boot))
 
   if(GI[1] < 0) {

R/histNormal.R

@@ -32,9 +32,11 @@ histNormal <- function(x,
                        main = deparse(substitute(x)),
                        breaks = "Sturges",
                        ylim = NULL) {
-  h <- hist(x, plot = FALSE, breaks = breaks)
+  h <- graphics::hist(x, plot = FALSE, breaks = breaks)
   xfit <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length = 100)
-  yfit <- dnorm(xfit, mean = mean(x, na.rm = TRUE), sd = sd(x, na.rm = TRUE))
+  yfit <- stats::dnorm(xfit,
+                       mean = mean(x, na.rm = TRUE),
+                       sd = stats::sd(x, na.rm = TRUE))
   yfit <- yfit * diff(h$mids[1:2]) * length(x)
 
   if(is.null(ylim)) {

R/national.SMART.R

@@ -33,11 +33,12 @@ national.SMART <- function(x, strata, indices = c("haz", "whz", "waz")) {
 
     for(j in indices) {
       referenceMean <- mean(stratumData[[j]], na.rm = TRUE)
-      stratumData$flagSMART <- ifelse(!is.na(stratumData[[j]]) &
-                                        (stratumData[[j]] < (referenceMean - 3) |
-                                           stratumData[[j]] > (referenceMean + 3)),
-                                      stratumData$flagSMART + 2^lambda,
-                                      stratumData$flagSMART)
+      stratumData$flagSMART <- ifelse(
+        !is.na(stratumData[[j]]) &
+          (stratumData[[j]] < (referenceMean - 3) |
+             stratumData[[j]] > (referenceMean + 3)),
+        stratumData$flagSMART + 2 ^ lambda, stratumData$flagSMART
+      )
       lambda <- lambda + 1
     }
     result <- rbind(result, stratumData)

R/nipnTK.R

@@ -13,6 +13,7 @@
 #' @importFrom graphics abline axTicks axis barplot hist lines par plot rect
 #'   strheight strwidth text
 #' @importFrom bbw recode
+#' @importFrom withr local_par
 #'
 #
 ################################################################################

R/outliersMD.R

@@ -19,8 +19,10 @@
 
 outliersMD <- function(x, y, alpha = 0.001) {
   df <- data.frame(x, y)
-  md <- mahalanobis(df, colMeans(df, na.rm = TRUE), cov(df, use = "complete.obs"))
-  p <- pchisq(md, 2, lower.tail = FALSE)
+  md <- stats::mahalanobis(df,
+                           colMeans(df, na.rm = TRUE),
+                           stats::cov(df, use = "complete.obs"))
+  p <- stats::pchisq(md, 2, lower.tail = FALSE)
   outlierMD <- (p < alpha)
   return(outlierMD)
 }

cran-comments.md

@@ -1,3 +1,19 @@
+## 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.
+
 ## Test environments
 * local R installation, R 4.0.3
 * ubuntu 20.04 (on GitHub Actions), R 4.0.3