diff --git a/R/SHARED.R b/R/SHARED.R index 7094b447..65f3e2fd 100644 --- a/R/SHARED.R +++ b/R/SHARED.R @@ -691,22 +691,24 @@ make_df <- function(ncol, nrow = 0, types = "numeric") { stop("'types' must be an acceptable type. For factors, use NA.") } if (length(types) == 1) types <- rep(types, ncol) - for (i in seq_len(ncol)) if (!is.na(types)[i] && types[i] != "numeric") df[[i]] <- get(types[i])(nrow) + for (i in seq_len(ncol)) if (!is.na(types)[i] && types[i] != "numeric") { + df[[i]] <- get(types[i])(nrow) + } } df } ifelse_ <- function(...) { dotlen <- ...length() - if (dotlen %% 2 == 0) stop("ifelse_ must have an odd number of arguments: pairs of test/yes, and one no.") + if (dotlen %% 2 == 0) stop("`ifelse_()` must have an odd number of arguments: pairs of test/yes, and one no.") out <- ...elt(dotlen) if (dotlen <= 1) { - if (!is.atomic(out)) stop("The first entry to ifelse_ must be atomic.") + if (!is.atomic(out)) stop("The first entry to `ifelse_()` must be atomic.") } if (!is.atomic(out)) { - stop("The last entry to ifelse_ must be atomic.") + stop("The last entry to `ifelse_()` must be atomic.") } if (length(out) == 1) out <- rep(out, length(..1)) @@ -716,8 +718,8 @@ ifelse_ <- function(...) { yes <- ...elt(2*i) if (length(yes) == 1) yes <- rep(yes, n) if (length(yes) != n || length(test) != n) stop("All entries must have the same length.") - if (!is.logical(test)) stop(paste("The", ordinal(2*i - 1), "entry to ifelse_ must be logical.")) - if (!is.atomic(yes)) stop(paste("The", ordinal(2*i), "entry to ifelse_ must be atomic.")) + if (!is.logical(test)) stop(paste("The", ordinal(2*i - 1), "entry to `ifelse_()` must be logical.")) + if (!is.atomic(yes)) stop(paste("The", ordinal(2*i), "entry to `ifelse_()` must be atomic.")) pos <- which(test) out[pos] <- yes[pos] } diff --git a/R/functions_for_processing.R b/R/functions_for_processing.R index f871b3dc..598f9674 100644 --- a/R/functions_for_processing.R +++ b/R/functions_for_processing.R @@ -2047,6 +2047,7 @@ get_covs_from_formula <- function(f, data = NULL, factor_sep = "_", int_sep = " #ex=names of variables to exclude in interactions and polynomials; a subset of df #int=whether to include interactions or not; currently only 2-way are supported #poly=degree of polynomials to include; will also include all below poly. If 1, no polynomial will be included + #orth=use orthogonal polynomials #nunder=number of underscores between variables cn <- is_not_null(co.names) diff --git a/R/set.cobalt.options.R b/R/set.cobalt.options.R index c23035e0..09acb5af 100644 --- a/R/set.cobalt.options.R +++ b/R/set.cobalt.options.R @@ -65,11 +65,11 @@ set.cobalt.options <- function(..., default = FALSE) { opts <- opts[names(opts) %in% names(acceptable.options())] } + return.to.default <- NULL if (default) { return.to.default <- setdiff(names(acceptable.options()), names(opts)) } - else return.to.default <- NULL - + multiple.opts <- NULL bad.opts <- NULL for (i in names(opts)) { @@ -80,8 +80,11 @@ set.cobalt.options <- function(..., default = FALSE) { else { if (length(opts[[i]]) > 1 && i %nin% multiple.allowed) multiple.opts <- c(multiple.opts, i) if (mode(opts[[i]]) != mode(acceptable.options()[[i]]) || - (!(is.character(opts[[i]]) && is.character(acceptable.options()[[i]]) && (i %in% any.string.allowed || !anyNA(pmatch(opts[[i]], acceptable.options()[[i]])))) && - !all(opts[[i]] %in% acceptable.options()[[i]]))) bad.opts <- c(bad.opts, i) + (!(is.character(opts[[i]]) && is.character(acceptable.options()[[i]]) && + (i %in% any.string.allowed || !anyNA(pmatch(opts[[i]], acceptable.options()[[i]])))) && + !all(opts[[i]] %in% acceptable.options()[[i]]))) { + bad.opts <- c(bad.opts, i) + } } } @@ -167,6 +170,7 @@ acceptable.options <- function() { int_sep = " * ", factor_sep = "_", center = TF, + orth = TF, remove_perfect_col = TF, disp.call = TF) }