csv

Author: astra-cdc

NEWS.md

@@ -8,6 +8,7 @@ value of interest.
 * Confidence intervals for numeric variables. 
 * Excel tables and charts! `set_opts( output = "excel", file = "my_workbook" )`
 * Improved conversion of tables to data frames with `as.data.frame()`.
+* The interface for CSV printing is now the same as for all other kinds of printing: `set_opts( output = "CSV", file = "my_file" )`
 
 # surveytable 0.9.8
 

R/as.data.frame.R

@@ -22,7 +22,7 @@
 #'
 #' @examples
 #' set_survey(namcs2019sv)
-#' tab("AGER") |> as.data.frame()
+#' as.data.frame( tab("AGER") )
 as.data.frame.surveytable_table = function(x, ...) {
   class(x) = "data.frame"
   names(x) = make.names( names(x), unique = TRUE )

R/codebook.R

@@ -1,19 +1,17 @@
 #' Create a codebook for the survey
 #'
 #' @param all tabulate all the variables?
-#' @param csv name of a CSV file
 #'
 #' @return A list of tables.
 #' @export
 #'
 #' @examples
 #' set_survey(namcs2019sv)
 #' codebook()
-codebook = function(all = FALSE
-    , csv = getOption("surveytable.csv")) {
+codebook = function(all = FALSE) {
   design = .load_survey()
   lret = list()
-  lret[[1]] = set_survey(design, csv = csv)
+  lret[[1]] = set_survey(design)
 
   nn = names(design$variables)
   nr = nrow(design$variables)
@@ -81,7 +79,7 @@ codebook = function(all = FALSE
 
   attr(ret, "title") = "Codebook"
   attr(ret, "num") = 5
-  lret[[2]] = .write_out(ret, csv = csv)
+  lret[[2]] = .finalize_tab(ret)
 
   if (all) {
     op_ = options(surveytable.find_lpe = FALSE)
@@ -98,8 +96,7 @@ codebook = function(all = FALSE
       lret[[n1]] = tab(n1
                        , test = FALSE
                        , drop_na = FALSE
-                       , max_levels = Inf
-                       , csv = csv)
+                       , max_levels = Inf)
       attr(env$survey$variables[,ii], "label") = lbl0
     }
   }

R/set_opts.R

@@ -35,34 +35,35 @@
 #' * `"Excel"`: print to an Excel workbook. Please specify the name of an Excel file using
 #' the `file` argument. Before using Excel printing, please be sure to install these
 #' packages: `openxlsx2` and `mschart`.
+#' * `"CSV"`: print to a comma-separated values (CSV) file. Please specify the name of a
+#' CSV file using the `file` argument.
 #'
 #' @param reset reset all options to their default values?
 #' @param mode `"general"` or `"NCHS"`. See below for details.
 #' @param adj adjustment to the Korn and Graubard confidence intervals for proportions. See
 #' `svyciprop_adjusted()` for details.
 #' @param output specify how the output is printed: `"auto"` (default); `"huxtable"`, `"gt"`, or
-#' `"kableExtra"`; `"raw"`; or `"Excel"`. If `output` is `"Excel"`: must also specify `file`; be
-#' sure to install `openxlsx2` and `mschart`.
+#' `"kableExtra"`; `"raw"`; `"Excel"` or `"CSV"`. If `output` is `"Excel"` or `"CSV"`, must also specify
+#' `file`. If `output` is `"Excel"`, be sure to install `openxlsx2` and `mschart`.
 #' @param file file name (see `output`).
 #' @param .file_temp place `file` in a temporary folder?
 #' @param count round counts to the nearest integer (`"int"`) or one thousand (`"1k"`).
 #' @param lpe identify low-precision estimates?
 #' @param drop_na drop missing values (`NA`)? Categorical variables only.
 #' @param max_levels a categorical variable can have at most this many levels.
 #' Used to avoid printing huge tables.
-#' @param csv the name of a CSV file or `""` to turn off CSV output.
 #'
 #' @return (Nothing.)
 #' @family options, print
 #' @export
 #'
 #' @examples
-#' # Send output to a CSV file:
-#' file_name = tempfile(fileext = ".csv")
-#' suppressMessages( set_opts(csv = file_name) )
 #' set_survey(namcs2019sv)
+#'
+#' # Round counts to the nearest one thousand:
+#' set_opts(count = "1k")
 #' tab("AGER")
-#' set_opts(csv = "") # Turn off CSV output
+#' set_opts(count = "int")
 #'
 #' show_opts()
 set_opts = function(
@@ -76,7 +77,6 @@ set_opts = function(
     , lpe = NULL
     , drop_na = NULL
     , max_levels = NULL
-    , csv = NULL
     ) {
 
   #### !!! If making changes, update: .onLoad(), set_opts(), show_opts(), .check_options()
@@ -124,7 +124,7 @@ set_opts = function(
   if (!is.null(output)) {
     if (getOption("surveytable.print") == ".print_excel") .print_excel_finish()
 
-    output %<>% .mymatch(c("huxtable", "gt", "kableExtra", "auto", "raw", "excel"))
+    output %<>% .mymatch(c("huxtable", "gt", "kableExtra", "auto", "raw", "excel", "csv"))
     if (output == "auto") {
       message("* Printing with huxtable for screen, gt for HTML, or kableExtra for PDF.")
       options(surveytable.raw = FALSE
@@ -140,26 +140,8 @@ set_opts = function(
       options(surveytable.raw = TRUE
               , surveytable.print = ".print_raw"
               , surveytable.file = "", surveytable.file_show = "")
-    } else if (output == "excel") {
-      assert_that(is.string(file), nzchar(file)
-                  , msg = "For Excel printing, please specify a file name using the file argument.")
-      if (!endsWith(tolower(file), ".xlsx")) {
-        file = glue("{file}.xlsx")
-      }
-      if (!isTRUE(.file_temp)) {
-        file %<>% normalizePath(mustWork = FALSE)
-        file_show = file
-      } else {
-        file = file.path(tempdir(), file)
-        file_show = file %>% basename()
-      }
-      message(glue("* Printing to Excel workbook {file_show}."))
-      if (file.exists(file)) {
-        message("* NOTE: file already exists!")
-      }
-      options(surveytable.raw = FALSE
-              , surveytable.print = ".print_excel"
-              , surveytable.file = file, surveytable.file_show = file_show)
+    } else if (output %in% c("excel", "csv")) {
+      .set_output_file(output = output, file = file, .file_temp = .file_temp)
     }
   }
 
@@ -206,21 +188,36 @@ set_opts = function(
     options(surveytable.max_levels = max_levels)
   }
 
-  if (!is.null(csv)) {
-    assert_that(is.string(csv)
-      , msg = "CSV file name must be a character string.")
-    if (nzchar(csv)) {
-      message(paste0("* Sending CSV output to: ", csv))
-      if (file.exists(csv)) {
-        message("* (File already exists. Output will be appended to the end of the file.)")
-      }
-      message("* To turn off CSV output: set_opts(csv = '')")
-    } else {
-      message("* Turning off CSV output.")
-    }
-    options(surveytable.csv = csv)
-  }
-
   .check_options()
   invisible(NULL)
 }
+
+.set_output_file = function(output, file, .file_temp) {
+  assert_that(output %in% c("excel", "csv"))
+  type = switch(output
+                , excel = "Excel"
+                , csv = "CSV")
+  extension = switch(output
+                     , excel = ".xlsx"
+                     , csv = ".csv")
+  assert_that(is.string(file), nzchar(file)
+              , msg = glue("For {type} printing, please specify a file name using the file argument."))
+  if (!endsWith(tolower(file), extension)) {
+    file = glue("{file}{extension}")
+  }
+  if (!isTRUE(.file_temp)) {
+    file %<>% normalizePath(mustWork = FALSE)
+    file_show = file
+  } else {
+    file = file.path(tempdir(), file)
+    file_show = file %>% basename()
+  }
+  message(glue("* Printing to {type} file {file_show}."))
+  if (file.exists(file)) {
+    message("* NOTE: file already exists!")
+  }
+  options(surveytable.raw = FALSE
+          , surveytable.print = glue(".print_{output}")
+          , surveytable.file = file, surveytable.file_show = file_show)
+}
+

R/set_survey.R

@@ -10,7 +10,6 @@
 #'
 #' @param design a survey object, created with [survey::svydesign()] or
 #' [survey::svrepdesign()]. For an unweighted survey, a `data.frame` or similar.
-#' @param csv name of a CSV file
 #' @param ... arguments to [set_opts()].
 #'
 #' @family options
@@ -20,7 +19,7 @@
 #' @examples
 #' set_survey(namcs2019sv)
 #' set_survey(namcs2019sv, mode = "general")
-set_survey = function(design, csv = getOption("surveytable.csv"), ...) {
+set_survey = function(design, ...) {
   # In case there's an error below and we don't set a new survey,
   # don't retain the previous survey either.
   env$survey = NULL
@@ -107,7 +106,7 @@ set_survey = function(design, csv = getOption("surveytable.csv"), ...) {
   env$survey = design
 
   .check_options()
-  .write_out(out, csv = csv)
+  .finalize_tab(out)
 }
 
 .load_survey = function() {

R/show_opts.R

@@ -26,6 +26,7 @@ show_opts = function() {
          , ".print_auto" = "* Printing with huxtable for screen, gt for HTML, or kableExtra for PDF."
          , ".print_raw" = "* Generating unformatted / raw output."
          , ".print_excel" = glue("* Printing to Excel workbook {getOption('surveytable.file_show')}.")
+         , ".print_csv" = glue("* Printing to CSV file {getOption('surveytable.file_show')}.")
          , glue("* Printing with a custom function: {xx}")) %>% message
 
   if (getOption("surveytable.raw")) {
@@ -60,19 +61,6 @@ show_opts = function() {
   assert_that(is.count(max_levels))
   message(paste0("* Maximum number of levels is: ", max_levels))
 
-  csv = getOption("surveytable.csv")
-  assert_that(is.string(csv)
-              , msg = "CSV file name must be a character string.")
-  if (nzchar(csv)) {
-    message(paste0("* Sending CSV output to: ", csv))
-    if (file.exists(csv)) {
-      message("* (File already exists. Output will be appended to the end of the file.)")
-    }
-    message("* To turn off CSV output: set_opts(csv = '')")
-  } else {
-    message("* CSV output has been turned off.")
-  }
-
   .check_options()
   invisible(NULL)
 }

R/tab.R

@@ -34,7 +34,6 @@
 #' @param p_adjust adjust p-values for multiple comparisons?
 #' @param drop_na drop missing values (`NA`)? Categorical or logical variables only.
 #' @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 tables or a single table.
 #' @family tables
@@ -54,7 +53,6 @@ tab = function(...
                , test = FALSE, alpha = 0.05, p_adjust = FALSE
                , drop_na = getOption("surveytable.drop_na")
                , max_levels = getOption("surveytable.max_levels")
-               , csv = getOption("surveytable.csv")
                ) {
 	ret = list()
 	if (...length() > 0) {
@@ -74,20 +72,17 @@ tab = function(...
 			  ret[[vr]] = .tab_factor(design = design
                       , vr = vr
                       , drop_na = drop_na
-                      , max_levels = max_levels
-                      , csv = csv)
+                      , max_levels = max_levels)
 			  if (test) {
 			    ret[[paste0(vr, " - test")]] = .test_factor(design = design
                                             , vr = vr
                                             , drop_na = drop_na
                                             , alpha = alpha
-                                            , p_adjust = p_adjust
-                                            , csv = csv)
+                                            , p_adjust = p_adjust)
 			  }
 			} else if (is.numeric(design$variables[,vr])) {
 			  ret[[vr]] = .tab_numeric(design = design
-                      , vr = vr
-                      , csv = csv)
+                      , vr = vr)
 			} else {
         warning(glue("{vr}: must be logical, categorical (factor or character),",
           " or numeric. Is {o2s(design$variables[,vr])}"))
@@ -99,7 +94,7 @@ tab = function(...
 	if (length(ret) == 1L) ret[[1]] else ret
 }
 
-.tab_factor = function(design, vr, drop_na, max_levels, csv) {
+.tab_factor = function(design, vr, drop_na, max_levels) {
   nm = names(design$variables)
   assert_that(vr %in% nm, msg = paste("Variable", vr, "not in the data."))
 
@@ -143,7 +138,7 @@ tab = function(...
 	  }
 	  attr(mp, "num") = 2:6
 	  attr(mp, "title") = .getvarname(design, vr)
-    return(.write_out(mp, csv = csv))
+    return(.finalize_tab(mp))
 	} else if (nlv > max_levels) {
 	  # don't use assert_that
 	  # if multiple tables are being produced, want to go to the next table
@@ -277,7 +272,7 @@ tab = function(...
 	  mp %<>% .add_flags( list(pro, pco, ppo) )
 	}
 
-	.write_out(mp, csv = csv)
+	.finalize_tab(mp)
 }
 
 .add_flags = function(df1, lfo) {

R/tab_cross.R

@@ -1,9 +1,7 @@
 #' @rdname tab_subset
 #' @export
-tab_cross = function(vr, vrby
-                     , max_levels = getOption("surveytable.max_levels")
-                     , csv = getOption("surveytable.csv")
-) {
+tab_cross = function(vr, vrby, max_levels = getOption("surveytable.max_levels")
+                     ) {
   design = .load_survey()
 
   # Ensure unique name
@@ -18,8 +16,7 @@ tab_cross = function(vr, vrby
     , .getvarname(design, vrby), ")")
   ret = .tab_factor(design = design, vr = newvr
                     , drop_na = FALSE
-                , max_levels = max_levels
-                , csv = csv)
+                    , max_levels = max_levels)
 
   design$variables[,newvr] = NULL
   env$survey = design

R/tab_rate.R

@@ -10,7 +10,6 @@
 #' @param per calculate rate per this many items in the population
 #' @param drop_na drop missing values (`NA`)?
 #' @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 tables or a single table.
 #' @family tables
@@ -27,7 +26,6 @@ tab_rate = function(vr, pop
   , per = getOption("surveytable.rate_per")
   , drop_na = getOption("surveytable.drop_na")
   , max_levels = getOption("surveytable.max_levels")
-  , csv = getOption("surveytable.csv")
   ) {
 
   assert_that(is.data.frame(pop) || is.number(pop)
@@ -61,8 +59,7 @@ tab_rate = function(vr, pop
   tfo = .tab_factor(design = design
             , vr = vr
             , drop_na = drop_na
-            , max_levels = max_levels
-            , csv = "")
+            , max_levels = max_levels)
 
   if (pop_df) {
     pop$Population = pop$Population / per
@@ -95,5 +92,5 @@ tab_rate = function(vr, pop
   attr(m1, "num") = 2:6
   attr(m1, "footer") = attr(tfo, "footer")
 
-  .write_out(m1, csv = csv)
+  .finalize_tab(m1)
 }