support format.freq

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 0.2.0.9011
-Date: 2018-07-15
+Version: 0.2.0.9012
+Date: 2018-07-16
 Title: Antimicrobial Resistance Analysis
 Authors@R: c(
     person(

NAMESPACE

@@ -8,6 +8,7 @@ S3method(as.vector,frequency_tbl)
 S3method(as_tibble,frequency_tbl)
 S3method(barplot,mic)
 S3method(barplot,rsi)
+S3method(format,frequency_tbl)
 S3method(hist,frequency_tbl)
 S3method(kurtosis,data.frame)
 S3method(kurtosis,default)
@@ -74,6 +75,7 @@ exportMethods(as.vector.frequency_tbl)
 exportMethods(as_tibble.frequency_tbl)
 exportMethods(barplot.mic)
 exportMethods(barplot.rsi)
+exportMethods(format.frequency_tbl)
 exportMethods(hist.frequency_tbl)
 exportMethods(kurtosis)
 exportMethods(kurtosis.data.frame)
@@ -97,12 +99,15 @@ importFrom(clipr,read_clip_tbl)
 importFrom(clipr,write_clip)
 importFrom(curl,nslookup)
 importFrom(dplyr,"%>%")
+importFrom(dplyr,all_vars)
+importFrom(dplyr,any_vars)
 importFrom(dplyr,arrange)
 importFrom(dplyr,arrange_at)
 importFrom(dplyr,as_tibble)
 importFrom(dplyr,between)
 importFrom(dplyr,desc)
 importFrom(dplyr,filter)
+importFrom(dplyr,filter_at)
 importFrom(dplyr,group_by)
 importFrom(dplyr,group_by_at)
 importFrom(dplyr,if_else)
@@ -118,6 +123,7 @@ importFrom(dplyr,slice)
 importFrom(dplyr,summarise)
 importFrom(dplyr,tibble)
 importFrom(dplyr,top_n)
+importFrom(dplyr,vars)
 importFrom(grDevices,boxplot.stats)
 importFrom(graphics,axis)
 importFrom(graphics,barplot)

NEWS.md

@@ -14,7 +14,7 @@ ratio(c(772, 1611, 737), ratio = "1:2:1")
   * A vignette to explain its usage
   * Support for `table` to use as input: `freq(table(x, y))`
   * Support for existing functions `hist` and `plot` to use a frequency table as input: `hist(freq(df$age))`
-  * Support for `as.vector`, `as.data.frame` and `as_tibble`
+  * Support for `as.vector`, `as.data.frame`, `as_tibble` and `format`
   * Support for quasiquotation: `freq(mydata, mycolumn)` is the same as `mydata %>% freq(mycolumn)`
   * Function `top_freq` function to return the top/below *n* items as vector
   * Header of frequency tables now also show Mean Absolute Deviaton (MAD) and Interquartile Range (IQR)

R/clipboard.R

@@ -7,6 +7,7 @@
 #' This also supports automatic column type transformation, with AMR classes \code{\link{as.rsi}} and \code{\link{as.mic}}.
 #' @rdname clipboard
 #' @name clipboard
+#' @inheritParams base::data.frame
 #' @inheritParams utils::read.table
 #' @inheritParams utils::write.table
 #' @inheritParams readr::locale
@@ -20,6 +21,10 @@
 #' @importFrom utils read.delim write.table object.size
 #' @importFrom readr parse_guess locale
 #' @details
+#' The parameter \code{stringsAsFactors} defaults to \code{FALSE}, as opposed to most base \R methods.
+#'
+#' The parameters \code{date_format} and \code{time_format} also support generic date and time formats like \code{"dd-mm-yyyy"} like Excel.
+#'
 #'   \if{html}{
 #'     \strong{Example for copying from Excel:}
 #'     \out{<div style="text-align: left">}\figure{clipboard_copy.png}\out{</div>}
@@ -36,10 +41,27 @@
 #'     \out{<div style="text-align: left">}\figure{clipboard_rsi.png}\out{</div>}
 #'   }
 #' @export
+#' @examples
+#' \dontrun{
+#'
+#' df1 <- data.frame(a = letters[1:12],
+#'                   b = runif(n = 12, min = 1000, max = 2000),
+#'                   stringsAsFactors = FALSE)
+#' clipboard_export(df1)
+#' df2 <- clipboard_import()
+#' identical(df1, df2)
+#'
+#' # send frequency table to clipboard (e.g. for pasting in Excel)
+#' septic_patients %>%
+#'   freq(age) %>%
+#'   format() %>%       # this will format the percentages
+#'   clipboard_export()
+#' }
 clipboard_import <- function(sep = '\t',
                              header = TRUE,
                              dec = ".",
                              na = c("", "NA", "NULL"),
+                             stringsAsFactors = FALSE,
                              startrow = 1,
                              as_vector = TRUE,
                              guess_col_types = TRUE,
@@ -58,7 +80,7 @@ clipboard_import <- function(sep = '\t',
                                      dec = dec,
                                      na.strings = na,
                                      encoding = 'UTF-8',
-                                     stringsAsFactors = FALSE)
+                                     stringsAsFactors = stringsAsFactors)
 
   # use tibble, so column types will be translated correctly
   import_tbl <- as_tibble(import_tbl)
@@ -91,6 +113,9 @@ clipboard_import <- function(sep = '\t',
     import_tbl <-  import_tbl %>% pull(1)
   }
 
+  # and transform back to data.frame
+  import_tbl <- as.data.frame(import_tbl, stringsAsFactors = stringsAsFactors)
+
   if (info == TRUE) {
     cat("Successfully imported from clipboard:", NROW(import_tbl), "obs. of", NCOL(import_tbl), "variables.\n")
   }

R/freq.R

@@ -100,10 +100,13 @@
 #' # show only the top 5
 #' years %>% print(nmax = 5)
 #'
+#' # save to an object with formatted percentages
+#' years <- format(years)
+#'
 #' # print a histogram of numeric values
 #' septic_patients %>%
 #'   freq(age) %>%
-#'   hist() # prettier: ggplot(septic_patients, aes(age)) + geom_histogram()
+#'   hist()  # prettier: ggplot(septic_patients, aes(age)) + geom_histogram()
 #'
 #' # or print all points to a regular plot
 #' septic_patients %>%
@@ -124,13 +127,20 @@
 #'             freq(age) %>%
 #'             as.vector() %>%
 #'             sort(),
-#'           sort(septic_patients$age)
-#' ) # TRUE
+#'           sort(septic_patients$age)) # TRUE
 #'
-#' # also supports table:
+#' # it also supports `table` objects:
 #' table(septic_patients$sex,
 #'       septic_patients$age) %>%
-#'   freq()
+#'   freq(sep = " **sep** ")
+#'
+#' \dontrun{
+#' # send frequency table to clipboard (e.g. for pasting in Excel)
+#' septic_patients %>%
+#'   freq(age) %>%
+#'   format() %>%       # this will format the percentages
+#'   clipboard_export()
+#' }
 frequency_tbl <- function(x,
                           ...,
                           sort.count = TRUE,
@@ -603,3 +613,20 @@ plot.frequency_tbl <- function(x, y, ...) {
 as.vector.frequency_tbl <- function(x, mode = "any") {
   as.vector(rep(x$item, x$count), mode = mode)
 }
+
+#' @noRd
+#' @exportMethod format.frequency_tbl
+#' @export
+format.frequency_tbl <- function(x, digits = 1, ...) {
+  opt <- attr(x, 'opt')
+  if (opt$nmax.set == TRUE) {
+    nmax <- opt$nmax
+  } else {
+    nmax <- getOption("max.print.freq", default = 15)
+  }
+
+  x <- x[1:nmax,]
+  x$percent <- percent(x$percent, round = digits, force_zero = TRUE)
+  x$cum_percent <- percent(x$cum_percent, round = digits, force_zero = TRUE)
+  base::format.data.frame(x, ...)
+}

man/clipboard.Rd

@@ -7,9 +7,10 @@
 \title{Import/export from clipboard}
 \usage{
 clipboard_import(sep = "\\t", header = TRUE, dec = ".", na = c("", "NA",
-  "NULL"), startrow = 1, as_vector = TRUE, guess_col_types = TRUE,
-  date_names = "en", date_format = "\%Y-\%m-\%d", time_format = "\%H:\%M",
-  tz = Sys.timezone(), encoding = "UTF-8", info = TRUE)
+  "NULL"), stringsAsFactors = FALSE, startrow = 1, as_vector = TRUE,
+  guess_col_types = TRUE, date_names = "en", date_format = "\%Y-\%m-\%d",
+  time_format = "\%H:\%M", tz = Sys.timezone(), encoding = "UTF-8",
+  info = TRUE)
 
 clipboard_export(x, sep = "\\t", dec = ".", na = "", header = TRUE,
   info = TRUE)
@@ -30,6 +31,11 @@ clipboard_export(x, sep = "\\t", dec = ".", na = "", header = TRUE,
 
 \item{na}{the string to use for missing values in the data.}
 
+\item{stringsAsFactors}{logical: should character vectors be converted
+    to factors?  The \sQuote{factory-fresh} default is \code{TRUE}, but
+    this can be changed by setting \code{\link{options}(stringsAsFactors
+      = FALSE)}.}
+
 \item{startrow}{\emph{n}th row to start importing from. When \code{header = TRUE}, the import will start on row \code{startrow} \emph{below} the header.}
 
 \item{as_vector}{a logical value indicating whether data consisting of only one column should be imported as vector using \code{\link[dplyr]{pull}}. This will strip off the header.}
@@ -80,7 +86,11 @@ The data will be read and written as tab-separated by default, which makes it po
 This also supports automatic column type transformation, with AMR classes \code{\link{as.rsi}} and \code{\link{as.mic}}.
 }
 \details{
-\if{html}{
+The parameter \code{stringsAsFactors} defaults to \code{FALSE}, as opposed to most base \R methods.
+
+The parameters \code{date_format} and \code{time_format} also support generic date and time formats like \code{"dd-mm-yyyy"} like Excel.
+
+  \if{html}{
     \strong{Example for copying from Excel:}
     \out{<div style="text-align: left">}\figure{clipboard_copy.png}\out{</div>}
     \cr
@@ -96,6 +106,23 @@ This also supports automatic column type transformation, with AMR classes \code{
     \out{<div style="text-align: left">}\figure{clipboard_rsi.png}\out{</div>}
   }
 }
+\examples{
+\dontrun{
+
+df1 <- data.frame(a = letters[1:12],
+                  b = runif(n = 12, min = 1000, max = 2000),
+                  stringsAsFactors = FALSE)
+clipboard_export(df1)
+df2 <- clipboard_import()
+identical(df1, df2)
+
+# send frequency table to clipboard (e.g. for pasting in Excel)
+septic_patients \%>\%
+  freq(age) \%>\%
+  format() \%>\%       # this will format the percentages
+  clipboard_export()
+}
+}
 \keyword{clipboard}
 \keyword{clipboard_export}
 \keyword{clipboard_import}

man/freq.Rd

@@ -111,10 +111,13 @@ years <- septic_patients \%>\%
 # show only the top 5
 years \%>\% print(nmax = 5)
 
+# save to an object with formatted percentages
+years <- format(years)
+
 # print a histogram of numeric values
 septic_patients \%>\%
   freq(age) \%>\%
-  hist() # prettier: ggplot(septic_patients, aes(age)) + geom_histogram()
+  hist()  # prettier: ggplot(septic_patients, aes(age)) + geom_histogram()
 
 # or print all points to a regular plot
 septic_patients \%>\%
@@ -135,13 +138,20 @@ identical(septic_patients \%>\%
             freq(age) \%>\%
             as.vector() \%>\%
             sort(),
-          sort(septic_patients$age)
-) # TRUE
+          sort(septic_patients$age)) # TRUE
 
-# also supports table:
+# it also supports `table` objects:
 table(septic_patients$sex,
       septic_patients$age) \%>\%
-  freq()
+  freq(sep = " **sep** ")
+
+\dontrun{
+# send frequency table to clipboard (e.g. for pasting in Excel)
+septic_patients \%>\%
+  freq(age) \%>\%
+  format() \%>\%       # this will format the percentages
+  clipboard_export()
+}
 }
 \keyword{freq}
 \keyword{frequency}