From 036d4ec80e6f95fed5d973f4c2656dcd59e828f5 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 6 Sep 2024 10:50:34 +0200 Subject: [PATCH] lintr --- R/bci.R | 3 ++- R/ci.R | 3 ++- R/describe_posterior.R | 8 +++++--- R/equivalence_test.R | 3 ++- R/estimate_density.R | 3 ++- R/eti.R | 3 ++- R/hdi.R | 3 ++- R/map_estimate.R | 3 ++- R/p_map.R | 3 ++- R/p_significance.R | 15 ++++++++------- R/point_estimate.R | 20 +++++++++++++++----- R/print.equivalence_test.R | 2 +- R/rope.R | 3 ++- R/si.R | 6 ++++-- R/spi.R | 11 ++++------- R/utils.R | 20 ++++++++++---------- 16 files changed, 65 insertions(+), 44 deletions(-) diff --git a/R/bci.R b/R/bci.R index 7ed341136..b5e61ccf4 100644 --- a/R/bci.R +++ b/R/bci.R @@ -47,7 +47,8 @@ bci.numeric <- function(x, ci = 0.95, verbose = TRUE, ...) { bci.data.frame <- function(x, ci = 0.95, rvar_col = NULL, verbose = TRUE, ...) { obj_name <- insight::safe_deparse_symbol(substitute(x)) - if (length(x_rvar <- .possibly_extract_rvar_col(x, rvar_col)) > 0L) { + x_rvar <- .possibly_extract_rvar_col(x, rvar_col) + if (length(x_rvar) > 0L) { cl <- match.call() cl[[1]] <- bayestestR::bci cl$x <- x_rvar diff --git a/R/ci.R b/R/ci.R index 704e5f7ce..0011fcf62 100644 --- a/R/ci.R +++ b/R/ci.R @@ -160,7 +160,8 @@ ci.numeric <- function(x, ci = 0.95, method = "ETI", verbose = TRUE, BF = 1, ... #' @inheritParams p_direction #' @export ci.data.frame <- function(x, ci = 0.95, method = "ETI", BF = 1, rvar_col = NULL, verbose = TRUE, ...) { - if (length(x_rvar <- .possibly_extract_rvar_col(x, rvar_col)) > 0L) { + x_rvar <- .possibly_extract_rvar_col(x, rvar_col) + if (length(x_rvar) > 0L) { cl <- match.call() cl[[1]] <- bayestestR::ci cl$x <- x_rvar diff --git a/R/describe_posterior.R b/R/describe_posterior.R index f0ca20370..b69821755 100644 --- a/R/describe_posterior.R +++ b/R/describe_posterior.R @@ -465,7 +465,7 @@ describe_posterior.default <- function(posterior, ...) { test_psig$.rowid <- seq_len(nrow(test_psig)) } else if (!all(is.na(test_rope$Parameter))) { test_rope$.rowid <- seq_len(nrow(test_rope)) - } else if (!all(is.na(test_bf$Parameter))) { + } else if (!all(is.na(test_bf$Parameter))) { # nolint test_bf$.rowid <- seq_len(nrow(test_bf)) } else { estimates$.rowid <- seq_len(nrow(estimates)) @@ -590,12 +590,14 @@ describe_posterior.data.frame <- function(posterior, rvar_col = NULL, verbose = TRUE, ...) { - if (length(x_rvar <- .possibly_extract_rvar_col(posterior, rvar_col)) > 0L) { + x_rvar <- .possibly_extract_rvar_col(posterior, rvar_col) + if (length(x_rvar) > 0L) { cl <- match.call() cl[[1]] <- bayestestR::describe_posterior cl$posterior <- x_rvar cl$rvar_col <- NULL - if (length(prior_rvar <- .possibly_extract_rvar_col(posterior, bf_prior)) > 0L) { + prior_rvar <- .possibly_extract_rvar_col(posterior, bf_prior) + if (length(prior_var) > 0L) { cl$bf_prior <- prior_rvar } out <- eval.parent(cl) diff --git a/R/equivalence_test.R b/R/equivalence_test.R index 482bececb..57d4b2058 100644 --- a/R/equivalence_test.R +++ b/R/equivalence_test.R @@ -150,7 +150,8 @@ equivalence_test.numeric <- function(x, range = "default", ci = 0.95, verbose = equivalence_test.data.frame <- function(x, range = "default", ci = 0.95, rvar_col = NULL, verbose = TRUE, ...) { obj_name <- insight::safe_deparse_symbol(substitute(x)) - if (length(x_rvar <- .possibly_extract_rvar_col(x, rvar_col)) > 0L) { + x_rvar <- .possibly_extract_rvar_col(x, rvar_col) + if (length(x_rvar) > 0L) { cl <- match.call() cl[[1]] <- bayestestR::equivalence_test cl$x <- x_rvar diff --git a/R/estimate_density.R b/R/estimate_density.R index 468b10200..9ee4c424f 100644 --- a/R/estimate_density.R +++ b/R/estimate_density.R @@ -235,7 +235,8 @@ estimate_density.data.frame <- function(x, at = NULL, rvar_col = NULL, ...) { - if (length(x_rvar <- .possibly_extract_rvar_col(x, rvar_col)) > 0L) { + x_rvar <- .possibly_extract_rvar_col(x, rvar_col) + if (length(x_rvar) > 0L) { cl <- match.call() cl[[1]] <- bayestestR::estimate_density cl$x <- x_rvar diff --git a/R/eti.R b/R/eti.R index 48efe0ccc..4bcf75af1 100644 --- a/R/eti.R +++ b/R/eti.R @@ -71,7 +71,8 @@ eti.numeric <- function(x, ci = 0.95, verbose = TRUE, ...) { eti.data.frame <- function(x, ci = 0.95, rvar_col = NULL, verbose = TRUE, ...) { obj_name <- insight::safe_deparse_symbol(substitute(x)) - if (length(x_rvar <- .possibly_extract_rvar_col(x, rvar_col)) > 0L) { + x_rvar <- .possibly_extract_rvar_col(x, rvar_col) + if (length(x_rvar) > 0L) { cl <- match.call() cl[[1]] <- bayestestR::eti cl$x <- x_rvar diff --git a/R/hdi.R b/R/hdi.R index 77abd3aea..0662a2c52 100644 --- a/R/hdi.R +++ b/R/hdi.R @@ -148,7 +148,8 @@ hdi.numeric <- function(x, ci = 0.95, verbose = TRUE, ...) { hdi.data.frame <- function(x, ci = 0.95, rvar_col = NULL, verbose = TRUE, ...) { obj_name <- insight::safe_deparse_symbol(substitute(x)) - if (length(x_rvar <- .possibly_extract_rvar_col(x, rvar_col)) > 0L) { + x_rvar <- .possibly_extract_rvar_col(x, rvar_col) + if (length(x_rvar) > 0L) { cl <- match.call() cl[[1]] <- bayestestR::hdi cl$x <- x_rvar diff --git a/R/map_estimate.R b/R/map_estimate.R index 3c7c02501..aea57b96c 100644 --- a/R/map_estimate.R +++ b/R/map_estimate.R @@ -151,7 +151,8 @@ map_estimate.brmsfit <- function(x, precision = 2^10, method = "kernel", effects #' @inheritParams p_direction #' @export map_estimate.data.frame <- function(x, precision = 2^10, method = "kernel", rvar_col = NULL, ...) { - if (length(x_rvar <- .possibly_extract_rvar_col(x, rvar_col)) > 0L) { + x_rvar <- .possibly_extract_rvar_col(x, rvar_col) + if (length(x_rvar) > 0L) { cl <- match.call() cl[[1]] <- bayestestR::map_estimate cl$x <- x_rvar diff --git a/R/p_map.R b/R/p_map.R index b257e7fd5..a0267e867 100644 --- a/R/p_map.R +++ b/R/p_map.R @@ -127,7 +127,8 @@ p_map.get_predicted <- function(x, #' @rdname p_map #' @inheritParams p_direction p_map.data.frame <- function(x, null = 0, precision = 2^10, method = "kernel", rvar_col = NULL, ...) { - if (length(x_rvar <- .possibly_extract_rvar_col(x, rvar_col)) > 0L) { + x_rvar <- .possibly_extract_rvar_col(x, rvar_col) + if (length(x_rvar) > 0L) { cl <- match.call() cl[[1]] <- bayestestR::p_map cl$x <- x_rvar diff --git a/R/p_significance.R b/R/p_significance.R index b6ba0fe4e..46c8bd1c5 100644 --- a/R/p_significance.R +++ b/R/p_significance.R @@ -114,7 +114,8 @@ p_significance.get_predicted <- function(x, p_significance.data.frame <- function(x, threshold = "default", rvar_col = NULL, ...) { obj_name <- insight::safe_deparse_symbol(substitute(x)) - if (length(x_rvar <- .possibly_extract_rvar_col(x, rvar_col)) > 0L) { + x_rvar <- .possibly_extract_rvar_col(x, rvar_col) + if (length(x_rvar) > 0L) { cl <- match.call() cl[[1]] <- bayestestR::p_significance cl$x <- x_rvar @@ -269,18 +270,18 @@ p_significance.stanreg <- function(x, component <- match.arg(component) threshold <- .select_threshold_ps(model = x, threshold = threshold, verbose = verbose) - data <- p_significance( + result <- p_significance( insight::get_parameters(x, effects = effects, component = component, parameters = parameters), threshold = threshold ) cleaned_parameters <- insight::clean_parameters(x) - out <- .prepare_output(data, cleaned_parameters, inherits(x, "stanmvreg")) + out <- .prepare_output(result, cleaned_parameters, inherits(x, "stanmvreg")) attr(out, "clean_parameters") <- cleaned_parameters attr(out, "threshold") <- threshold attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) - class(out) <- class(data) + class(out) <- class(result) out } @@ -305,18 +306,18 @@ p_significance.brmsfit <- function(x, component <- match.arg(component) threshold <- .select_threshold_ps(model = x, threshold = threshold, verbose = verbose) - data <- p_significance( + result <- p_significance( insight::get_parameters(x, effects = effects, component = component, parameters = parameters), threshold = threshold ) cleaned_parameters <- insight::clean_parameters(x) - out <- .prepare_output(data, cleaned_parameters) + out <- .prepare_output(result, cleaned_parameters) attr(out, "clean_parameters") <- cleaned_parameters attr(out, "threshold") <- threshold attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) - class(out) <- class(data) + class(out) <- class(result) out } diff --git a/R/point_estimate.R b/R/point_estimate.R index 49ebc2b63..c11a6040a 100644 --- a/R/point_estimate.R +++ b/R/point_estimate.R @@ -83,7 +83,7 @@ point_estimate.numeric <- function(x, centrality = "all", dispersion = FALSE, th estimate_list <- centrality } - out <- data.frame(".temp" = 0) + out <- data.frame(.temp = 0) # Median if ("median" %in% estimate_list) { @@ -132,8 +132,14 @@ point_estimate.numeric <- function(x, centrality = "all", dispersion = FALSE, th #' @export #' @rdname point_estimate #' @inheritParams p_direction -point_estimate.data.frame <- function(x, centrality = "all", dispersion = FALSE, threshold = 0.1, rvar_col = NULL, ...) { - if (length(x_rvar <- .possibly_extract_rvar_col(x, rvar_col)) > 0L) { +point_estimate.data.frame <- function(x, + centrality = "all", + dispersion = FALSE, + threshold = 0.1, + rvar_col = NULL, + ...) { + x_rvar <- .possibly_extract_rvar_col(x, rvar_col) + if (length(x_rvar) > 0L) { cl <- match.call() cl[[1]] <- bayestestR::point_estimate cl$x <- x_rvar @@ -156,7 +162,7 @@ point_estimate.data.frame <- function(x, centrality = "all", dispersion = FALSE, estimates <- do.call(rbind, estimates) } - out <- cbind(data.frame("Parameter" = names(x), stringsAsFactors = FALSE), estimates) + out <- cbind(data.frame(Parameter = names(x), stringsAsFactors = FALSE), estimates) rownames(out) <- NULL attr(out, "data") <- x attr(out, "centrality") <- centrality @@ -209,7 +215,11 @@ point_estimate.BGGM <- point_estimate.bcplm #' @export -point_estimate.bamlss <- function(x, centrality = "all", dispersion = FALSE, component = c("conditional", "location", "all"), ...) { +point_estimate.bamlss <- function(x, + centrality = "all", + dispersion = FALSE, + component = c("conditional", "location", "all"), + ...) { component <- match.arg(component) out <- point_estimate( insight::get_parameters(x, component = component), diff --git a/R/print.equivalence_test.R b/R/print.equivalence_test.R index 620ee1664..044d4554b 100644 --- a/R/print.equivalence_test.R +++ b/R/print.equivalence_test.R @@ -84,7 +84,7 @@ print.equivalence_test <- function(x, digits = 2, ...) { .dynGet <- function(x, - ifnotfound = stop(gettextf("%s not found", sQuote(x)), domain = NA), + ifnotfound = stop(gettextf("%s not found", sQuote(x)), domain = NA, call. = FALSE), minframe = 1L, inherits = FALSE) { x <- insight::safe_deparse(x) diff --git a/R/rope.R b/R/rope.R index 36e905d21..cdb692584 100644 --- a/R/rope.R +++ b/R/rope.R @@ -219,7 +219,8 @@ rope.get_predicted <- function(x, rope.data.frame <- function(x, range = "default", ci = 0.95, ci_method = "ETI", rvar_col = NULL, verbose = TRUE, ...) { obj_name <- insight::safe_deparse_symbol(substitute(x)) - if (length(x_rvar <- .possibly_extract_rvar_col(x, rvar_col)) > 0L) { + x_rvar <- .possibly_extract_rvar_col(x, rvar_col) + if (length(x_rvar) > 0L) { cl <- match.call() cl[[1]] <- bayestestR::rope cl$x <- x_rvar diff --git a/R/si.R b/R/si.R index 4e75f8c05..69bb9bde3 100644 --- a/R/si.R +++ b/R/si.R @@ -224,12 +224,14 @@ si.get_predicted <- function(posterior, prior = NULL, BF = 1, use_iterations = F #' @inheritParams p_direction #' @export si.data.frame <- function(posterior, prior = NULL, BF = 1, rvar_col = NULL, verbose = TRUE, ...) { - if (length(x_rvar <- .possibly_extract_rvar_col(posterior, rvar_col)) > 0L) { + x_rvar <- .possibly_extract_rvar_col(posterior, rvar_col) + if (length(x_rvar) > 0L) { cl <- match.call() cl[[1]] <- bayestestR::si cl$posterior <- x_rvar cl$rvar_col <- NULL - if (length(prior_rvar <- .possibly_extract_rvar_col(posterior, prior)) > 0L) { + prior_rvar <- .possibly_extract_rvar_col(posterior, prior) + if (length(prior_rvar) > 0L) { cl$prior <- prior_rvar } out <- eval.parent(cl) diff --git a/R/spi.R b/R/spi.R index abe90e29c..b4baf5607 100644 --- a/R/spi.R +++ b/R/spi.R @@ -71,7 +71,8 @@ spi.numeric <- function(x, ci = 0.95, verbose = TRUE, ...) { spi.data.frame <- function(x, ci = 0.95, rvar_col = NULL, verbose = TRUE, ...) { obj_name <- insight::safe_deparse_symbol(substitute(x)) - if (length(x_rvar <- .possibly_extract_rvar_col(x, rvar_col)) > 0L) { + x_rvar <- .possibly_extract_rvar_col(x, rvar_col) + if (length(x_rvar) > 0L) { cl <- match.call() cl[[1]] <- bayestestR::spi cl$x <- x_rvar @@ -351,11 +352,7 @@ spi.get_predicted <- function(x, ci = 0.95, use_iterations = FALSE, verbose = TR } # output - data.frame( - "CI" = ci, - "CI_low" = x.l, - "CI_high" = x.u - ) + data.frame(CI = ci, CI_low = x.l,CI_high = x.u) } .spi_lower <- function(bw, n.sims, k, l, dens, x) { @@ -432,7 +429,7 @@ spi.get_predicted <- function(x, ci = 0.95, use_iterations = FALSE, verbose = TR w.l <- quadprog::solve.QP(D.l, d.l, A.l, c(1, rep(0, range_ll_lu + 2)), range_ll_lu) x.l <- w.l$solution %*% x[l.l:l.u] - return(x.l) + x.l } .spi_upper <- function(bw, n.sims, ui, u, dens, x) { diff --git a/R/utils.R b/R/utils.R index 1af5ac507..876e7debd 100644 --- a/R/utils.R +++ b/R/utils.R @@ -186,21 +186,21 @@ all_attrs <- attributes(results) # save attributes for later all_class <- class(results) - grid <- insight::get_datagrid(object) - grid_names <- colnames(grid) + datagrid <- insight::get_datagrid(object) + grid_names <- colnames(datagrid) if (long) { - grid$Parameter <- unique(results$Parameter) - results <- datawizard::data_merge(grid, results, by = "Parameter") + datagrid$Parameter <- unique(results$Parameter) + results <- datawizard::data_merge(datagrid, results, by = "Parameter") results$Parameter <- NULL class(results) <- all_class } else { - results[colnames(grid)] <- grid + results[colnames(datagrid)] <- datagrid results$Parameter <- NULL results <- results[, c(grid_names, setdiff(colnames(results), grid_names)), drop = FALSE] # add back attributes - most_attrs <- all_attrs[setdiff(names(all_attrs), names(attributes(grid)))] + most_attrs <- all_attrs[setdiff(names(all_attrs), names(attributes(datagrid)))] attributes(results)[names(most_attrs)] <- most_attrs } @@ -225,13 +225,13 @@ all_attrs <- attributes(results) # save attributes for later all_class <- class(results) - is_rvar <- vapply(object, function(col) inherits(col, "rvar"), FUN.VALUE = logical(1)) + is_rvar <- vapply(object, inherits, FUN.VALUE = logical(1), "rvar") grid_names <- colnames(object)[!is_rvar] - grid <- data.frame(object[, grid_names, drop = FALSE]) + datagrid <- data.frame(object[, grid_names, drop = FALSE]) if (long) { - grid$Parameter <- unique(results$Parameter) - results <- datawizard::data_merge(grid, results, by = "Parameter") + datagrid$Parameter <- unique(results$Parameter) + results <- datawizard::data_merge(datagrid, results, by = "Parameter") results$Parameter <- NULL class(results) <- all_class } else {