Me ha parecido una pregunta muy interesante y me he esforzado por pensar en situaciones en las que el agrupamiento de una variable de respuesta permitiría mejorar las predicciones.
Lo mejor que se me ha ocurrido es un escenario como este (todo el código se adjunta al final), donde la clase roja corresponde a $y \leq 1$ y la clase azul a $y>1$ y tenemos un predictor (o por supuesto más) que dentro de la clase no está correlacionado con $y$ pero separa perfectamente las clases. ![enter image description here]()
Aquí, una regresión logística penalizada por Firth
Predicted
Truth red blue
red 5000 0
blue 2 4998
bate un modelo lineal simple (seguido de una clasificación basada en si las predicciones son >1):
Predicted
Truth red blue
red 4970 30
blue 0 5000
Sin embargo, seamos sinceros, parte del problema es que una regresión lineal no es un modelo tan bueno para este problema. Sustituir la regresión lineal y la regresión logística por una regresión y un bosque aleatorio de clasificación, respectivamente, resuelve esto perfectamente. Ambos producen este resultado (véase más abajo):
Predicted
Truth red blue
red 5000 0
blue 0 5000
Sin embargo, supongo que al menos es un ejemplo en el que parece que se obtienen resultados un poco mejores dentro de la clase de modelos con una ecuación de regresión lineal (por supuesto, esto sigue ignorando totalmente la posibilidad de utilizar splines, etc.).
library(tidyverse)
library(ranger)
library(ggrepel)
library(logistf)
# Set defaults for ggplot2 ----
theme_set( theme_bw(base_size=18) +
theme(legend.position = "none"))
scale_colour_discrete <- function(...) {
# Alternative: ggsci::scale_color_nejm(...)
scale_colour_brewer(..., palette="Set1")
}
scale_fill_discrete <- function(...) {
# Alternative: ggsci::scale_fill_nejm(...)
scale_fill_brewer(..., palette="Set1")
}
scale_colour_continuous <- function(...) {
scale_colour_viridis_c(..., option="turbo")
}
update_geom_defaults("point", list(size=2))
update_geom_defaults("line", list(size=1.5))
# To allow adding label to points e.g. as geom_text_repel(data=. %>% filter(1:n()==n()))
update_geom_defaults("text_repel", list(label.size = NA, fill = rgb(0,0,0,0),
segment.color = "transparent", size=6))
# Start program ----
set.seed(1234)
records = 5000
# Create the example data including a train-test split
example = tibble(y = c(runif(n=records*2, min = 0, max=1),
runif(n=records*2, min = 1, max=2)),
class = rep(c(0L,1L), each=records*2),
test = factor(rep(c(0,1,0,1), each=records),
levels=0:1, labels=c("Train", "Test")),
predictor = c(runif(n=records*2, min = 0, max=1),
runif(n=records*2, min = 1, max=2)))
# Plot the dataset
example %>%
ggplot(aes(x=predictor, y=y, col=factor(class))) +
geom_point(alpha=0.3) +
facet_wrap(~test)
# Linear regression
lm1 = lm(data=example %>% filter(test=="Train"),
y ~ predictor)
# Performance of linear regression prediction followed by classifying by prediction>1
table(example %>% filter(test=="Test") %>% pull(class),
predict(lm1,
example %>% filter(test=="Test")) > 1)
# Firth penalized logistic regression
glm1 = logistf(data=example %>% filter(test=="Train"),
class ~ predictor,
pl=F)
# Performance of classifying by predicted log-odds from Firth LR being >0
table(example %>% filter(test=="Test") %>% pull(class),
predict(glm1,
example %>% filter(test=="Test"))>0)
# Now, let's try this with RF instead:
# First, binary classification RF
rf1 = ranger(formula = class ~ predictor,
data=example %>% filter(test=="Train"),
classification = T)
table(example %>% filter(test=="Test") %>% pull(class),
predict(rf1, example %>% filter(test=="Test"))$predictions)
# Now regression RF
rf2 = ranger(formula = y ~ predictor,
data=example %>% filter(test=="Train"),
classification = F)
table(example %>% filter(test=="Test") %>% pull(class),
predict(rf2, example %>% filter(test=="Test"))$predictions>1)
