Standardizing internal error check syntax and transitioning some mess…

…ages into true warnings

R/array_melt.R

@@ -35,7 +35,7 @@ array_melt <- function(array = NULL){
 
   # Error out if `array` is null or isn't an array
   if(is.null(array) | methods::is(object = array, class2 = "array") != TRUE)
-    stop("`array` must be provided and must be an array")
+    stop("'array' must be provided and must be an array")
 
   df <- array %>%
     # Flatten array to a list (margin = 3 because each z should be in a separate list element)

R/crop_tri.R

@@ -20,20 +20,21 @@
 crop_tri <- function(data = NULL, drop_tri = "upper", drop_diag = FALSE){
 
   # Error out for missing data
-  if(is.null(data)) stop("`data` must be provided")
+  if(is.null(data) == TRUE) 
+    stop("'data' must be provided")
 
   # Error out if data aren't symmetric
   if(nrow(data) != ncol(data))
-    stop("`data` must be have same number of rows as columns (i.e., must be symmetric")
+    stop("'data' must be have same number of rows as columns (i.e., must be symmetric)")
 
   # Error out if triangle argument isn't supported
-  if(!drop_tri %in% c("upper", "lower"))
-    stop("`drop_tri` must be one of 'upper' or 'lower'")
+  if(drop_tri %in% c("upper", "lower") != TRUE)
+    stop("'drop_tri' must be one of 'upper' or 'lower'")
 
   # Coerce `drop_diag` to logical if it isn't
-  if(methods::is(object = drop_diag, class2 = "logical") != TRUE){
-    drop_diag <- FALSE
-    message("`drop_diag` must be logical. Defaulting to FALSE") }
+  if(is.logical(drop_diag) != TRUE){
+    warning("'drop_diag' must be logical. Defaulting to FALSE")
+    drop_diag <- FALSE }
 
   # Duplicate data
   crop_data <- data

R/date_check.R

@@ -39,10 +39,10 @@ date_check <- function(data = NULL, col = NULL) {
     col_opt <- col[j]
 
     # Remove NA entries
-    notNA <- base::subset(df, !base::is.na(df[, col_opt]))
+    not_na <- base::subset(df, !base::is.na(df[, col_opt]))
 
     # Identify rows that would be lost if `as.Date()` is used
-    bad_df <- base::subset(notNA, is.na(base::as.Date(notNA[, col_opt])))
+    bad_df <- base::subset(not_na, is.na(base::as.Date(not_na[, col_opt])))
 
     # Get a vector of just the unique 'bad' entries
     bad_vec <- base::unique(bad_df[, col_opt])

R/date_format_guess.R

@@ -42,54 +42,65 @@ date_format_guess <- function(data = NULL, date_col = NULL,
   new_dates <- simp_dates <- simp_dates2 <- NULL
   num_L <- num_R <- year <- format_guess <- NULL
 
-  # Error out if `data` isn't defined
-  if(is.null(data)) stop("`data` must be defined")
-
-  # Error out if `date_col` is undefined...
-  if(is.null(date_col)) stop("`date_col` must be defined")
+  # Error out if 'data' isn't defined
+  if(is.null(data)) 
+    stop("'data' must be defined")
+
+  # Error out if 'date_col' is undefined...
+  if(is.null(date_col)) 
+    stop("'date_col' must be defined")
+
   # ...Or isn't a character...
   if(is.character(date_col) != TRUE)
-    stop("`date_col` must be a character")
-  # ...Or isn't a column in `data`...
+    stop("'date_col' must be a character")
+
+  # ...Or isn't a column in 'data'...
   if(!date_col %in% names(data))
-    stop("`date_col` must be a column name in `data`")
+    stop("'date_col' must be a column name in 'data'")
+
   # ...Or the column isn't a character/factor column
   if(date_col %in% names(data) & is.character(data[[date_col]]) != TRUE)
-    stop("`date_col` must refer to a character column in the `data` object")
+    stop("'date_col' must refer to a character column in the 'data' object")
 
-  # Warn when `groups` isn't a logical and re-set it to `FALSE`
-  if(methods::is(groups, "logical") != TRUE){
-    message("`groups` must be a logical. Re-setting to `FALSE`")
+  # Warn when 'groups' isn't a logical and re-set it to 'FALSE'
+  if(is.logical(groups) != TRUE){
+    warning("'groups' must be a logical. Re-setting to 'FALSE'")
     groups <- FALSE }
 
-  # Error out if `groups = TRUE` but `group_col` is undefined...
+  # Error out if 'groups = TRUE' but 'group_col' is undefined...
   if(groups == TRUE & is.null(group_col))
-    stop("`group_col` must be defined if `groups == TRUE`")
-  # Error out if `groups = TRUE` and `group_col` *is* defined BUT...
+    stop("'group_col' must be defined if 'groups == TRUE'")
+
+  # Error out if 'groups = TRUE' and 'group_col' *is* defined BUT...
   if(groups == TRUE & !is.null(group_col)){
     # ...Includes more than one column...
     if(length(group_col) > 1)
-      stop("`group_col` only supports a single grouping column. Consider collapsing several columns to achieve this if necessary")
+      stop("'group_col' only supports a single grouping column. Consider collapsing several columns to achieve this if necessary")
+
     # ...Isn't a character...
     if(is.character(group_col) != TRUE)
-      stop("`group_col` must be a character")
+      stop("'group_col' must be a character")
+
     #...Or isn't in the dataframe...
     if(!group_col %in% names(data))
-      stop("`group_col` must be a column name in `data`")
+      stop("'group_col' must be a column name in 'data'")
+
     # ...Or the column isn't a character/factor column
     if(group_col %in% names(data) & is.character(data[[group_col]]) != TRUE)
-      stop("`group_col` must refer to a character column") }
+      stop("'group_col' must refer to a character column") }
 
-  # Warn when `quiet` isn't a logical and re-set it to `FALSE`
+  # Warn when 'quiet' isn't a logical and re-set it to 'FALSE'
   if(is.logical(quiet) != TRUE){
-    message("`quiet` must be a logical. Defaulting to `FALSE`")
+    warning("'quiet' must be a logical. Defaulting to 'FALSE'")
     quiet <- FALSE }
 
-  # Error out if `return is unspecified`...
-  if(is.null(return)) stop("`return` must be defined")
+  # Error out if 'return is unspecified'...
+  if(is.null(return) == TRUE) 
+    stop("'return' must be defined")
+
   # ...Or isn't either "dataframe" or "vector"
   if(!return %in% c("dataframe", "vector"))
-    stop("`return` must be one of either 'dataframe' or 'vector'")
+    stop("'return' must be one of either 'dataframe' or 'vector'")
 
   # Do some initial standardization & extraction
   guess_v1 <- data %>%
@@ -110,7 +121,7 @@ date_format_guess <- function(data = NULL, date_col = NULL,
     # Make both numbers truly numeric
     dplyr::mutate(num_L = as.numeric(num_L), num_R = as.numeric(num_R))
 
-  # `groups == TRUE` ----
+  # 'groups == TRUE' ----
   # Count frequencies and use that to help our inference
   if(groups == TRUE) {
 
@@ -153,12 +164,12 @@ date_format_guess <- function(data = NULL, date_col = NULL,
       "/" %in% gsub(pattern = "0|1|2|3|4|5|6|7|8|9", replacement = "",
                     x = year_partial) ~ paste0("year/", guess_partial) ) ) }
 
-  # `groups == FALSE` ----
+  # 'groups == FALSE' ----
   if(groups == FALSE){
 
     # Warn the user that lacking groups makes the function worse
     if(quiet != TRUE){
-      message("Defining `groups` is strongly recommended! If none exist, consider adding a single artificial group shared by all rows then re-run this function") }
+      message("Defining 'groups' is strongly recommended! If none exist, consider adding a single artificial group shared by all rows then re-run this function") }
 
     # We can't do the frequency counting thing so we'll just make empty columns
     guess_v2 <- guess_v1 %>%
@@ -196,11 +207,11 @@ date_format_guess <- function(data = NULL, date_col = NULL,
     # Make it a dataframe
     as.data.frame()
 
-  # If `return = "dataframe"`, return that object
+  # If 'return = "dataframe"', return that object
   if(return == "dataframe"){
     if(quiet != TRUE){ message("Returning dataframe of data format guesses") }
     return(guess_actual) }
-  # If `return = "vector"`, return *that* object
+  # If 'return = "vector"', return *that* object
   if(return == "vector"){
     if(quiet != TRUE){ message("Returning vector of data format guesses") }
     return(guess_actual$format_guess) }

R/diff_check.R

@@ -31,17 +31,17 @@ diff_check <- function(old = NULL, new = NULL,
     stop("Both arguments must be specified")
 
   # Error out if either is not a vector
-  if(!is.vector(old) | !is.vector(new))
+  if(is.vector(old) != TRUE | is.vector(new) != TRUE)
     stop("Both arguments must be vectors")
 
   # Coerce `sort` to TRUE if not a logical
-  if(!is.logical(sort)){
-    message("`sort` must be either TRUE or FALSE. Coercing to TRUE")
+  if(is.logical(sort) != TRUE){
+    warning("'sort' must be either TRUE or FALSE. Defaulting to TRUE")
     sort <- TRUE }
 
   # Coerce `return` to FALSE if not a logical
-  if(!is.logical(return)){
-    message("`return` must be either TRUE or FALSE. Coercing to FALSE")
+  if(is.logical(return) != TRUE){
+    warning("'return' must be either TRUE or FALSE. Defaulting to FALSE")
     return <- FALSE }
 
   # Identify what is lost (i.e., in old but not new)

R/force_num.R

@@ -14,7 +14,7 @@ force_num <- function(x = NULL){
 
   # Error out for no argument specification
   if(is.null(x))
-    stop("`x` argument must be defined")
+    stop("'x' argument must be defined")
 
   # Coerce to numeric
   y <- suppressWarnings(expr = as.numeric(x = x))

R/github_ls.R

@@ -17,14 +17,14 @@ github_ls_single <- function(repo = NULL, folder = NULL){
 
   # Error out for missing repo URL
   if(is.null(repo) == TRUE)
-    stop("`repo` must be the URL for a GitHub repository (including 'github.com')")
+    stop("'repo' must be the URL for a GitHub repository (including 'github.com')")
 
   # Break URL into its component parts
   url_bits <- stringr::str_split_1(string = repo, pattern = "/")
 
   # Error out if "github.com" isn't in the URL
   if(!"github.com" %in% url_bits)
-    stop("`repo` must be the URL for a GitHub repository (including 'github.com')")
+    stop("'repo' must be the URL for a GitHub repository (including 'github.com')")
 
   # Drop unwanted parts of that
   repo_id <- setdiff(x = url_bits, y = c("https:", "", "www.", "github.com"))

R/name_vec.R

@@ -13,7 +13,11 @@
 #' # Create a named vector
 #' name_vec(content = 1:10, name = paste0("text_", 1:10))
 #' 
-name_vec <- function(content, name){
+name_vec <- function(content = NULL, name = NULL){
+
+  # Error out either is not provided
+  if(is.null(content) == TRUE | is.null(name) == TRUE)
+    stop("Both arguments must be specified")
 
   # Error out if content & name are not the same length
   if(length(x = content) != length(x = name))

R/nms_ord.R

@@ -55,27 +55,27 @@ nms_ord <- function(mod = NULL, groupcol = NULL, title = NA,
 
   # Error out if the model is the wrong class
   if(base::unique(base::class(mod) %in% c("metaMDS", "monoMDS")) != TRUE)
-    stop("Model must be returned by `vegan::metaMDS`")
+    stop("Model must be returned by 'vegan::metaMDS'")
 
   # Error out for inappropriate shapes / lines
   if(!is.numeric(shapes) | base::max(shapes) > 25 | base::min(shapes < 0))
-    stop("`shapes` must be numeric value as defined in `?pch`")
+    stop("'shapes' must be numeric value as defined in '?pch'")
 
   # Warn and coerce to default for inappropriate point size
   if(!is.numeric(pt_size)) {
-    message("`pt_size` must be numeric. Coercing to 1.5")
+    warning("'pt_size' must be numeric. Coercing to 1.5")
     pt_size <- 1.5 }
 
   # Do the same for transparency
   if(!is.numeric(pt_alpha)) {
-    message("`pt_alpha` must be numeric. Coercing to 1")
+    warning("'pt_alpha' must be numeric. Coercing to 1")
     pt_alpha <- 1 }
 
   # Warning message when attempting to plot too many groups
   if (base::length(base::unique(groupcol)) > base::min(base::length(colors),
                                                        base::length(shapes),
                                                        base::length(lines))) {
-    message('Insufficient aesthetic values provided. 10 colors/shapes/lines are built into the function but you have supplied ', base::length(base::unique(groupcol)), ' groups. Please modify `colors`, `lines`, or `shapes` as needed to provide one value per category in your group column.')
+    warning("Insufficient aesthetic values provided. 10 colors/shapes/lines are built into the function but you have supplied ", base::length(base::unique(groupcol)), " groups. Please modify 'colors', 'lines', or 'shapes' as needed to provide one value per category in your group column.")
   } else {
 
     # Before actually creating the plot we need to make sure colors/shapes/lines are correctly formatted

R/num_check.R

@@ -37,13 +37,11 @@ num_check <- function(data = NULL, col = NULL) {
     col_opt <- col[k]
 
     # Remove NA entries
-    notNA <- base::subset(df, !base::is.na(df[, col_opt]))
+    not_na <- base::subset(df, !base::is.na(df[, col_opt]))
 
     # Identify rows that would be lost if `as.numeric()` is used
-    bad_df <- base::subset(notNA,
-                           base::is.na(
-                             base::suppressWarnings(
-                               base::as.numeric(notNA[, col_opt]))))
+    bad_df <- base::subset(not_na,
+                           base::is.na(supportR::force_num(x = not_na[, col_opt])))
 
     # Get a vector of just the unique 'bad' entries
     bad_vec <- base::unique(bad_df[, col_opt])

R/pcoa_ord.R

@@ -55,27 +55,27 @@ pcoa_ord <- function(mod = NULL, groupcol = NULL, title = NA,
 
   # Error out if the model is the wrong class
   if(base::class(mod) != "pcoa")
-    stop("Model must be returned by `ape::pcoa`")
+    stop("Model must be returned by 'ape::pcoa'")
 
   # Error out for inappropriate shapes / lines
   if(!is.numeric(shapes) | base::max(shapes) > 25 | base::min(shapes < 0))
-    stop("`shapes` must be numeric value as defined in `?pch`")
+    stop("'shapes' must be numeric value as defined in '?pch'")
 
   # Warn and coerce to default for inappropriate point size
   if(!is.numeric(pt_size)) {
-    message("`pt_size` must be numeric. Coercing to 1.5")
+    warning("'pt_size' must be numeric. Coercing to 1.5")
     pt_size <- 1.5 }
 
   # Do the same for transparency
   if(!is.numeric(pt_alpha)) {
-    message("`pt_alpha` must be numeric. Coercing to 1")
+    warning("'pt_alpha' must be numeric. Coercing to 1")
     pt_alpha <- 1 }
 
   # Warning message when attempting to plot too many groups
   if (base::length(base::unique(groupcol)) > base::min(base::length(colors),
                                                        base::length(shapes),
                                                        base::length(lines))) {
-    message('Insufficient aesthetic values provided. 10 colors/shapes/lines are built into the function but you have supplied ', length(unique(groupcol)), ' groups. Please modify `colors`, `lines`, or `shapes` as needed to provide one value per category in your group column.')
+    warning("Insufficient aesthetic values provided. 10 colors/shapes/lines are built into the function but you have supplied ", length(unique(groupcol)), " groups. Please modify 'colors', 'lines', or 'shapes' as needed to provide one value per category in your group column.")
   } else {
 
     # Before actually creating the plot we need to make sure colors/shapes/lines are correctly formatted

R/rmd_export.R

@@ -3,7 +3,7 @@
 #' @description This function allows you to knit a specified R Markdown file locally and export it to the Google Drive folder for which you provided a link. NOTE that if you have not used `googledrive::drive_auth` this will prompt you to authorize a Google account in a new browser tab. If you do not check the box in that screen before continuing you will not be able to use this function until you clear your browser cache and re-authenticate. I recommend invoking `drive_auth` beforehand to reduce the chances of this error
 #'
 #' @param rmd (character) name and path to R markdown file to knit
-#' @param out_path (character) path to the knit file's destination (defaults to path returned by `getwd`)
+#' @param out_path (character) path to the knit file's destination (defaults to path returned by `getwd()`)
 #' @param out_name (character) desired name for knit file (with or without file suffix)
 #' @param out_type (character) either "html" or "pdf" depending on what YAML entry you have in the `output: ` field of your R Markdown file
 #' @param drive_link (character) full URL of drive folder to upload the knit document
@@ -28,11 +28,11 @@ rmd_export <- function(rmd = NULL, out_path = getwd(), out_name = NULL, out_type
 
   # Error out for unspecified R markdown file to knit
   if(base::is.null(rmd))
-    stop("Name of .Rmd file to knit must be provided to `rmd`")
+    stop("Name of .Rmd file to knit must be provided to 'rmd'")
 
   # Error out for unspecified export name
   if(base::is.null(out_name))
-    stop("Name to export knit file locally must be provided to `out_name`")
+    stop("Name to export knit file locally must be provided to 'out_name'")
 
   # Error out if any argument is not a character
   if(!base::is.character(rmd) |
@@ -42,10 +42,11 @@ rmd_export <- function(rmd = NULL, out_path = getwd(), out_name = NULL, out_type
 
   # Error out for invalid export types
   if(!out_type %in% c("html", "pdf"))
-    stop("Invalid `out_type` specification. Please supply either 'html' or 'pdf'")
+    stop("Invalid 'out_type' specification. Please supply either 'html' or 'pdf'")
 
     # If the input name does not include .Rmd, add it
-    if(stringr::str_detect(rmd, pattern = ".Rmd") != "TRUE"){ rmd <- base::paste0(rmd, ".Rmd") }
+    if(stringr::str_detect(rmd, pattern = ".Rmd") != "TRUE"){ 
+      rmd <- base::paste0(rmd, ".Rmd") }
 
     # Render provided input
     rmarkdown::render(input = rmd, output_dir = out_path, output_file = out_name)

R/safe_rename.R

@@ -29,13 +29,12 @@ safe_rename <- function(data = NULL, bad_names = NULL, good_names = NULL){
     stop("Must provide same number of replacement column names as names to be replaced")
 
   # Error out if good names are not characters
-  if(is.character(bad_names) != TRUE |
-     is.character(good_names) != TRUE)
+  if(is.character(bad_names) != TRUE | is.character(good_names) != TRUE)
     stop("Column names (bad and good) must be provided as characters")
 
   # Error out if not all "bad_names" are found in the data
   if(all(bad_names %in% names(data)) != TRUE)
-    stop("Not all `bad_names` found in data")
+    stop("Not all elements of 'bad_names' found in data")
 
   # Duplicate data
   renamed_data <- data