.

R/set_survey.R

@@ -11,7 +11,7 @@
 #'
 #' @param design a survey object (`survey.design` or `svyrep.design`)
 #'
-#' @return Object with info about the survey.
+#' @return Info about the survey.
 #' @export
 #'
 #' @examples

R/survey_subset.R

@@ -1,10 +1,10 @@
 #' Subset a survey, while preserving variable labels
 #'
-#' @param design a survey design object
+#' @param design a survey object
 #' @param subset an expression specifying the sub-population
-#' @param label survey label of the newly created survey design object
+#' @param label survey label of the newly created survey object
 #'
-#' @return a new survey design object
+#' @return a new survey object
 #' @export
 #'
 #' @examples

R/svyciprop_adjusted.R

@@ -1,17 +1,17 @@
 #' Confidence intervals for proportions, adjusted for degrees of freedom
 #'
-#' A version of `survey::svyciprop` that adjusts for the degrees of freedom when `method == "beta"`.
+#' A version of `survey::svyciprop()` that adjusts for the degrees of freedom when `method = "beta"`.
 #'
 #' Written by Makram Talih in 2019.
 #'
 #' To use this function in tabulations, type: `options(surveytable.adjust_svyciprop = TRUE)`.
 #'
-#' @param formula see `survey::svyciprop`.
-#' @param design see `survey::svyciprop`.
-#' @param method see `survey::svyciprop`.
-#' @param level see `survey::svyciprop`.
+#' @param formula see `survey::svyciprop()`.
+#' @param design see `survey::svyciprop()`.
+#' @param method see `survey::svyciprop()`.
+#' @param level see `survey::svyciprop()`.
 #' @param df_method how `df` should be calculated: "default" or "NHIS".
-#' @param ... see `survey::svyciprop`.
+#' @param ... see `survey::svyciprop()`.
 #'
 #' `df_method`: for "default", `df = degf(design)`; for "NHIS", `df = nrow(design) - 1`.
 #'
@@ -26,50 +26,52 @@
 #' tab("AGER")
 svyciprop_adjusted = function(formula
                     , design
-                    , method = c("logit", "likelihood", "asin", "beta", "mean")
+                    , method = c("logit", "likelihood", "asin", "beta"
+                                 , "mean", "xlogit")
                     , level = 0.95
                     , df_method
                     , ...) {
   assert_that(df_method %in% c("default", "NHIS"))
   df = switch(df_method,
-     default = degf(design),
-     NHIS = nrow(design) - 1
+              default = degf(design),
+              NHIS = nrow(design) - 1
   )
-  method = match.arg(method)
-  if (method == "beta") {
-    m = eval(bquote(svymean(~as.numeric(.(formula[[2]])), design, ...)))
-    rval = coef(m)[1]
 
-    #Effective sample size
-    n.eff = coef(m) * (1 - coef(m))/stats::vcov(m)
+  method = match.arg(method)
+  if (method != "beta") {
+    return( svyciprop(formula, design, method, level, df, ...) )
+  }
 
-    attr(rval, "var") = stats::vcov(m)
-    alpha = 1 - level
+  m = eval(bquote(svymean(~as.numeric(.(formula[[2]])), design, ...)))
+  rval = coef(m)[1]
 
-    # Degrees of freedom used only for adjusting effective sample size, below
+  #Effective sample size
+  n.eff = coef(m) * (1 - coef(m))/stats::vcov(m)
 
-    # For NHIS, provisional guideline is to override the R default
-    # df = nrow(design) - 1  ## uncomment this row to override R default
+  attr(rval, "var") = stats::vcov(m)
+  alpha = 1 - level
 
-    # R-default from degf(design) uses subdomain Strata and PSUs
+  # Degrees of freedom used only for adjusting effective sample size, below
 
-    if (df >0) {     #Korn-Graubard df-adjustment factor
-      rat.squ = (qt(alpha/2, nrow(design) - 1)/qt(alpha/2, df))^2
-    } else {
-      rat.squ = 0 # limit case: set to zero
-    }
+  # For NHIS, provisional guideline is to override the R default
+  # df = nrow(design) - 1  ## uncomment this row to override R default
 
-    if (rval > 0) {  #Adjusted effective sample size
-      n.eff = min(nrow(design), n.eff*rat.squ)
-    } else {
-      n.eff = nrow(design) #limit case: set to sample size
-    }
+  # R-default from degf(design) uses subdomain Strata and PSUs
 
-    ci = c(stats::qbeta(alpha/2, n.eff*rval, n.eff*(1-rval)+1), stats::qbeta(1-alpha/2, n.eff*rval+1, n.eff*(1 - rval)))
+  if (df >0) {     #Korn-Graubard df-adjustment factor
+    rat.squ = (qt(alpha/2, nrow(design) - 1)/qt(alpha/2, df))^2
+  } else {
+    rat.squ = 0 # limit case: set to zero
   }
-  else {
-    svyciprop(formula, design, method, level, df, ...)
+
+  if (rval > 0) {  #Adjusted effective sample size
+    n.eff = min(nrow(design), n.eff*rat.squ)
+  } else {
+    n.eff = nrow(design) #limit case: set to sample size
   }
+
+  ci = c(stats::qbeta(alpha/2, n.eff*rval, n.eff*(1-rval)+1), stats::qbeta(1-alpha/2, n.eff*rval+1, n.eff*(1 - rval)))
+
   halfalpha = (1 - level)/2
   names(ci) = paste(round(c(halfalpha, (1 - halfalpha))*100, 1), "%", sep = "")
   names(rval) = deparse(formula[[2]])

R/tab.R

@@ -25,7 +25,7 @@
 #' @param max_levels a categorical variable can have at most this many levels. Used to avoid printing huge tables.
 #' @param csv     name of a CSV file
 #'
-#' @return A list of `data.frame` tables or a single `data.frame` table.
+#' @return A list of tables or a single table.
 #' @family tables
 #' @export
 #'

R/tab_rate.R

@@ -2,7 +2,7 @@
 #'
 #' Calculate the rates for categorical (factor) or logical variables.
 #'
-#' @param vr      variable to tabulate
+#' @param vr variable to tabulate
 #' @param pop   either a single number or a `data.frame` with columns named
 #' `Level` and `Population`. `Level` must
 #' exactly match the levels of `vr`. `Population` is the population for that
@@ -12,7 +12,7 @@
 #' @param max_levels a categorical variable can have at most this many levels. Used to avoid printing huge tables.
 #' @param csv     name of a CSV file
 #'
-#' @return A list of `data.frame` tables or a single `data.frame` table.
+#' @return A list of tables or a single table.
 #' @family tables
 #' @export
 #'

R/tab_subset.R

@@ -25,9 +25,7 @@
 #' @param max_levels a categorical variable can have at most this many levels. Used to avoid printing huge tables.
 #' @param csv     name of a CSV file
 #'
-#' @return
-#' * `tab_subset`: A list of `data.frame` tables or a single `data.frame` table.
-#' * `tab_cross`: A `data.frame` table.
+#' @return A list of tables or a single table.
 #'
 #' @family tables
 #'
@@ -71,7 +69,20 @@ tab_subset = function(vr, vrby, lvls = c()
   # Need to convert to factor for testing
   if (is.logical(design$variables[,vr])) {
     lbl = attr(design$variables[,vr], "label")
-    design$variables[,vr] %<>% factor %>% droplevels %>% .fix_factor
+    design$variables[,vr] %<>% factor %>% droplevels
+
+    if (drop_na) {
+      design = design[which(!is.na(design$variables[,vr])),]
+      if(inherits(design, "svyrep.design")) {
+        design$prob = 1 / design$pweights
+      }
+      # drop_na in .tab_factor will set this
+      # lbl %<>% paste("(knowns only)")
+    } else {
+      design$variables[,vr] %<>% .fix_factor
+    }
+    assert_that(noNA(design$variables[,vr]), noNA(levels(design$variables[,vr])))
+
     attr(design$variables[,vr], "label") = lbl
   }
 

R/tab_subset_rate.R

@@ -14,7 +14,7 @@
 #' @param max_levels a categorical variable can have at most this many levels. Used to avoid printing huge tables.
 #' @param csv     name of a CSV file
 #'
-#' @return A list of `data.frame` tables or a single `data.frame` table.
+#' @return A list of tables or a single table.
 #' @family tables
 #' @export
 #'

R/total.R

@@ -2,7 +2,7 @@
 #'
 #' @param csv     name of a CSV file
 #'
-#' @return `data.frame`
+#' @return A table
 #' @family tables
 #' @export
 #'

R/total_rate.R

@@ -4,7 +4,7 @@
 #' @param per calculate rate per this many items in the population
 #' @param csv     name of a CSV file
 #'
-#' @return `data.frame`
+#' @return A table
 #' @family tables
 #' @export
 #'

R/var_any.R

@@ -6,7 +6,7 @@
 #' @param newvr   name of the new variable to be created
 #' @param vrs   vector of logical variables
 #'
-#' @return (Nothing.)
+#' @return Survey object
 #' @family variables
 #' @export
 #'

R/var_case.R

@@ -4,7 +4,7 @@
 #' @param vr factor variable
 #' @param cases one or more levels of `vr` that are converted to `TRUE`. All other levels are converted to `FALSE`.
 #'
-#' @return (Nothing.)
+#' @return Survey object
 #' @family variables
 #' @export
 #'

R/var_collapse.R

@@ -6,7 +6,7 @@
 #' @param newlevel name of the new level
 #' @param oldlevels vector of old levels
 #'
-#' @return (Nothing.)
+#' @return Survey object
 #' @family variables
 #' @export
 #'

R/var_copy.R

@@ -6,7 +6,7 @@
 #' @param newvr   name of the new variable to be created
 #' @param vr variable
 #'
-#' @return (Nothing.)
+#' @return Survey object
 #' @family variables
 #' @export
 #'

R/var_cross.R

@@ -7,7 +7,7 @@
 #' @param vr      first variable
 #' @param vrby    second variable
 #'
-#' @return (Nothing.)
+#' @return Survey object
 #' @family variables
 #' @export
 #'

R/var_cut.R

@@ -7,7 +7,7 @@
 #' @param breaks see [`cut()`]
 #' @param labels see [`cut()`]
 #'
-#' @return (Nothing.)
+#' @return Survey object
 #' @family variables
 #' @export
 #'

R/var_list.R

@@ -4,7 +4,7 @@
 #' @param all     print all variables?
 #' @param csv     name of a CSV file
 #'
-#' @return `data.frame`
+#' @return A table
 #' @export
 #'
 #' @examples

R/z_data.R

@@ -7,7 +7,7 @@
 #' `namcs2019sv_df` is a data frame.
 #'
 #' `namcs2019sv` is a survey object created from `namcs2019sv_df`
-#' using `survey::svydesign()`.
+#' using `[survey::svydesign()]`.
 #'
 #' @source
 #' * SAS data: <https://ftp.cdc.gov/pub/Health_Statistics/NCHS/Dataset_Documentation/NAMCS/sas/namcs2019_sas.zip>

R/z_utils.R

@@ -1,3 +1,5 @@
+# if (drop_na) do that, else .fix_factor
+# then, assert noNA
 .fix_factor = function(xx) {
   assert_that(is.factor(xx))
   idx = which(is.na(xx))

docs/pkgdown.yml

@@ -4,7 +4,7 @@ pkgdown_sha: ~
 articles:
   Example-National-Ambulatory-Medical-Care-Survey-NAMCS-tables: Example-National-Ambulatory-Medical-Care-Survey-NAMCS-tables.html
   surveytable: surveytable.html
-last_built: 2024-01-18T12:13Z
+last_built: 2024-01-18T15:04Z
 urls:
   reference: https://cdcgov.github.io/surveytable/reference
   article: https://cdcgov.github.io/surveytable/articles