fixed default tb's ask param default + cosmetic changes

dcomtois · Aug 10, 2021 · 498929b · 498929b
1 parent 58a3936
commit 498929b
Show file tree

Hide file tree

Showing 6 changed files with 39 additions and 21 deletions.
diff --git a/R/define_keywords.R b/R/define_keywords.R
@@ -114,7 +114,7 @@
 #' @importFrom tcltk tclvalue tk_messageBox tkgetSaveFile
 #' @importFrom checkmate check_path_for_output
 #' @export
-define_keywords <- function(..., ask = FALSE, file = NA) {
+define_keywords <- function(..., ask = TRUE, file = NA) {
   mc <- match.call()
   kw <- names(mc[setdiff(names(mc), names(formals()))])[-1]
   if (length(kw) == 0 && !isTRUE(interactive())) {
@@ -152,7 +152,7 @@ define_keywords <- function(..., ask = FALSE, file = NA) {
             "  - Close the editing window when finished")
     tr.copy <- tr
     tr <- try(edit(tr), silent = TRUE)
-    if (class(tr) == "try-error") {
+    if (inherits(x = tr, "try-error")) {
       stop("Window dialogs not allowed; use arguments to ",
            "redefine specific keywords (see ?define_keywords), or turn to the ",
            "use_custom_lang() function which allows redefining all keywords at ",
@@ -166,12 +166,13 @@ define_keywords <- function(..., ask = FALSE, file = NA) {
     for (it in kw) {
       ind <- which(tr$item == it)
       if (length(ind) == 0) {
-        stop("'", it, "' is not a recognized keyword; see ?define_keywords ",
-             "for a list of valid keywords")
+        message("'", it, "' is not a recognized keyword; see ?define_keywords ",
+                "for a list of valid keywords")
+        next
       }
       if (inherits(mc[[it]], c("call", "name"))) {
        mc[[it]] <- eval(mc[[it]], parent.frame())
-      } 
+      }
       tr$custom[ind] <- mc[[it]]
     }
   }
@@ -187,8 +188,7 @@ define_keywords <- function(..., ask = FALSE, file = NA) {
               fileEncoding = "utf-8")
     message("Custom language file written: ", filename)
     } else {
-      warning("file name or path is invalid. Custom language is in effect; ",
-              "call define_keywords() without arguments to save file")
+      warning("file name or path invalid")
     }
   } else if (isTRUE(ask)) {
     filename <- ""

diff --git a/R/print.list.R b/R/print.list.R
@@ -1,6 +1,7 @@
 #' Print Method for Objects of Class \dQuote{list}
 #'
-#' Displays a list comprised of summarytools objects created with \code{lapply}. 
+#' Displays a list comprised of summarytools objects created with
+#'   \code{\link{lapply}}. 
 #'
 #' @usage
 #'  \method{print}{list}(x, method = "pander", file = "", 
@@ -10,6 +11,11 @@
 #'   footnote = st_options('footnote'), collapse = 0,
 #'   escape.pipe = st_options('escape.pipe'), \dots)
 #' 
+#' @details This function is there only for cases where the object to be printed
+#'   was created with \code{\link{lapply}}, as opposed to the recommended
+#'   functions for creating grouped results (\code{\link{stby}} and
+#'   \code{\link[dplyr]{group_by}}).
+#' 
 #' @inheritParams print.summarytools
 #' @method print list
 #' @export

diff --git a/R/tb.R b/R/tb.R
@@ -51,15 +51,18 @@ tb <- function(x, order = 1, na.rm = FALSE, drop.var.col = FALSE) {
     grp_stats <- lapply(x, tb, na.rm = na.rm, drop.var.col = FALSE)
 
     if ("groups" %in% names(attributes(x))) {
-      left_part <- as_tibble(merge(grp_stats[[1]][,1],
-                                   attr(x, "groups"),
-                                   all = TRUE)[,-1])
+      left_part <- as_tibble(
+        merge(grp_stats[[1]][,1], attr(x, "groups"), all = TRUE)[,-1]
+      )
+
       if (identical(colnames(left_part), "value")) {
         # for special case of descr
         colnames(left_part) <- colnames(attr(x, "group"))
       }
       grp_values <- attr(x, "groups")
+
     } else {
+
       null_grs     <- which(vapply(x, is.null, TRUE))
       non_null_grs <- setdiff(seq_along(x), null_grs)
       grp_values   <- as_tibble(expand.grid(attr(x, "dimnames")))[non_null_grs,]
@@ -85,16 +88,18 @@ tb <- function(x, order = 1, na.rm = FALSE, drop.var.col = FALSE) {
 
     colnames(output)[1:ncol(left_part)] <-
       sub("(.+)\\$(.+)", "\\2", colnames(output)[1:ncol(left_part)])
-    if (order==1) {
+    if (order == 1) {
     } else if (order %in% 2:3) {
-      output <- output[do.call(what = "order",
-                               args = unname(output[ ,c(nb_gr_var + 1, 1:nb_gr_var)])), ]
+      output <- 
+        output[do.call(what = "order",
+                       args = unname(output[ ,c(nb_gr_var + 1, 1:nb_gr_var)])), ]
       if (order == 3) {
-        output <- output[ ,c(nb_gr_var + 1, 1:(nb_gr_var), (nb_gr_var + 2):ncol(output))]
+        output <- output[ ,c(nb_gr_var + 1,
+                             1:(nb_gr_var),
+                             (nb_gr_var + 2):ncol(output))]
       }
     }
 
-
     if (attr(x[[1]], "st_type") == "freq") {
 
       if ("pct_valid" %in% colnames(output)) {

diff --git a/man/define_keywords.Rd b/man/define_keywords.Rd
diff --git a/man/print.list.Rd b/man/print.list.Rd
diff --git a/vignettes/introduction.Rmd b/vignettes/introduction.Rmd
@@ -102,7 +102,7 @@ Results can be
 
 **When creating _R Markdown_ documents**, make sure to 
 
-  - Use chunk option`result="asis"`
+  - Use chunk option `results="asis"`
   - Une the function argument `plain.ascii=FALSE` 
   - Set the *style* parameter to "rmarkdown", or "grid" for `dfSummary()`
 
@@ -125,12 +125,12 @@ Results can be
    + Default values for a good number of function parameters can be modified
      using `st_options()` to minimize redundancy in function calls 
    + **By-group processing** is easily achieved using the package's `stby()`
-     function which is a slightly modified version of base `base::by()`, but
+     function which is a slightly modified version of `base::by()`, but
      `dplyr::group_by()` is also supported 
    + [**Pander options**](http://rapporter.github.io/pander/) can be used to
      customize or enhance plain text and markdown tables 
    + Base R's `format()` parameters are also supported; this can be used to set
-     thousands separator or modify the decimal separator, among several other
+     thousands separator or modify the decimal separator, among other
      possibilities (see `help("format")`)
    + [**Bootstrap CSS**](https://getbootstrap.com/) is used by default with
      *html* output, and user-defined classes can be added at will