Code and doc cleaning

Author: ngreifer

R/functions_for_processing.R

@@ -36,7 +36,8 @@
 
   if ((!is.character(method) && !is.function(method)) ||
       (is.character(method) && (length(method) > 1L ||
-                                .method_to_proper_method(method) %nin% names(.weightit_methods)))) {
+                                !utils::hasName(.weightit_methods,
+                                                .method_to_proper_method(method))))) {
     .err(sprintf("`method` must be a string of length 1 containing the name of an acceptable weighting method or a function that produces weights. Allowable methods:\n%s",
                  word_list(names(.weightit_methods), and.or = FALSE, quotes = 2L)),
          tidy = FALSE)
@@ -53,7 +54,7 @@
 
 .check_method_treat.type <- function(method, treat.type) {
   if (is_not_null(method) && is.character(method) &&
-      (method %in% names(.weightit_methods)) &&
+      utils::hasName(.weightit_methods, method) &&
       (treat.type %nin% .weightit_methods[[method]]$treat_type)) {
     .err(sprintf("%s can only be used with a %s treatment",
                  .method_to_phrase(method),
@@ -63,7 +64,7 @@
 
 .check_required_packages <- function(method) {
   if (is_not_null(method) && is.character(method) &&
-      (method %in% names(.weightit_methods))) {
+      utils::hasName(.weightit_methods, method)) {
 
     pkgs <- .weightit_methods[[method]]$packages_needed
 
@@ -85,15 +86,15 @@
     return(s.weights)
   }
 
-  if (!is.character(s.weights) || length(s.weights) != 1L) {
+  if (!chk::vld_string(s.weights)) {
     .err("the argument to `s.weights` must be a vector or data frame of sampling weights or the (quoted) names of the variable in `data` that contains sampling weights")
   }
 
   if (is_null(data)) {
     .err("`s.weights` was specified as a string but there was no argument to `data`")
   }
 
-  if (s.weights %nin% names(data)) {
+  if (!utils::hasName(data, s.weights)) {
     .err("the name supplied to `s.weights` is not the name of a variable in `data`")
   }
 
@@ -111,16 +112,19 @@
 
 .method_to_phrase <- function(method) {
 
-  if (is_null(method))
+  if (is_null(method)) {
     return("no weighting")
+  }
 
-  if (is.function(method))
+  if (is.function(method)) {
     return("a user-defined method")
+  }
 
   method <- .method_to_proper_method(method)
 
-  if (method %nin% names(.weightit_methods))
+  if (!utils::hasName(.weightit_methods, method)) {
     return("the chosen method of weighting")
+  }
 
   .weightit_methods[[method]]$description
 }
@@ -315,9 +319,9 @@
 
 .missing_to_phrase <- function(missing) {
   switch(missing,
-         "ind" = "missingness indicators",
-         "saem" = "SAEM",
-         "surr" = "surrogate splitting",
+         ind = "missingness indicators",
+         saem = "SAEM",
+         surr = "surrogate splitting",
          missing)
 }
 
@@ -350,7 +354,7 @@
       .err("`ps` was specified as a string but there was no argument to `data`")
     }
 
-    if (ps %nin% names(data)) {
+    if (!utils::hasName(data, ps)) {
       .err("the name supplied to `ps` is not the name of a variable in `data`")
     }
 
@@ -571,7 +575,7 @@ get_treated_level <- function(treat, estimand, focal = NULL) {
     by <- NULL
     by.name <- NULL
   }
-  else if (chk::vld_string(by) && by %in% names(data)) {
+  else if (chk::vld_string(by) && utils::hasName(data, by)) {
     by.name <- by
     by <- data[[by]]
   }
@@ -1108,7 +1112,7 @@ stabilize_w <- function(weights, treat) {
   else {
     if (is_null(density)) .density <- function(x, log = FALSE) dnorm(x, log = log)
     else if (is.function(density)) .density <- function(x, log = FALSE) {
-      if ("log" %in% names(formals(density))) density(x, log = log)
+      if (utils::hasName(formals(density), "log")) density(x, log = log)
       else if (log) log(density(x))
       else density(x)
     }
@@ -1136,7 +1140,7 @@ stabilize_w <- function(weights, treat) {
       }
 
       .density <- function(x, log = FALSE) {
-        if ("log" %in% names(formals(splitdens1))) {
+        if (utils::hasName(formals(splitdens1), "log")) {
           out <- tryCatch(do.call(splitdens1, c(list(x, log = log), as.list(str2num(splitdens[-1L])))),
                           error = function(e) {
                             .err(sprintf("Error in applying density:\n  %s",

R/glm_weightit-methods.R

@@ -788,7 +788,7 @@ update.glm_weightit <- function(object, formula. = NULL, ..., evaluate = TRUE) {
         }
       }
 
-      if ("s.weights" %in% names(extras)) {
+      if (utils::hasName(extras, "s.weights")) {
         extras[["s.weights"]] <- NULL
       }
     }

R/plot.weightit.R

@@ -13,7 +13,7 @@
 #'
 #' @details
 #'
-#' ## [`method = "gbm"`](method_gbm)
+#' ## `method = "gbm"`
 #'
 #' After weighting with generalized boosted modeling, `plot()` displays the
 #' results of the tuning process used to find the optimal number of trees (and
@@ -25,7 +25,7 @@
 #' `weightit()`, the plot is faceted by the `by` variable. See [`method_gbm`]
 #' for more information on selecting tuning parameters.
 #'
-#' ## [`method = "optweight"`](method_optweight)
+#' ## `method = "optweight"`
 #'
 #' After estimating stable balancing weights, `plot()` displays the values of
 #' the dual variables for each balance constraint in a bar graph. Large values
@@ -37,7 +37,7 @@
 #' each covariate after weighting is equal to its unweighted mean) and those for
 #' balance (i.e., ensuring the treatment-covariate correlations are no larger
 #' than the imbalance tolerance). This is essentially a wrapper for
-#' \pkgfun{optweight}{plot.optweight}.
+#' \pkgfun{optweight}{plot.optweight}. See [`method_optweight`] for details.
 #'
 #' @seealso [weightit()], [plot.summary.weightit()]
 #'
@@ -52,13 +52,13 @@ plot.weightit <- function(x, ...) {
     .err("`plot(.)` can currently only be used with `weightit()` output objects. To view the distribution of weights, use `plot(summary(.))`")
   }
 
-  if (!is.character(x$method) || !.weightit_methods[[x$method]]$plot.weightit_ok) {
+  if (!chk::vld_string(x$method) || !.weightit_methods[[x$method]]$plot.weightit_ok) {
     .err(sprintf("`plot(.)` cannot be used with %s. To view the distribution of weights, use `plot(summary(.))`",
                  .method_to_phrase(x$method)))
   }
 
   switch(x$method,
-         "gbm" = .plot_tune_gbm(x$info, x$by),
-         "optweight" = .plot_duals_optweight(x$info, x$by)
+         gbm = .plot_tune_gbm(x$info, x$by),
+         optweight = .plot_duals_optweight(x$info, x$by)
   )
 }

R/utils.R

@@ -170,8 +170,8 @@ round_df_char <- function(df, digits, pad = "0", na_vals = "") {
   df[nas] <- na_vals
   df[infs] <- "N/A"
 
-  if (length(rn) > 0L) rownames(df) <- rn
-  if (length(cn) > 0L) names(df) <- cn
+  if (is_not_null(rn)) rownames(df) <- rn
+  if (is_not_null(cn)) names(df) <- cn
 
   df
 }
@@ -591,28 +591,28 @@ hasbar <- function(term) {
 #treat/covs
 get_covs_and_treat_from_formula <- function(f, data = NULL, terms = FALSE, sep = "", ...) {
 
+  if (!rlang::is_formula(f)) {
+    .err("`formula` must be a formula")
+  }
+
+  env <- environment(f)
+
   #Check if data exists
   if (is_not_null(data)) {
     if (is.data.frame(data)) {
       data.specified <- TRUE
     }
     else {
       .wrn("the argument supplied to `data` is not a data.frame object. This may causes errors or unexpected results")
-      data <- environment(f)
+      data <- env
       data.specified <- FALSE
     }
   }
   else {
-    data <- environment(f)
+    data <- env
     data.specified <- FALSE
   }
 
-  env <- environment(f)
-
-  if (!rlang::is_formula(f)) {
-    .err("`formula` must be a formula")
-  }
-
   eval.model.matrx <- !hasbar(f)
 
   tryCatch({
@@ -628,6 +628,9 @@ get_covs_and_treat_from_formula <- function(f, data = NULL, terms = FALSE, sep =
     .err(msg)
   })
 
+  treat <- ...get("treat")
+  treat.name <- NULL
+
   #Check if response exists
   if (rlang::is_formula(tt, lhs = TRUE)) {
     resp.var.mentioned <- attr(tt, "variables")[[2L]]
@@ -648,25 +651,18 @@ get_covs_and_treat_from_formula <- function(f, data = NULL, terms = FALSE, sep =
     }
 
     if (resp.var.failed) {
-      if (is_null(...get("treat"))) {
+      if (is_null(treat)) {
         .err(sprintf("the given response variable, %s, is not a variable in %s",
                      add_quotes(resp.var.mentioned.char),
                      word_list(c("data", "the global environment")[c(data.specified, TRUE)], "or")))
       }
       tt <- delete.response(tt)
     }
-  }
-  else {
-    resp.var.failed <- TRUE
-  }
 
-  if (resp.var.failed) {
-    treat <- ...get("treat")
-    treat.name <- NULL
-  }
-  else {
-    treat.name <- resp.var.mentioned.char
-    treat <- eval(resp.var.mentioned, data, env)
+    if (!resp.var.failed) {
+      treat.name <- resp.var.mentioned.char
+      treat <- eval(resp.var.mentioned, data, env)
+    }
   }
 
   #Check if RHS variables exist
@@ -762,7 +758,7 @@ get_covs_and_treat_from_formula <- function(f, data = NULL, terms = FALSE, sep =
       .err(conditionMessage(e), tidy = FALSE)
     })
 
-    if (is_not_null(treat.name) && treat.name %in% names(covs)) {
+    if (is_not_null(treat.name) && utils::hasName(covs, treat.name)) {
       .err("the variable on the left side of the formula appears on the right side too")
     }
   }

R/weightit.fit.R

@@ -463,6 +463,8 @@ weightitMSM.fit <- function(covs.list, treat.list, method = "glm", s.weights = N
 
   obj <- NULL
 
+  .check_required_packages(method)
+
   if (is.function(method)) {
     fun <- "weightitMSM2user"
   }

R/weightit2user.R

@@ -150,7 +150,7 @@ weightit2user <- function(Fun, covs, treat, s.weights, subset, estimand, focal,
 
   #Get a list of function args for the user-defined function Fun
   Fun_formal <- as.list(formals(Fun))
-  has_dots <- ("..." %in% names(Fun_formal))
+  has_dots <- utils::hasName(Fun_formal, "...")
   if (has_dots) {
     Fun_formal[["..."]] <- NULL
   }
@@ -160,7 +160,7 @@ weightit2user <- function(Fun, covs, treat, s.weights, subset, estimand, focal,
     if (exists(i, inherits = FALSE)) {
       fun_args[i] <- list(get0(i, inherits = FALSE))
     }
-    else if (i %in% names(A)) {
+    else if (utils::hasName(A, i)) {
       fun_args[i] <- A[i]
       A[[i]] <- NULL
     }
@@ -227,7 +227,7 @@ weightitMSM2user <- function(Fun, covs.list, treat.list, s.weights, subset, stab
 
   #Get a list of function args for the user-defined function Fun
   Fun_formal <- as.list(formals(Fun))
-  has_dots <- ("..." %in% names(Fun_formal))
+  has_dots <- utils::hasName(Fun_formal, "...")
   if (has_dots) {
     Fun_formal[["..."]] <- NULL
   }

_dev/R/_aux_functions.R

@@ -324,7 +324,7 @@ process.ps <- function(ps, data = NULL, treat) {
       if (is_null(data)) {
         stop("'ps' was specified as a string but there was no argument to 'data'.", call. = FALSE)
       }
-      else if (ps %in% names(data)) {
+      else if (utils::hasName(data, ps)) {
         ps <- data[[ps]]
       }
       else stop("The name supplied to 'ps' is not the name of a variable in 'ps'.", call. = FALSE)