Gráfico de superficie de las interacciones de regresión logística

Question

Estoy tratando de visualizar algunas interacciones diferentes de una regresión logística en R. Me gustaría crear un gráfico de superficie del modelo de predicción con dos variables de predicción a lo largo de la x y la y, a continuación, la predicción binaria en la z.

He intentado usar plotly, geoR, persp, bplot, y algunos otros métodos sin mucho éxito. Casi tuve éxito con lattice, pero no estoy seguro de cómo trazar el modelo predictivo en lugar de los datos en bruto.

Algunos antecedentes: a continuación se presentan datos simulados modelados a partir de un experimento en el que un observador toma una decisión de sí/no sobre un estímulo presentado en 9 ajustes diferentes que van de 0,6 a 1,4 en pasos de 0,1. El ajuste (ordinal) y un parámetro adicional que va de 0,02626 a 0,14749 (continuo) se utilizaron para predecir el sí/no utilizando glmer a la:

resultado ~ (efecto aleatorio) + ajuste * parámetro

Los resultados mostraron una interacción negativa significativa entre el ajuste y el parámetro; esto es lo que estoy tratando de visualizar.

outcome <- sample(x = c(0,1), size = 4186, replace = TRUE)
setting <- sample(x = c(0.6,0.7,0.8,0.9,1.0,1.1,1.2,1.3,1.4), size = 4186, replace = TRUE)
parameter <- runif(4186, min=0.02626, max=0.14749)

Lo más cerca que he llegado es a usar este código:

library(lattice)
library(gridExtra)

trellis.par.set("axis.line", list(col=NA,lty=1,lwd=1))
jobsat_plot <- wireframe(outcome ~ setting*parameter, data=data, 
          xlab = "setting",
          ylab = "parameter",
          main = "Logistic - setting x parameter",
          drape = TRUE,
          colorkey = TRUE,
          scales = list(arrows=FALSE,cex=.5, tick.number = 10, z = list(arrows=F), distance =c(1.5, 1.5, 1.5)),
          light.source = c(10,0,10),
          col.regions = rainbow(100, s = 1, v = 1, start = 0, end = max(1,100 - 1)/100, alpha = .8),
          screen = list(z = -60, x = -60)
)

grid.arrange(jobsat_plot, ncol=1, clip=TRUE)

Lo que produce algo como esto (con los datos reales; no puedo conseguir que funcione con los datos simulados):

Creo que esto consigue el punto a través, pero me gustaría que el modelo de predicción suave para mostrar las tendencias generales. Se agradece cualquier ayuda o indicación en la dirección correcta.

Answer 1

La razón por la que tu código no funciona es que está trazando los datos en bruto, no las predicciones hechas a partir de un modelo.

Para conseguir lo que quieres, sólo tienes que hacer una cuadrícula de puntos en los que hacer las predicciones del modelo, las predicciones en estos puntos de la cuadrícula, y luego suministrar eso como los datos a wireframe .

library(lattice)
set.seed(42)

dat = data.frame(
    outcome=sample(x = c(0,1), size = 4186, replace = TRUE),
    setting=sample(x = c(0.6,0.7,0.8,0.9,1.0,1.1,1.2,1.3,1.4), size = 4186, replace = TRUE),
    parameter=runif(4186, min=0.02626, max=0.14749)
    )
model <- glm(outcome ~ setting*parameter, data=dat, family="binomial")

x_tilde <- expand.grid(setting=seq(0.6, 1.4, length.out=10), parameter=seq(0.02626, 0.14749, length.out=10))
x_tilde$prediction <- predict(model, x_tilde, type="response")

wireframe(prediction ~ setting + parameter, data=x_tilde,
    xlab = "setting",
          ylab = "parameter",
          main = "Logistic - setting x parameter",
          drape = TRUE,
          colorkey = TRUE,
          scales = list(arrows=FALSE,cex=.5, tick.number = 10, z = list(arrows=F), distance =c(1.5, 1.5, 1.5)),
          light.source = c(10,0,10),
          col.regions = rainbow(100, s = 1, v = 1, start = 0, end = max(1,100 - 1)/100, alpha = .8),
          screen = list(z = -60, x = -60))

Obviamente, tendrá que afinar la forma de mostrar el gráfico, pero esta es la idea general.