Skip to content
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Type: Package
Package: parameters
Title: Processing of Model Parameters
Version: 0.29.2
Version: 0.29.2.1
Authors@R:
c(person(given = "Daniel",
family = "Lüdecke",
Expand Down
13 changes: 12 additions & 1 deletion R/format_parameters.R
Original file line number Diff line number Diff line change
Expand Up @@ -242,6 +242,11 @@ format_parameters.parameters_model <- function(model, ...) {
name <- .format_factor(name = name, variable = variable, brackets = brackets)
}

# Logical
if (type == "logical") {
name <- .format_logical(name = name, brackets = brackets)
}

# Polynomials
if (type %in% c("poly", "poly_raw")) {
name <- .format_poly(
Expand Down Expand Up @@ -394,6 +399,12 @@ format_parameters.parameters_model <- function(model, ...) {
}


#' @keywords internal
.format_logical <- function(name, brackets = c("[", "]")) {
paste0(name, " ", brackets[1], "TRUE", brackets[2])
}
Comment thread
strengejacke marked this conversation as resolved.


#' @keywords internal
.format_log <- function(name, variable, type, brackets = c("[", "]")) {
paste0(variable, " ", brackets[1], gsub("(.*)\\((.*)\\)", "\\1", name), brackets[2])
Expand Down Expand Up @@ -463,7 +474,7 @@ format_parameters.parameters_model <- function(model, ...) {
factor_terms
)
for (k in seq_along(factor_terms)) {
ft <- factor_terms[k] # e.g. "factor(cyl)"
ft <- factor_terms[k] # e.g. "factor(cyl)"
orig <- cleaned_terms[k] # e.g. "cyl"
if (orig %in% colnames(mf) && !ft %in% colnames(mf)) {
orig_label <- attr(mf[[orig]], "label", exact = TRUE)
Expand Down
7 changes: 7 additions & 0 deletions R/parameters_type.R
Original file line number Diff line number Diff line change
Expand Up @@ -90,7 +90,7 @@
params$Parameter <- gsub("^(count_|zero_)", "", params$Parameter)
}

data <- insight::get_data(model, source = "mf", verbose = FALSE)

Check warning on line 93 in R/parameters_type.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files

file=R/parameters_type.R,line=93,col=3,[object_overwrite_linter] 'data' is an exported object from package 'utils'. Avoid re-using such symbols.
if (is.null(data) || inherits(data, "ts") || nrow(data) == 0) {
return(NULL)
}
Expand Down Expand Up @@ -167,13 +167,13 @@

#' @keywords internal
.parameters_type <- function(name, data, reference) {
if (grepl(":", name, fixed = TRUE)) {

Check warning on line 170 in R/parameters_type.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files

file=R/parameters_type.R,line=170,col=3,[unnecessary_nesting_linter] Reduce the nesting of this if/else statement by unnesting the portion without an exit clause, i.e., return().
# Split
var <- unlist(strsplit(name, ":", fixed = TRUE))

Check warning on line 172 in R/parameters_type.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files

file=R/parameters_type.R,line=172,col=5,[object_overwrite_linter] 'var' is an exported object from package 'stats'. Avoid re-using such symbols.
if (length(var) > 2) {
var <- c(utils::tail(var, 1), paste0(utils::head(var, -1), collapse = ":"))

Check warning on line 174 in R/parameters_type.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files

file=R/parameters_type.R,line=174,col=37,[paste_linter] Use paste(), not paste0(), to collapse a character vector when sep= is not used.

Check warning on line 174 in R/parameters_type.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files

file=R/parameters_type.R,line=174,col=7,[object_overwrite_linter] 'var' is an exported object from package 'stats'. Avoid re-using such symbols.
} else {
var <- rev(var)

Check warning on line 176 in R/parameters_type.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files

file=R/parameters_type.R,line=176,col=7,[object_overwrite_linter] 'var' is an exported object from package 'stats'. Avoid re-using such symbols.
}

# Check if any is factor
Expand All @@ -186,7 +186,7 @@
link <- ifelse(any("factor" %in% types), "Difference", "Association")
# Get type
main <- .parameters_type_basic(var[1], data, reference)
return(c("interaction", link, main[3], main[4], main[5], var[2]))

Check warning on line 189 in R/parameters_type.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files

file=R/parameters_type.R,line=189,col=5,[return_linter] Use implicit return behavior; explicit return() is not needed.
} else {
.parameters_type_basic(name, data, reference)
}
Expand All @@ -209,12 +209,16 @@

# Intercept
if (.in_intercepts(cleaned_name)) {
return(c("intercept", "Mean", "(Intercept)", NA, NA, NA))

Check warning on line 212 in R/parameters_type.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files

file=R/parameters_type.R,line=212,col=5,[return_linter] Use implicit return behavior; explicit return() is not needed.

# Numeric

Check warning on line 214 in R/parameters_type.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files

file=R/parameters_type.R,line=214,col=5,[unreachable_code_linter] Remove code and comments coming after return().
} else if (cleaned_name %in% reference$numeric) {
return(c("numeric", "Association", name, name, NA, NA))

Check warning on line 216 in R/parameters_type.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files

file=R/parameters_type.R,line=216,col=5,[return_linter] Use implicit return behavior; explicit return() is not needed.

# Logicals
} else if (cleaned_name %in% reference$logical) {
return(c("logical", "Difference", name, cleaned_name, "TRUE", NA))
Comment thread
strengejacke marked this conversation as resolved.
Outdated

# Ordered factors
} else if (is.ordered(data[[cleaned_ordered_name]])) {
fac <- reference$levels_parent[match(cleaned_name, reference$levels)]
Expand Down Expand Up @@ -427,5 +431,8 @@
out$levels <- out$levels[!is.na(out$levels)]
out$levels_parent <- out$levels_parent[!is.na(out$levels_parent)]

# Logical
out$logical <- names(data[vapply(data, is.logical, TRUE)])
Comment thread
strengejacke marked this conversation as resolved.
Outdated

out
}
20 changes: 16 additions & 4 deletions R/utils_cleaners.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,15 +11,19 @@
# remove them here and clean/prepare them in ".parameters_type_basic()".
# for formatting / printing, refer to ".format_parameter()".

# fmt: skip
pattern <- if (full) {
c(
"as.factor", "as.numeric", "as.ordered", "factor", "ordered", "offset",
"lag", "diff", "catg", "matrx", "pol", "strata", "strat", "scale",
"as.factor", "as.numeric", "as.ordered", "as.logical", "factor", "ordered",
"offset", "lag", "diff", "catg", "matrx", "pol", "strata", "strat", "scale",
"scored", "interaction", "lsp", "pb", "lo", "t2", "te", "ti", "tt", "mi",
"mo", "gp"
)
} else {
c("as.factor", "as.numeric", "as.ordered", "factor", "ordered", "catg", "interaction")
c(
"as.factor", "as.numeric", "as.ordered", "as.logical", "factor", "ordered",
"catg", "interaction"
)
}

for (j in seq_along(pattern)) {
Expand All @@ -31,13 +35,21 @@
x <- insight::trim_ws(sub("offset\\(([^-+ )]*)\\)(.*)", "\\1\\2", x))
# some exceptions here...
} else if (full && pattern[j] == "scale" && any(grepl("scale(", x, fixed = TRUE))) {
x[grepl("scale(", x, fixed = TRUE)] <- insight::clean_names(grep("scale(", x, fixed = TRUE, value = TRUE))
x[grepl("scale(", x, fixed = TRUE)] <- insight::clean_names(grep(
"scale(",
x,
fixed = TRUE,
value = TRUE
))
} else if (any(grepl(pattern[j], x, fixed = TRUE))) {
p <- paste0(pattern[j], "\\(((\\w|\\.)*)\\)(.*)")
x <- insight::trim_ws(sub(p, "\\1\\3", x))
}
}

# for logicals
x <- gsub("TRUE$", "", x)

gsub("`", "", x, fixed = TRUE)
Comment thread
strengejacke marked this conversation as resolved.
Outdated
}

Expand Down
Loading