Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Simple glms no longer supported? #660

Merged
merged 2 commits into from
Nov 29, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
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: performance
Title: Assessment of Regression Models Performance
Version: 0.10.8.5
Version: 0.10.8.6
Authors@R:
c(person(given = "Daniel",
family = "Lüdecke",
Expand Down
7 changes: 7 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,8 +1,15 @@
# performance 0.10.9

## Changes

* `r2()` for models of class `glmmTMB` without random effects now returns the
correct r-squared value for non-mixed models.

## Bug fixes

* Fixed issue in `binned_residuals()` for models with binary outcome, where
in rare occasions empty bins could occur.

# performance 0.10.8

## Changes
Expand Down
27 changes: 16 additions & 11 deletions R/binned_residuals.R
Original file line number Diff line number Diff line change
Expand Up @@ -143,17 +143,22 @@ binned_residuals <- function(model,
n <- length(items)
sdev <- stats::sd(y[items], na.rm = TRUE)

conf_int <- switch(ci_type,
gaussian = stats::qnorm(c((1 - ci) / 2, (1 + ci) / 2), mean = ybar, sd = sdev / sqrt(n)),
exact = {
out <- stats::binom.test(sum(y0[items]), n)$conf.int
# center CIs around point estimate
out <- out - (min(out) - ybar) - (diff(out) / 2)
out
},
boot = .boot_binned_ci(y[items], ci, iterations)
)
names(conf_int) <- c("CI_low", "CI_high")
# sanity check - do we have any data in our bin?
if (n == 0) {
conf_int <- stats::setNames(c(NA, NA), c("CI_low", "CI_high"))
} else {
conf_int <- switch(ci_type,
gaussian = stats::qnorm(c((1 - ci) / 2, (1 + ci) / 2), mean = ybar, sd = sdev / sqrt(n)),
exact = {
out <- stats::binom.test(sum(y0[items]), n)$conf.int
# center CIs around point estimate
out <- out - (min(out) - ybar) - (diff(out) / 2)
out
},
boot = .boot_binned_ci(y[items], ci, iterations)
)
names(conf_int) <- c("CI_low", "CI_high")
}

d0 <- data.frame(
xbar = xbar,
Expand Down
68 changes: 67 additions & 1 deletion tests/testthat/test-binned_residuals.R
Original file line number Diff line number Diff line change
Expand Up @@ -164,7 +164,7 @@ test_that("binned_residuals, msg for non-bernoulli", {

dat <- data.frame(tot, suc)
dat$prop <- suc / tot
dat$x1 <- as.factor(sample(1:5, 100, replace = TRUE))
dat$x1 <- as.factor(sample.int(5, 100, replace = TRUE))

mod <- glm(prop ~ x1,
family = binomial,
Expand All @@ -175,3 +175,69 @@ test_that("binned_residuals, msg for non-bernoulli", {
expect_message(binned_residuals(mod), regex = "Using `ci_type = \"gaussian\"`")
expect_silent(binned_residuals(mod, verbose = FALSE))
})

test_that("binned_residuals, empty bins", {
eel <- data.frame(
cured_bin = c(
1, 1, 1, 0, 0, 0, 1, 0, 0, 1, 0,
0, 0, 1, 1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0,
0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0,
0, 1, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0,
0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 0, 1,
0, 0, 1, 1, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 0
),
intervention = c(
"No treatment",
"No treatment", "No treatment", "No treatment", "Intervention",
"No treatment", "Intervention", "Intervention", "No treatment",
"No treatment", "Intervention", "No treatment", "No treatment",
"Intervention", "No treatment", "No treatment", "Intervention",
"Intervention", "Intervention", "Intervention", "No treatment",
"Intervention", "Intervention", "No treatment", "Intervention",
"Intervention", "No treatment", "No treatment", "Intervention",
"Intervention", "No treatment", "No treatment", "Intervention",
"Intervention", "Intervention", "No treatment", "No treatment",
"Intervention", "No treatment", "Intervention", "No treatment",
"Intervention", "Intervention", "Intervention", "No treatment",
"No treatment", "No treatment", "Intervention", "Intervention",
"No treatment", "Intervention", "Intervention", "Intervention",
"No treatment", "No treatment", "Intervention", "Intervention",
"No treatment", "Intervention", "Intervention", "No treatment",
"No treatment", "No treatment", "Intervention", "Intervention",
"No treatment", "No treatment", "No treatment", "No treatment",
"No treatment", "Intervention", "No treatment", "Intervention",
"Intervention", "Intervention", "No treatment", "Intervention",
"Intervention", "No treatment", "Intervention", "No treatment",
"No treatment", "Intervention", "Intervention", "Intervention",
"Intervention", "No treatment", "Intervention", "Intervention",
"No treatment", "Intervention", "No treatment", "Intervention",
"Intervention", "Intervention", "Intervention", "No treatment",
"No treatment", "No treatment", "Intervention", "No treatment",
"No treatment", "Intervention", "No treatment", "No treatment",
"No treatment", "No treatment", "No treatment", "Intervention",
"Intervention", "No treatment", "No treatment", "Intervention"
), duration = c(
7L, 7L, 6L, 8L, 7L, 6L, 7L, 7L, 8L, 7L, 7L, 7L,
5L, 9L, 6L, 7L, 8L, 7L, 7L, 9L, 7L, 9L, 8L, 7L, 6L, 8L, 7L, 6L,
7L, 6L, 7L, 6L, 5L, 6L, 7L, 7L, 8L, 7L, 5L, 7L, 9L, 10L, 7L,
8L, 5L, 8L, 4L, 7L, 8L, 6L, 6L, 6L, 7L, 7L, 8L, 7L, 7L, 7L, 7L,
8L, 7L, 9L, 7L, 8L, 8L, 7L, 7L, 7L, 8L, 7L, 8L, 7L, 8L, 8L, 9L,
7L, 10L, 5L, 7L, 8L, 9L, 5L, 10L, 8L, 7L, 6L, 5L, 6L, 7L, 7L,
7L, 7L, 7L, 7L, 8L, 5L, 6L, 7L, 6L, 7L, 7L, 9L, 6L, 6L, 7L, 7L,
6L, 7L, 8L, 9L, 4L, 6L, 9L
),
stringsAsFactors = FALSE
)
m_eel <- glm(cured_bin ~ intervention + duration, data = eel, family = binomial())
out <- binned_residuals(m_eel)
expect_equal(
out$xbar,
c(0.27808, 0.28009, 0.28167, 0.28326, 0.48269, 0.56996, 0.57188, 0.57456),
tolerance = 1e-4
)
expect_equal(
out$CI_low,
c(-0.42552, -0.45162, -0.10819, -0.7339, -0.28086, -0.52599, 0.02795, -0.44023),
tolerance = 1e-4
)
})
Loading