построение поверхности отклика для логистической регрессии (трехмерный график)

Question

Я хочу построить поверхность отклика для логистической регрессии. Я пробовал с scatterplot3dно ничего не получил.
На графике должна быть ось X = возраст, ось Y = стоимость проезда и ось Z = прогнозируемые вероятности.

library(mlr)
library(tidyverse)
#install.packages("ciTools")
library(ciTools)
#install.packages("titanic")
data(titanic_train, package = "titanic")
titanicTib <- as_tibble(titanic_train)
titanicTib
fctrs <- c("Survived", "Sex", "Pclass")

titanicClean <- titanicTib %>%
  mutate_at(.vars = fctrs, .funs = factor) %>%
  mutate(FamSize = SibSp + Parch) %>%
  select(Survived, Pclass, Sex, Age, Fare, FamSize)

titanicClean

imp <- impute(titanicClean, cols = list(Age = imputeMean()))

sum(is.na(titanicClean$Age))
sum(is.na(imp$data$Age))
imp$data %>%
  glimpse()

model <- glm(Survived ~ (Pclass + Sex + Age + Fare + FamSize),
             family = "binomial", data = imp$data)

summary(model)



newdata<- data.frame(FamSize = mean(imp$data$FamSize),
                   Fare = seq(min(imp$data$Fare), max(imp$data$Fare), length.out= 102)
                   Sex = factor(rep(c("male"), 102)),
                   Pclass = factor(rep(c(1:3), each=34)),
                   Age = rep(seq(1, 100, 3), 3) )


preds <- predict(model, newdata = newdata, type = "response" , se.fit =TRUE)

Я пробовал с scatterplot3d как это:

scatterplot3d(imp$data$Age[1:20], imp$data$Fare[1:20], imp$data$Survived[1:20],
                    angle = 55,
                    main="3D Scatter Plot",
                    xlab = "Age",
                    ylab = "Fare",
                    zlab = "Survived", color="steelblue", grid = TRUE,
                    )

Answer 1

Вот пример поверхности отклика.

ng <- 41 ## grid size
ss <- function(x) seq(min(x,na.rm=TRUE), max(x,na.rm=TRUE), length.out=ng)
newdata <- with(titanicClean,
                expand.grid(Sex="male",
                            Pclass="1",
                            Fare=ss(Fare),
                            Age=ss(Age),
                            FamSize=mean(FamSize))
                )

Это не имеет большого значения, поскольку у вас нет взаимодействий в вашей модели (поэтому различия в нефокальных параметрах приведут только к сдвигу базовой линии вашей модели, но не изменят ее форму), но если вам нужен "средний" ответ для В моделях, включающих категориальные предикторы, может быть удобнее использовать контрасты суммы к нулю при подборе модели.

Возможно, стоит также изучить effects и emmeans пакеты, которые могут упростить процесс построения координатной сетки и генерации соответствующих прогнозов.

Чтобы построить с persp или же rgl::persp3d нам нужно значение отклика (z), структурированное в виде матрицы. Fare меняется быстрее, чем Age в newdata, поэтому ответ на Fare будут сохранены как увеличивающиеся значения в столбцах, когда мы свернем вектор прогнозов обратно в матрицу (я думаю: вы можете дважды проверить это!)

pp <- predict(model, newdata,type="response", se.fit=TRUE)
fitmat <- matrix(pp$fit, nrow=ng)
fvec <- ss(titanicClean$Fare)
avec <- ss(titanicClean$Age)

Теперь, когда у нас есть данные, мы можем построить:

persp(avec,fvec,fitmat)
library(rgl)
persp3d(avec,fvec,fitmat,col="gray")
library(plot3Drgl)
persp3Drgl(avec,fvec,fitmat,col="gray")

• persp на основе R дает "ванильные" перспективные графики (вы можете управлять перспективой и т. д., изменяя параметры и перерисовывая график).
• persp3d из rgl дает динамический график, который можно улучшить, и позволяет вращать его с помощью мыши
• persp3Drgl кладет еще один слой изящности поверх persp3d