Solving parenthesis problems in R package code

R/build.R

@@ -7,7 +7,7 @@ statColumn <- function(stat, data)
 {
   data %>%
     lapply(statify, stat) %>%
-    unlist
+    unlist()
 }
 
 
@@ -47,12 +47,12 @@ varColumn <- function(data, labels = NULL)
   base_names[base_names %in% names(labels)] <- labels[base_names[base_names %in% names(labels)]]
 
   # Insert levels for factors after the variable name
-  if (any(data %>% lapply(is.factor) %>% unlist))
+  if (any(data %>% lapply(is.factor) %>% unlist()))
   {
     data %>%
       lapply(is.factor) %>%
-      unlist %>%
-      which -> factors_idx
+      unlist() %>%
+      which() -> factors_idx
 
     base_names[factors_idx] <- paste0("**", base_names[factors_idx], "**")
     factor_levels <-
@@ -125,7 +125,7 @@ varColumn <- function(data, labels = NULL)
 #'   desctable
 #'
 #' # Does the same as stats_auto here
-#' iris %>% 
+#' iris %>%
 #'   desctable(stats = list("N"      = length,
 #'                          "%/Mean" = is.factor ~ percent | (is.normal ~ mean),
 #'                          "sd"     = is.normal ~ sd,
@@ -145,7 +145,7 @@ varColumn <- function(data, labels = NULL)
 #' # With nested grouping, on arbitrary variables
 #' mtcars %>%
 #'   group_by(vs, cyl) %>%
-#'   desctable
+#'   desctable()
 #'
 #' # With grouping on a condition, and choice of tests
 #' iris %>%
@@ -177,7 +177,7 @@ desctable.grouped_df <- function(data, stats = stats_auto, tests = tests_auto, l
   data <- dplyr::ungroup(data)
 
   # Build the complete table recursively, assign "desctable" class
-  c(Variables = list(varColumn(data[!names(data) %in% (grps %>% lapply(as.character) %>% unlist)], labels)),
+  c(Variables = list(varColumn(data[!names(data) %in% (grps %>% lapply(as.character) %>% unlist())], labels)),
     subTable(data, stats, tests, grps)) %>%
   `class<-`("desctable")
 }
@@ -195,9 +195,9 @@ subNames <- function(grp, df)
 {
   paste0(as.character(grp),
          ": ",
-         eval(grp, df) %>% factor %>% levels,
+         eval(grp, df) %>% factor() %>% levels(),
          " (n=",
-         summary(eval(grp, df) %>% factor %>% stats::na.omit(), maxsum = Inf),
+         summary(eval(grp, df) %>% factor() %>% stats::na.omit(), maxsum = Inf),
          ")")
 }
 
@@ -213,12 +213,12 @@ testColumn <- function(df, tests, grp)
   group <- eval(grp, df)
 
   df <- df %>%
-      dplyr::select(- !!(grp))
+      dplyr::select(-!!(grp))
 
   if (is.function(tests))
   {
     ftests <- df %>%
-      lapply(tests, group %>% factor)
+      lapply(tests, group %>% factor())
     tests <- ftests
   } else if (!is.null(tests$.auto))
   {
@@ -255,11 +255,11 @@ subTable <- function(df, stats, tests, grps)
   # Final group, make tests
   if (length(grps) == 1)
   {
-    group <- eval(grps[[1]], df) %>% factor
+    group <- eval(grps[[1]], df) %>% factor()
 
     # Create the subtable stats
     df %>%
-      dplyr::select(- !!(grps[[1]])) %>%
+      dplyr::select(-!!(grps[[1]])) %>%
       by(group, statTable, stats) %>%
       # Name the subtables with info about group and group size
       stats::setNames(subNames(grps[[1]], df)) -> stats
@@ -275,7 +275,7 @@ subTable <- function(df, stats, tests, grps)
 
     # Go through the next grouping levels and build the subtables
     df %>%
-      dplyr::select(- !!(grps[[1]])) %>%
+      dplyr::select(-!!(grps[[1]])) %>%
       by(group, subTable, stats, tests, grps[-1]) %>%
       # Name the subtables with info about group and group size
       stats::setNames(subNames(grps[[1]], df))

R/convenience_functions.R

@@ -7,7 +7,7 @@
 #' @return A nlevels(x) + 1 length vector of percentages
 percent <- function(x)
 {
-  if (x %>% is.factor)
+  if (x %>% is.factor())
     c(NA, summary(x, maxsum = Inf) / length(x)) * 100
   else
     NA
@@ -36,7 +36,7 @@ IQR <- function(x)
 #' @return A boolean
 is.normal <- function(x)
 {
-  if (! x %>% is.numeric) 
+  if (! x %>% is.numeric())
     F
   else if (length(x %>% stats::na.omit()) >= 30)
     tryCatch(stats::shapiro.test(x)$p.value > .1,

R/output.R

@@ -6,7 +6,7 @@
 #' @export
 print.desctable <- function(x, ...)
 {
-  print(x %>% as.data.frame)
+  print(x %>% as.data.frame())
 }
 
 
@@ -24,7 +24,7 @@ as.data.frame.desctable <- function(x, ...)
   header <- x %>% header("dataframe")
 
   x %>%
-    flatten_desctable %>%
+    flatten_desctable() %>%
     data.frame(check.names = F, ...) %>%
     stats::setNames(header)
 }
@@ -129,7 +129,7 @@ datatable.default <- function(data,
                               fillContainer = getOption("DT.fillContainer", NULL),
                               autoHideNavigation = getOption("DT.autoHideNavigation", NULL),
                               selection = c("multiple", "single", "none"),
-                              extensions = list(), 
+                              extensions = list(),
                               plugins = NULL, ...)
 {
   DT::datatable(data, options = options, class = class, callback = callback, caption = caption, filter = filter, escape = escape, style = style, width = width, height = height, elementId = elementId, fillContainer = fillContainer, autoHideNavigation = autoHideNavigation, selection = selection, extensions = extensions, plugins = plugins, ...)
@@ -160,7 +160,7 @@ datatable.desctable <- function(data,
                                 autoHideNavigation = getOption("DT.autoHideNavigation", NULL),
                                 selection = c("multiple", "single", "none"),
                                 extensions = c("FixedHeader", "FixedColumns", "Buttons"),
-                                plugins = NULL, 
+                                plugins = NULL,
                                 rownames = F,
                                 digits = 2, ...)
 {
@@ -170,7 +170,7 @@ datatable.desctable <- function(data,
   header <- data %>% header("datatable")
 
   data %>%
-  flatten_desctable -> flat
+  flatten_desctable() -> flat
 
   if (!is.null(digits))
     flat <- flat %>% lapply(prettyNum, digits = digits) %>% lapply(gsub, pattern = "^NA$", replacement = "")
@@ -180,7 +180,7 @@ datatable.desctable <- function(data,
     DT::datatable(container = header,
                   options = options,
                   extensions = extensions,
-                  escape = escape, 
+                  escape = escape,
                   class = class,
                   callback = callback,
                   caption = caption,

R/stats.R

@@ -128,7 +128,7 @@ stats_auto <- function(data)
   data %>%
     Filter(f = is.numeric) %>%
     lapply(is.normal) %>%
-    unlist -> shapiro
+    unlist() -> shapiro
 
   if (length(shapiro) == 0)
   {
@@ -141,7 +141,7 @@ stats_auto <- function(data)
     any(!shapiro) -> nonnormal
   }
 
-  any(data %>% lapply(is.factor) %>% unlist) -> fact
+  any(data %>% lapply(is.factor) %>% unlist()) -> fact
 
   if (fact & normal & !nonnormal)
     stats_normal(data)

R/tests.R

@@ -9,7 +9,7 @@
 #' @return The results for the function applied on the vector, compatible with the format of the result table
 testify <- function(x, f, group)
 {
-  fun <- f %>% deparse %>% Reduce(f = paste0) %>% substring(2)
+  fun <- f %>% deparse() %>% Reduce(f = paste0) %>% substring(2)
   f <- eval(f[[2]])
   p <- tryCatch(f(x ~ group)$p.value[1],
                 error = function(e) {message(e);NaN})
@@ -36,11 +36,11 @@ testify <- function(x, f, group)
 #' @export
 tests_auto <- function(var, grp)
 {
-  grp <- grp %>% factor
+  grp <- grp %>% factor()
   if (nlevels(grp) < 2)
     ~no.test
-  else if (var %>% is.factor)
-    if (tryCatch(fisher.test(var ~ grp)$p.value %>% is.numeric, error = function(e) F))
+  else if (var %>% is.factor())
+    if (tryCatch(fisher.test(var ~ grp)$p.value %>% is.numeric(), error = function(e) F))
       ~fisher.test
     else
       ~chisq.test

R/utils.R

@@ -6,7 +6,7 @@
 #' @return The combined vector
 insert <- function(x, y, position)
 {
-  if (! y %>% is.list)
+  if (! y %>% is.list())
     y <- list(y)
 
   stopifnot(length(y) == length(position))
@@ -40,28 +40,28 @@ parse_formula <- function(x, f)
   parse_f <- function(x)
   {
     if (length(x) == 1)
-      x %>% as.character
+      x %>% as.character()
     else
     {
-      if (x[[1]] %>% as.character == "~") 
+      if (x[[1]] %>% as.character() == "~")
       {
-        paste0("if (", x[[2]] %>% parse_f, "(x)) ",
+        paste0("if (", x[[2]] %>% parse_f(), "(x)) ",
                "{",
-               x[[3]] %>% parse_f,
+               x[[3]] %>% parse_f(),
                "}")
-      } else if (x[[1]] %>% as.character == "|")
+      } else if (x[[1]] %>% as.character() == "|")
       {
-        paste0(x[[2]] %>% parse_f,
+        paste0(x[[2]] %>% parse_f(),
                "} else ",
                "{",
-               x[[3]] %>% parse_f)
-      } else if (x[[1]] %>% as.character == "(")
+               x[[3]] %>% parse_f())
+      } else if (x[[1]] %>% as.character() == "(")
       {
-        x[[2]] %>% parse_f
+        x[[2]] %>% parse_f()
       }
     }
   }
-  parse(text = parse_f(f)) %>% eval
+  parse(text = parse_f(f)) %>% eval()
 }
 
 
@@ -71,13 +71,13 @@ parse_formula <- function(x, f)
 #' @return A names vector
 head_pander <- function(head)
 {
-  if (head[[1]] %>% is.integer)
+  if (head[[1]] %>% is.integer())
   {
     head %>% names %>% lapply(function(x){c(x, rep("", head[[x]] - 1))}) %>% unlist
   } else
   {
-    paste(head %>% names %>% lapply(function(x){c(x, rep("", attr(head[[x]], "colspan") - 1))}) %>% unlist,
-          head %>% lapply(head_pander) %>% unlist,
+    paste(head %>% names() %>% lapply(function(x){c(x, rep("", attr(head[[x]], "colspan") - 1))}) %>% unlist(),
+          head %>% lapply(head_pander) %>% unlist(),
           sep = "<br/>")
   }
 }
@@ -90,9 +90,9 @@ head_pander <- function(head)
 head_datatable <- function(head)
 {
   TRs <- list()
-  while(head[[1]] %>% is.list)
+  while (head[[1]] %>% is.list())
   {
-    TR <- purrr::map2(head %>% names, head %>% lapply(attr, "colspan"), ~htmltools::tags$th(.x, colspan = .y))
+    TR <- purrr::map2(head %>% names(), head %>% lapply(attr, "colspan"), ~htmltools::tags$th(.x, colspan = .y))
 
     TRs <- c(TRs, list(TR))
     head <- purrr::flatten(head)
@@ -107,13 +107,13 @@ head_datatable <- function(head)
 #' @return A names vector
 head_dataframe <- function(head)
 {
-  if (head[[1]] %>% is.integer)
+  if (head[[1]] %>% is.integer())
   {
-    head %>% names %>% lapply(function(x){rep(x, head[[x]])}) %>% unlist
+    head %>% names() %>% lapply(function(x){rep(x, head[[x]])}) %>% unlist()
   } else
   {
-    paste(head %>% names %>% lapply(function(x){rep(x, attr(head[[x]], "colspan"))}) %>% unlist,
-          head %>% lapply(head_pander) %>% unlist,
+    paste(head %>% names() %>% lapply(function(x){rep(x, attr(head[[x]], "colspan"))}) %>% unlist(),
+          head %>% lapply(head_pander) %>% unlist(),
           sep = " / ")
   }
 }
@@ -131,7 +131,7 @@ header <- function(desctable, output = c("pander", "datatable", "dataframe"))
 {
   nm <- desctable %>%
     `[`(-1) %>%
-    flatten_desctable %>%
+    flatten_desctable() %>%
     data.frame(check.names = F) %>%
     names
 
@@ -173,7 +173,7 @@ header <- function(desctable, output = c("pander", "datatable", "dataframe"))
 #' @return A nested list of headers with colspans
 headerList <- function(desctable)
 {
-  if (desctable %>% is.data.frame)
+  if (desctable %>% is.data.frame())
   {
     length(desctable)
   }
@@ -181,7 +181,7 @@ headerList <- function(desctable)
   {
     lapply(desctable, headerList) -> rec
     if (is.integer(rec[[1]]))
-      attr(rec, "colspan") <- rec %>% unlist %>% sum
+      attr(rec, "colspan") <- rec %>% unlist() %>% sum()
     else
       attr(rec, "colspan") <- rec %>% lapply(attr, "colspan") %>% unlist %>% sum
 
@@ -196,7 +196,7 @@ headerList <- function(desctable)
 #' @return A flat dataframe
 flatten_desctable <- function(desctable)
 {
-  if (desctable %>% is.data.frame)
+  if (desctable %>% is.data.frame())
     desctable
   else
     desctable %>% lapply(flatten_desctable) %>% dplyr::bind_cols()