Skip to content

Commit

Permalink
lintr, style, remove cwi
Browse files Browse the repository at this point in the history
  • Loading branch information
strengejacke committed Oct 4, 2024
1 parent 54ddb72 commit cf6b287
Show file tree
Hide file tree
Showing 21 changed files with 98 additions and 158 deletions.
2 changes: 0 additions & 2 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -112,7 +112,6 @@ S3method(ci,sim.merMod)
S3method(ci,slopes)
S3method(ci,stanfit)
S3method(ci,stanreg)
S3method(cwi,data.frame)
S3method(describe_posterior,BFBayesFactor)
S3method(describe_posterior,BGGM)
S3method(describe_posterior,MCMCglmm)
Expand Down Expand Up @@ -642,7 +641,6 @@ export(contr.orthonorm)
export(convert_bayesian_as_frequentist)
export(convert_p_to_pd)
export(convert_pd_to_p)
export(cwi)
export(density_at)
export(describe_posterior)
export(describe_prior)
Expand Down
4 changes: 2 additions & 2 deletions R/bic_to_bf.R
Original file line number Diff line number Diff line change
Expand Up @@ -27,8 +27,8 @@ bic_to_bf <- function(bic, denominator, log = FALSE) {
delta <- (denominator - bic) / 2

if (log) {
return(delta)
delta
} else {
return(exp(delta))
exp(delta)
}
}
4 changes: 2 additions & 2 deletions R/describe_prior.R
Original file line number Diff line number Diff line change
Expand Up @@ -63,7 +63,7 @@ describe_prior.brmsfit <- function(model,

# If the prior scale has been adjusted, it is the actual scale that was used.
if ("Prior_Adjusted_Scale" %in% names(priors)) {
priors$Prior_Scale[!is.na(priors$Prior_Adjusted_Scale)] <- priors$Prior_Adjusted_Scale[!is.na(priors$Prior_Adjusted_Scale)]
priors$Prior_Scale[!is.na(priors$Prior_Adjusted_Scale)] <- priors$Prior_Adjusted_Scale[!is.na(priors$Prior_Adjusted_Scale)] # nolint
priors$Prior_Adjusted_Scale <- NULL
}

Expand All @@ -85,7 +85,7 @@ describe_prior.brmsfit <- function(model,
colnames(priors)[1] <- "Cleaned_Parameter"
out <- merge(cp, priors, by = "Cleaned_Parameter", all = TRUE)
out <- out[!duplicated(out$Parameter), ]
priors <- out[intersect(colnames(out), c("Parameter", "Prior_Distribution", "Prior_df", "Prior_Location", "Prior_Scale", "Response"))]
priors <- out[intersect(colnames(out), c("Parameter", "Prior_Distribution", "Prior_df", "Prior_Location", "Prior_Scale", "Response"))] # nolint
}

priors
Expand Down
17 changes: 13 additions & 4 deletions R/diagnostic_draws.R
Original file line number Diff line number Diff line change
Expand Up @@ -27,17 +27,26 @@ diagnostic_draws <- function(posterior, ...) {
diagnostic_draws.brmsfit <- function(posterior, ...) {
insight::check_if_installed("brms")

data <- brms::nuts_params(posterior)
data$idvar <- paste0(data$Chain, "_", data$Iteration)
nuts_parameters <- brms::nuts_params(posterior)
nuts_parameters$idvar <- paste0(
nuts_parameters$Chain,
"_",
nuts_parameters$Iteration
)
out <- stats::reshape(
data,
nuts_parameters,
v.names = "Value",
idvar = "idvar",
timevar = "Parameter",
direction = "wide"
)
out$idvar <- NULL
out <- merge(out, brms::log_posterior(posterior), by = c("Chain", "Iteration"), sort = FALSE)
out <- merge(
out,
brms::log_posterior(posterior),
by = c("Chain", "Iteration"),
sort = FALSE
)

# Rename
names(out)[names(out) == "Value.accept_stat__"] <- "Acceptance_Rate"
Expand Down
32 changes: 16 additions & 16 deletions R/distribution.R
Original file line number Diff line number Diff line change
Expand Up @@ -33,21 +33,21 @@ distribution <- function(type = "normal", ...) {
)

switch(match.arg(arg = type, choices = basr_r_distributions),
"beta" = distribution_beta(...),
"binom" = ,
"binomial" = distribution_binomial(...),
"cauchy" = distribution_cauchy(...),
"chisq" = ,
"chisquared" = distribution_chisquared(...),
"gamma" = distribution_gamma(...),
"gaussian" = ,
"normal" = distribution_normal(...),
"nbinom" = distribution_nbinom(...),
"poisson" = distribution_poisson(...),
"t" = ,
"student" = ,
"student_t" = distribution_student(...),
"uniform" = distribution_uniform(...),
beta = distribution_beta(...),
binom = ,
binomial = distribution_binomial(...),
cauchy = distribution_cauchy(...),
chisq = ,
chisquared = distribution_chisquared(...),
gamma = distribution_gamma(...),
gaussian = ,
normal = distribution_normal(...),
nbinom = distribution_nbinom(...),
poisson = distribution_poisson(...),
t = ,
student = ,
student_t = distribution_student(...),
uniform = distribution_uniform(...),
distribution_custom(type = type, ...)
)
}
Expand Down Expand Up @@ -148,7 +148,7 @@ distribution_mixture_normal <- function(n, mean = c(-3, 3), sd = 1, random = FAL
n <- round(n / length(mean))
sd <- sd
if (length(sd) != length(mean)) {
sd <- rep(sd, length.out = length(mean))
sd <- rep_len(sd, length(mean))
}


Expand Down
10 changes: 6 additions & 4 deletions R/effective_sample.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,8 +16,10 @@
#' information there is in autocorrelated chains} (*Kruschke 2015, p182-3*).
#'
#' @references
#' - Kruschke, J. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press.
#' - Bürkner, P. C. (2017). brms: An R package for Bayesian multilevel models using Stan. Journal of Statistical Software, 80(1), 1-28
#' - Kruschke, J. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS,
#' and Stan. Academic Press.
#' - Bürkner, P. C. (2017). brms: An R package for Bayesian multilevel models
#' using Stan. Journal of Statistical Software, 80(1), 1-28
#'
#' @examplesIf require("rstanarm")
#' \donttest{
Expand Down Expand Up @@ -82,7 +84,7 @@ effective_sample.brmsfit <- function(model,
#' @export
effective_sample.stanreg <- function(model,
effects = c("fixed", "random", "all"),
component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"),
component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), # nolint
parameters = NULL,
...) {
# check arguments
Expand Down Expand Up @@ -112,7 +114,7 @@ effective_sample.stanreg <- function(model,
#' @export
effective_sample.stanmvreg <- function(model,
effects = c("fixed", "random", "all"),
component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"),
component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), # nolint
parameters = NULL,
...) {
# check arguments
Expand Down
3 changes: 2 additions & 1 deletion R/hdi.R
Original file line number Diff line number Diff line change
Expand Up @@ -82,7 +82,8 @@
#' @inherit ci return
#'
#' @family ci
#' @seealso Other interval functions, such as [hdi()], [eti()], [bci()], [spi()], [si()], [cwi()].
#' @seealso Other interval functions, such as [`hdi()`], [`eti()`], [`bci()`],
#' [`spi()`], [`si()`].
#'
#' @examplesIf require("rstanarm") && require("brms") && require("emmeans") && require("BayesFactor")
#' library(bayestestR)
Expand Down
6 changes: 3 additions & 3 deletions R/model_to_priors.R
Original file line number Diff line number Diff line change
Expand Up @@ -35,12 +35,12 @@ model_to_priors.brmsfit <- function(model, scale_multiply = 3, ...) {

for (p in priors_params$Parameter) {
if (p %in% params$Parameter) {
subset <- params[params$Parameter == p, ]
param_subset <- params[params$Parameter == p, ]
priors$prior[priors_params$Parameter == p] <- paste0(
"normal(",
insight::format_value(subset$Mean),
insight::format_value(param_subset$Mean),
", ",
insight::format_value(subset$SD * scale_multiply),
insight::format_value(param_subset$SD * scale_multiply),
")"
)
}
Expand Down
52 changes: 39 additions & 13 deletions R/overlap.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
#' Overlap Coefficient
#'
#' A method to calculate the overlap coefficient between two empirical distributions (that can be used as a measure of similarity between two samples).
#' A method to calculate the overlap coefficient between two empirical
#' distributions (that can be used as a measure of similarity between two
#' samples).
#'
#' @param x Vector of x values.
#' @param y Vector of x values.
Expand All @@ -17,32 +19,56 @@
#' overlap(x, y)
#' plot(overlap(x, y))
#' @export
overlap <- function(x, y, method_density = "kernel", method_auc = "trapezoid", precision = 2^10, extend = TRUE, extend_scale = 0.1, ...) {
overlap <- function(x,
y,
method_density = "kernel",
method_auc = "trapezoid",
precision = 2^10,
extend = TRUE,
extend_scale = 0.1,
...) {
# Generate densities
dx <- estimate_density(x, method = method_density, precision = precision, extend = extend, extend_scale = extend_scale, ...)
dy <- estimate_density(y, method = method_density, precision = precision, extend = extend, extend_scale = extend_scale, ...)
dx <- estimate_density(
x,
method = method_density,
precision = precision,
extend = extend,
extend_scale = extend_scale,
...
)
dy <- estimate_density(
y,
method = method_density,
precision = precision,
extend = extend,
extend_scale = extend_scale,
...
)

# Create density estimation functions
fx <- stats::approxfun(dx$x, dx$y, method = "linear", rule = 2)
fy <- stats::approxfun(dy$x, dy$y, method = "linear", rule = 2)

x_axis <- seq(min(c(dx$x, dy$x)), max(c(dx$x, dy$x)), length.out = precision)
data <- data.frame(x = x_axis, y1 = fx(x_axis), y2 = fy(x_axis))

approx_data <- data.frame(x = x_axis, y1 = fx(x_axis), y2 = fy(x_axis))


# calculate intersection densities
data$intersection <- pmin(data$y1, data$y2)
data$exclusion <- pmax(data$y1, data$y2)
approx_data$intersection <- pmin(approx_data$y1, approx_data$y2)
approx_data$exclusion <- pmax(approx_data$y1, approx_data$y2)

# integrate areas under curves
area_intersection <- area_under_curve(data$x, data$intersection, method = method_auc)
area_intersection <- area_under_curve(
approx_data$x,
approx_data$intersection,
method = method_auc
)
# area_exclusion <- area_under_curve(data$x, data$exclusion, method = method_auc)


# compute overlap coefficient
overlap <- area_intersection
attr(overlap, "data") <- data
attr(overlap, "data") <- approx_data

class(overlap) <- c("overlap", class(overlap))
overlap
Expand All @@ -59,7 +85,7 @@ print.overlap <- function(x, ...) {
#' @export
plot.overlap <- function(x, ...) {
# Can be improved through see
data <- attributes(x)$data
graphics::plot(data$x, data$exclusion, type = "l")
graphics::polygon(data$x, data$intersection, col = "red")
plot_data <- attributes(x)$data
graphics::plot(plot_data$x, plot_data$exclusion, type = "l")
graphics::polygon(plot_data$x, plot_data$intersection, col = "red")
}
2 changes: 1 addition & 1 deletion R/p_significance.R
Original file line number Diff line number Diff line change
Expand Up @@ -285,7 +285,7 @@ p_significance.predictions <- p_significance.slopes
p_significance.stanreg <- function(x,
threshold = "default",
effects = c("fixed", "random", "all"),
component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"),
component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), # nolint
parameters = NULL,
verbose = TRUE,
...) {
Expand Down
File renamed without changes.
10 changes: 5 additions & 5 deletions man/bayestestR-package.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 0 additions & 1 deletion man/bci.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 0 additions & 1 deletion man/ci.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

0 comments on commit cf6b287

Please sign in to comment.