performance::r2_nakagawa() and r.squaredGLMM() give different values for Gaussian glmmTMB models without random effects

[strengejacke]

Fixes #652

• Include weights, see code in summary.lm():

    w <- z$weights
    if (is.null(w)) {
        mss <- if (attr(z$terms, "intercept")) 
            sum((f - mean(f))^2)
        else sum(f^2)
        rss <- sum(r^2)
    }
    else {
        mss <- if (attr(z$terms, "intercept")) {
            m <- sum(w * f/sum(w))
            sum(w * (f - m)^2)
        }
        else sum(w * f^2)
        rss <- sum(w * r^2)
        r <- sqrt(w) * r
    }

[strengejacke]

@IndrajeetPatil This new lintr is a bit odd:

Warning: file=R/r2_coxsnell.R,line=72,col=3,[unnecessary_nesting_linter] Reduce the nesting of this if/else statement by unnesting the portion without an exit clause (i.e., stop(), return(), abort(), quit(), q()).

The related code is:

  if (info$is_binomial && !info$is_bernoulli) {
    if (verbose) {
      insight::format_alert("Can't calculate accurate R2 for binomial models that are not Bernoulli models.")
    }
    return(NULL)
  }

How can I reduce this nesting?

[IndrajeetPatil]

@strengejacke This lint is actually relevant for the entire if/else block:

'r2_nagelkerke.glm <- function(model, verbose = TRUE, ...) {
  info <- list(...)$model_info
  if (is.null(info)) {
    info <- suppressWarnings(insight::model_info(model, verbose = FALSE))
  }
  if (info$is_binomial && !info$is_bernoulli && class(model)[1] == "glm") {
    if (verbose) {
      insight::format_warning("Can\'t calculate accurate R2 for binomial models that are not Bernoulli models.")
    }
    return(NULL)
  } else {
    r2cox <- r2_coxsnell(model)
    if (is.na(r2cox) || is.null(r2cox)) {
      return(NULL)
    }
    r2_nagelkerke <- r2cox / (1 - exp(-model$null.deviance / insight::n_obs(model, disaggregate = TRUE)))
    names(r2_nagelkerke) <- "Nagelkerke\'s R2"
    r2_nagelkerke
  }
}' -> code

library(lintr)
lint(text = code, linters = unnecessary_nesting_linter())
#> <text>:6:3: warning: [unnecessary_nesting_linter] Reduce the nesting of this if/else statement by unnesting the portion without an exit clause (i.e., stop(), return(), abort(), quit(), q()).
#>   if (info$is_binomial && !info$is_bernoulli && class(model)[1] == "glm") {
#>   ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

^{Created on 2023-11-22 with reprex v2.0.2}

Note that, since you are returning early in if branch, you don't need to have else. So you can reduce the nesting and flatten the code so:

r2_nagelkerke.glm <- function(model, verbose = TRUE, ...) {
  info <- list(...)$model_info

  if (is.null(info)) {
    info <- suppressWarnings(insight::model_info(model, verbose = FALSE))
  }

  if (info$is_binomial && !info$is_bernoulli && class(model)[1] == "glm") {
    if (verbose) {
      insight::format_warning("Can\'t calculate accurate R2 for binomial models that are not Bernoulli models.")
    }
    return(NULL)
  }

  r2cox <- r2_coxsnell(model)
  if (is.na(r2cox) || is.null(r2cox)) {
    return(NULL)
  }
  r2_nagelkerke <- r2cox / (1 - exp(-model$null.deviance / insight::n_obs(model, disaggregate = TRUE)))
  names(r2_nagelkerke) <- "Nagelkerke\'s R2"
  r2_nagelkerke
}

Lemme know if you think those are not equivalent.

[strengejacke]

Ah, I see! Makes sense. Thanks!