illustrating binning for binary data/residuals from logistic regression

binnedplots2.R

data("Contraception", package = "mlmRev")
library(lme4)
library(tidyverse)
library(magrittr)
## make sure we have a variable that's actually continuous
Contraception %<>% mutate(ja = jitter(age),
                          n_use = as.numeric(use) -1)
m1 <- glmer(use ~ urban * splines::ns(ja, 3) + (1|district), data = Contraception,
            family = binomial)
aa <- broom.mixed::augment(m1, data = Contraception, type.residuals = "pearson")

## this makes sense if we are plotting binomial *data* values (plots mean and binomial CIs)
bbfun <- function(x) {
  prop <- mean(x)
  n <- length(x)
  bb <- binom.test(sum(x), n)
  data.frame(y = prop, ymin = bb$conf.int[1], ymax = bb$conf.int[2])
}

## continuous variable: data (univariate model/view)
ggplot(aa, aes(ja, n_use)) +
  geom_point(alpha = 0.3, position = position_jitter(height = 0.02)) +
  stat_summary_bin(binwidth = 1, fun.data = bbfun,
                   geom = "pointrange") +
  stat_summary_bin(binwidth = 1, fun.data = bbfun,
                   geom = "ribbon", fill = "blue", alpha = 0.2) +
  geom_smooth(colour = "purple", method = "gam",
              method.args = list(family = binomial))

## continuous variable: residuals
ggplot(aa, aes(ja, .resid)) +
  geom_point(alpha = 0.3) +
  stat_summary_bin(binwidth = 1, fun.data = mean_cl_boot,
                   geom = "pointrange") +
  stat_summary_bin(binwidth = 1, fun.data = mean_cl_boot,
                   geom = "ribbon", fill = "blue", alpha = 0.2) +
  geom_smooth(colour = "purple", method = "loess", span = 0.2)


## categorical predictor: residuals
ggplot(aa, aes(livch, .resid)) +
  ## geom_point(alpha = 0.1) +
  stat_summary(aes(group = livch), fun.data = mean_cl_boot,
               geom = "pointrange")


ggplot(aa, aes(livch, n_use)) +
  geom_point(alpha = 0.3, position = position_jitter(height = 0.02)) +
  stat_summary(aes(group = livch), fun.data = bbfun, geom = "pointrange")