lintr stuff

TysonStanley · Feb 3, 2024 · cccd2f4 · cccd2f4
1 parent 104ae31
commit cccd2f4
Show file tree

Hide file tree

Showing 15 changed files with 146 additions and 130 deletions.
diff --git a/R/Table1.R b/R/Table1.R
@@ -139,7 +139,7 @@ table1.data.frame = function(.data,
   ###################
   ## Preprocessing ##
   ###################
-  .call <- match.call()
+  # .call <- match.call()
   ## Test output
   format_output <- type[which(type %in% c("pvalue", "pvalues", "pval", "pvals", "p",
                                           "full", "f",
@@ -163,7 +163,7 @@ table1.data.frame = function(.data,
     NAkeep <- "always"
   }
   ## Only pvalues are shown in simple or condensed versions
-  if (simple | condense){
+  if (simple || condense){
     format_output <- "pvalue"
   }
   ## Formatting default functions
@@ -250,14 +250,14 @@ table1.data.frame = function(.data,
 
 
   ## Splitby variable needs to have more than one level when test = TRUE
-  if (test & length(levels(d$split))>1){
+  if (test && length(levels(d$split))>1){
     test <- TRUE
   } else {
     test <- FALSE
   }
 
   ## Does each variable have at least two levels?
-  if ((! .more_than_one_value(d)) & test){
+  if ((! .more_than_one_value(d)) && test){
     test = FALSE
     warning("Not all variables have at least 2 unique values. Cannot do tests...", 
             call. = FALSE)
@@ -375,7 +375,7 @@ print.table1 <- function(x, ...){
   x2[] <- sapply(x2, as.character)
 
   ## Get width of table for lines
-  for (i in 1:dim(x2)[2]){
+  for (i in seq_len(dim(x2)[2])){
     max_col_width[[i]] <- max(sapply(x2[[i]], nchar, type="width"))
   }
   tot_width <- sum(ifelse(unlist(max_col_width) > nchar(names(x2)), unlist(max_col_width), nchar(names(x2)))) + 
@@ -392,10 +392,10 @@ print.table1 <- function(x, ...){
     x5 <- x3[, first_part, drop = FALSE]
     x4[] <- sapply(x4, as.character)
     x5[] <- sapply(x5, as.character)
-    for (i in 1:ncol(x4)){
+    for (i in seq_len(ncol(x4))){
       max_col_width2[[i]] <- max(sapply(x4[[i]], nchar, type="width"))
     }
-    for (i in 1:ncol(x5)){
+    for (i in seq_len(ncol(x5))){
       max_col_width3[[i]] <- max(sapply(x5[[i]], nchar, type="width"))
     }
     var_width <- sum(ifelse(unlist(max_col_width2) > nchar(names(x4)), unlist(max_col_width2), nchar(names(x4)))) + 

diff --git a/R/furniture.R b/R/furniture.R
@@ -5,18 +5,18 @@
 #' communicate their data as well as clean their data in a tidy way. The package
 #' follows similar semantics to the "tidyverse" packages. It contains several
 #' table functions (\code{table1()}) being the core one.
-#' 
+#'
 #' \itemize{
-#'   \item \code{table1} provides a well-formatted descriptive table often seen 
-#'         as table 1 in academic journals (also a version that simplifies the 
+#'   \item \code{table1} provides a well-formatted descriptive table often seen
+#'         as table 1 in academic journals (also a version that simplifies the
 #'         output is available as \code{simple_table1}),
-#'   \item \code{washer} provides a simple way to clean up data where there are 
+#'   \item \code{washer} provides a simple way to clean up data where there are
 #'         placeholder values, and
-#'   \item \code{\%xt\%} is an operator that takes two factor variables and 
-#'         creates a cross tabulation and tests for significance via a 
+#'   \item \code{\%xt\%} is an operator that takes two factor variables and
+#'         creates a cross tabulation and tests for significance via a
 #'         chi-square test.
 #' }
-#' 
+#'
 #' Table 1 is the main function in furniture. It is useful in both data
 #' exploration and data communication. With minimal cleaning, the outputted
 #' table can be put into an academic, peer reviewed journal manuscript. As such,
@@ -26,33 +26,33 @@
 #' the health condition (i.e. "yes" or "no"; "low", "mid", or "high"; or a list
 #' of conditions) as the stratifying variable. With little code, you can test
 #' for associations and check means or counts by the stratifying variable.
-#' See the vignette for more information. 
-#' 
+#' See the vignette for more information.
+#'
 #' Note: furniture is meant to make life more comfortable and beautiful.
 #' In like manner, this package is designed to be "furniture" for quantitative
 #' research.
-#' 
+#'
 #' @examples
 #' \dontrun{
-#' 
+#'
 #' library(furniture)
-#' 
+#'
 #' ## Table 1
 #' data %>%
 #'   table1(var1, var2, var3, 
 #'          splitby = ~groupvar,
 #'          test = TRUE)
-#' 
+#'
 #' ## Table F
 #' data %>%
 #'   tableF(var1)
-#' 
+#'
 #' ## Washer
 #' x = washer(x, 7, 8, 9)
 #' x = washer(x, is.na, value=0)
-#' 
+#'
 #' }
-#' 
+#'
 #' @name furniture
 #' @aliases furniture-package
 "_PACKAGE"
diff --git a/R/long_wide.R b/R/long_wide.R
@@ -2,7 +2,7 @@
 #' @author Tyson S. Barrett
 #'
 #' @description \code{wide()} is a wrapper of \code{stats::reshape()} that takes
-#' the data from a long format to a wide format. 
+#' the data from a long format to a wide format.
 #'
 #' @param data the data.frame containing the wide format data
 #' @param v.names the variable names in quotes of the measures to be separated
@@ -15,15 +15,15 @@
 #' @importFrom stats reshape
 #'
 #' @export
-wide <- function(data, v.names, timevar, id=NULL){
+wide <- function(data, v.names, timevar, id = NULL){
   UseMethod("wide", data)
 }
 
 #' @importFrom stats reshape
 #' @export
-wide.tibble <- function(data, v.names=NULL, timevar, id=NULL){
+wide.tibble <- function(data, v.names = NULL, timevar, id = NULL){
   data = as.data.frame(data, stringsAsFactors = TRUE)
-  if (any(grepl("[i|I][d|D]", names(data))) & is.null(id)){
+  if (any(grepl("[i|I][d|D]", names(data))) && is.null(id)){
     id = names(data)[grep("[i|I][d|D]", names(data))[1]]
     message(paste("id =", id))
   }
@@ -34,9 +34,9 @@ wide.tibble <- function(data, v.names=NULL, timevar, id=NULL){
 
 #' @importFrom stats reshape
 #' @export
-wide.tbl_df <- function(data, v.names=NULL, timevar, id=NULL){
+wide.tbl_df <- function(data, v.names = NULL, timevar, id = NULL){
   data = as.data.frame(data, stringsAsFactors = TRUE)
-  if (any(grepl("[i|I][d|D]", names(data))) & is.null(id)){
+  if (any(grepl("[i|I][d|D]", names(data))) && is.null(id)){
     id = names(data)[grep("[i|I][d|D]", names(data))[1]]
     message(paste("id =", id))
   }
@@ -47,8 +47,8 @@ wide.tbl_df <- function(data, v.names=NULL, timevar, id=NULL){
 
 #' @importFrom stats reshape
 #' @export
-wide.data.frame <- function(data, v.names=NULL, timevar, id=NULL){
-  if (any(grepl("[i|I][d|D]", names(data))) & is.null(id)){
+wide.data.frame <- function(data, v.names = NULL, timevar, id = NULL){
+  if (any(grepl("[i|I][d|D]", names(data))) && is.null(id)){
     id = names(data)[grep("[i|I][d|D]", names(data))[1]]
     message(paste("id =", id))
   }
@@ -59,8 +59,8 @@ wide.data.frame <- function(data, v.names=NULL, timevar, id=NULL){
 
 #' @importFrom stats reshape
 #' @export
-wide.matrix <- function(data, v.names=NULL, timevar, id=NULL){
-  if (any(grepl("[i|I][d|D]", names(data))) & is.null(id)){
+wide.matrix <- function(data, v.names = NULL, timevar, id = NULL){
+  if (any(grepl("[i|I][d|D]", names(data))) && is.null(id)){
     id = names(data)[grep("[i|I][d|D]", names(data))[1]]
     message(paste("id =", id))
   }
@@ -120,13 +120,15 @@ wide.matrix <- function(data, v.names=NULL, timevar, id=NULL){
 #'
 #'
 #' @export
-long <- function(data, ..., v.names=NULL, id=NULL, timevar=NULL, times=NULL, sep=""){
+long <- function(data, ..., v.names = NULL, id = NULL, timevar = NULL,
+                 times = NULL, sep = ""){
   UseMethod("long", data)
 }
 
 #' @importFrom stats reshape
 #' @export
-long.tibble <- function(data, ..., v.names=NULL, id=NULL, timevar=NULL, times=NULL, sep=""){
+long.tibble <- function(data, ..., v.names = NULL, id = NULL, timevar = NULL,
+                        times = NULL, sep=""){
   varying = list(...)
   if (is.null(id)){
     if (any(grepl("[i|I][d|D]", names(data)))){
@@ -144,7 +146,7 @@ long.tibble <- function(data, ..., v.names=NULL, id=NULL, timevar=NULL, times=NU
   }
   data = as.data.frame(data, stringsAsFactors = TRUE)
   data$miss = NA
-  ids = 1:NROW(data)
+  ids = seq_len(NROW(data))
   newd = stats::reshape(data, varying, v.names, timevar = timevar,
                         times = times, idvar = id, ids = ids, sep=sep,
                         direction = "long")
@@ -157,7 +159,8 @@ long.tibble <- function(data, ..., v.names=NULL, id=NULL, timevar=NULL, times=NU
 
 #' @importFrom stats reshape
 #' @export
-long.tbl_df <- function(data, ..., v.names=NULL, id=NULL, timevar=NULL, times=NULL, sep=""){
+long.tbl_df <- function(data, ..., v.names = NULL, id = NULL, timevar = NULL,
+                        times = NULL, sep = ""){
   varying = list(...)
   if (is.null(id)){
     if (any(grepl("[i|I][d|D]", names(data)))){
@@ -175,7 +178,7 @@ long.tbl_df <- function(data, ..., v.names=NULL, id=NULL, timevar=NULL, times=NU
   }
   data = as.data.frame(data, stringsAsFactors = TRUE)
   data$miss = NA
-  ids = 1:NROW(data)
+  ids = seq_len(NROW(data))
   newd = stats::reshape(data, varying, v.names, timevar = timevar,
                         times = times, idvar = id, ids = ids, sep=sep,
                         direction = "long")
@@ -188,7 +191,8 @@ long.tbl_df <- function(data, ..., v.names=NULL, id=NULL, timevar=NULL, times=NU
 
 #' @importFrom stats reshape
 #' @export
-long.data.frame <- function(data, ..., v.names=NULL, id=NULL, timevar=NULL, times=NULL, sep=""){
+long.data.frame <- function(data, ..., v.names = NULL, id = NULL, 
+                            timevar = NULL, times = NULL, sep = ""){
   varying = list(...)
   if (is.null(id)){
     if (any(grepl("[i|I][d|D]", names(data)))){
@@ -205,7 +209,7 @@ long.data.frame <- function(data, ..., v.names=NULL, id=NULL, timevar=NULL, time
     times = seq_along(varying[[1]])
   }
   data$miss = NA
-  ids = 1:NROW(data)
+  ids = seq_len(NROW(data))
   newd = stats::reshape(data, varying, v.names, timevar = timevar,
                         times = times, idvar = id, ids = ids, sep=sep,
                         direction = "long")
@@ -218,7 +222,8 @@ long.data.frame <- function(data, ..., v.names=NULL, id=NULL, timevar=NULL, time
 
 #' @importFrom stats reshape
 #' @export
-long.matrix <- function(data, ..., v.names=NULL, id=NULL, timevar=NULL, times=NULL, sep=""){
+long.matrix <- function(data, ..., v.names = NULL, id = NULL, timevar = NULL,
+                        times = NULL, sep = ""){
   varying = list(...)
   if (is.null(id)){
     if (any(grepl("[i|I][d|D]", names(data)))){
@@ -235,7 +240,7 @@ long.matrix <- function(data, ..., v.names=NULL, id=NULL, timevar=NULL, times=NU
     times = seq_along(varying[[1]])
   }
   data$miss = NA
-  ids = 1:NROW(data)
+  ids = seq_len(NROW(data))
   newd = stats::reshape(data, varying, v.names, timevar = timevar,
                         times = times, idvar = id, ids = ids, sep=sep,
                         direction = "long")
@@ -245,4 +250,3 @@ long.matrix <- function(data, ..., v.names=NULL, id=NULL, timevar=NULL, times=NU
   }
   return(newd)
 }
-
diff --git a/R/table1_gt.R b/R/table1_gt.R
@@ -1,49 +1,52 @@
 #' @title gt output for table1
 #' @author Tyson S. Barrett
-#' 
+#'
 #' @description This takes a table1 object and outputs a `gt` version.
-#' 
+#'
 #' @param tab the table1 object
-#' @param spanner the label above the grouping variable (if table1 is grouped) or any label you want to include over the statistics column(s)
-#' 
+#' @param spanner the label above the grouping variable (if table1 is grouped)
+#' or any label you want to include over the statistics column(s)
+#'
 #' @importFrom gt gt
 #' @importFrom gt fmt_markdown
 #' @importFrom gt tab_spanner
-#' 
+#'
 #' @examples
-#' 
+#'
 #' library(furniture)
 #' library(dplyr)
-#' 
+#'
 #' data('nhanes_2010')
-#' nhanes_2010 %>% 
-#'   group_by(asthma) %>% 
-#'   table1(age, marijuana, illicit, rehab, na.rm = FALSE) %>% 
+#' nhanes_2010 %>%
+#'   group_by(asthma) %>%
+#'   table1(age, marijuana, illicit, rehab, na.rm = FALSE) %>%
 #'   table1_gt(spanner = "Asthma")
-#' 
-#' 
+#'
 #' @export
-table1_gt <- function(tab, spanner = NULL){
+table1_gt <- function(tab, spanner = NULL) {
   # save names and adjust table to include n's in header
   nams <- names(tab[[1]])
   nams[1] <- "Characteristic"
   tab_df <- as.data.frame(tab)
-  nams <- paste0(nams, tab_df[1,])
+  nams <- paste0(nams, tab_df[1, ])
   nams <- gsub("n =", ", n =", nams)
   tab_df <- tab_df[-1, ]
   names(tab_df) <- nams
-  
+
   # add spacing for the table
-  tab_df$Characteristic <- ifelse(grepl("  ", tab_df$Characteristic), paste("&nbsp;&nbsp;&nbsp;&nbsp;", tab_df$Characteristic), tab_df$Characteristic)
-
+  tab_df$Characteristic <- ifelse(
+    grepl("  ", tab_df$Characteristic),
+    paste("&nbsp;&nbsp;&nbsp;&nbsp;", tab_df$Characteristic),
+    tab_df$Characteristic
+  )
+
   # make it a gt and return
   gt_tab <- gt::gt(tab_df)
   gt_tab <- gt::fmt_markdown(gt_tab)
-  
+
   # add spanner
   if (!is.null(spanner))
     gt::tab_spanner(gt_tab, label = spanner, columns = -Characteristic)
   else
     gt_tab
 }
-