A continuacion se simula un dataset con una variable continua riesgo_genetico y una binaria cancer, cuya probabilidad depende del riesgo mediante una función logística
set.seed(123)
n <- 100
riesgo_genetico <- runif(n, 0, 1)
prob_cancer <- 1 / (1 + exp(-(-2 + 5 * riesgo_genetico)))
cancer <- rbinom(n, 1, prob_cancer)
data <- data.frame(cancer, riesgo_genetico)
head(data)
## cancer riesgo_genetico
## 1 0 0.2875775
## 2 1 0.7883051
## 3 1 0.4089769
## 4 0 0.8830174
## 5 1 0.9404673
## 6 1 0.0455565
modelo_lineal <- lm(cancer ~ riesgo_genetico, data = data)
summary(modelo_lineal)
##
## Call:
## lm(formula = cancer ~ riesgo_genetico, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.0175 -0.2807 0.0284 0.3011 0.8083
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.15041 0.07988 1.883 0.0627 .
## riesgo_genetico 0.98202 0.13928 7.051 2.52e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3949 on 98 degrees of freedom
## Multiple R-squared: 0.3366, Adjusted R-squared: 0.3298
## F-statistic: 49.72 on 1 and 98 DF, p-value: 2.522e-10
Grafica los puntos y ajusta la línea de regresión lineal, aunque de por si las variables y datos usados nunca van a superar el 1, es util ver el modelo con esta base de datos.
ggplot(data = data, aes(x = riesgo_genetico, y = cancer)) +
geom_point(aes(color = as.factor(cancer)), shape = 1) +
geom_smooth(method = "lm", color = "gray20", se = FALSE) +
theme_bw() +
labs(title = "Regresión lineal por mínimos cuadrados",
y = "Probabilidad de cáncer") +
theme(legend.position = "none")
## `geom_smooth()` using formula = 'y ~ x'
A continuacion se predice la respuesta esperada (valor continuo) cuando riesgo_genetico = 0.5.
predict(object = modelo_lineal, newdata = data.frame(riesgo_genetico = 0.5))
## 1
## 0.6414151
Se ajusta una regresión logística, apropiada para variables binarias.
modelo_logistico <- glm(cancer ~ riesgo_genetico, data = data, family = "binomial")
summary(modelo_logistico)
##
## Call:
## glm(formula = cancer ~ riesgo_genetico, family = "binomial",
## data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.0006 0.5346 -3.742 0.000182 ***
## riesgo_genetico 5.8672 1.1937 4.915 8.86e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 130.684 on 99 degrees of freedom
## Residual deviance: 91.716 on 98 degrees of freedom
## AIC: 95.716
##
## Number of Fisher Scoring iterations: 5
Se grafica la curva logística predicha sobre los datos.
ggplot(data = data, aes(x = riesgo_genetico, y = cancer)) +
geom_point(aes(color = as.factor(cancer)), shape = 1) +
stat_function(fun = function(x){
predict(modelo_logistico, newdata = data.frame(riesgo_genetico = x), type = "response")
}) +
theme_bw() +
labs(title = "Regresión logística",
y = "Probabilidad de cáncer") +
theme(legend.position = "none")
Aqui hay otra forma más sencilla de graficar la curva logística con ggplot2.
ggplot(data = data, aes(x = riesgo_genetico, y = cancer)) +
geom_point(aes(color = as.factor(cancer)), shape = 1) +
geom_smooth(method = "glm", method.args = list(family = "binomial"),
color = "gray20", se = FALSE) +
theme_bw() +
theme(legend.position = "none")
## `geom_smooth()` using formula = 'y ~ x'
Ambas funciones devuelven el mismo valor, util para la transformación logística (sigmoide) de un número.
sig <- function(x){ 1 / (1 + exp(-x)) }
sig(0.15041)
## [1] 0.5375318
plogis(0.15041)
## [1] 0.5375318
Se compara visualmente la distribución del riesgo genético entre los grupos con y sin cáncer.
data <- data %>% mutate(cancer = as.factor(cancer))
ggplot(data = data, aes(x = cancer, y = riesgo_genetico, color = cancer)) +
geom_boxplot(outlier.shape = NA) +
geom_jitter(width = 0.1) +
theme_bw() +
theme(legend.position = "none")
modelo <- glm(cancer ~ riesgo_genetico, data = data, family = "binomial")
confint(object = modelo, level = 0.95)
## Waiting for profiling to be done...
## 2.5 % 97.5 %
## (Intercept) -3.131067 -1.014082
## riesgo_genetico 3.733298 8.463583
data$cancer <- as.character(data$cancer)
data$cancer <- as.numeric(data$cancer)
nuevos_puntos <- seq(from = min(data$riesgo_genetico), to = max(data$riesgo_genetico), length.out = 100)
predicciones <- predict(modelo, data.frame(riesgo_genetico = nuevos_puntos), se.fit = TRUE)
predicciones_logit <- exp(predicciones$fit) / (1 + exp(predicciones$fit))
limite_inferior <- predicciones$fit - 1.96 * predicciones$se.fit
limite_inferior_logit <- exp(limite_inferior) / (1 + exp(limite_inferior))
limite_superior <- predicciones$fit + 1.96 * predicciones$se.fit
limite_superior_logit <- exp(limite_superior) / (1 + exp(limite_superior))
datos_curva <- data.frame(riesgo_genetico = nuevos_puntos,
probabilidad_cancer = predicciones_logit,
limite_inferior_logit = limite_inferior_logit,
limite_superior_logit = limite_superior_logit)
Muestra la curva logística ajustada junto con los intervalos de confianza, permitiendonos una interpretacion más clara del modelo
ggplot(data, aes(x = riesgo_genetico, y = cancer)) +
geom_point(aes(color = as.factor(cancer)), shape = "I", size = 3) +
geom_line(data = datos_curva, aes(y = probabilidad_cancer), color = "firebrick") +
geom_line(data = datos_curva, aes(y = limite_inferior_logit), linetype = "dashed") +
geom_line(data = datos_curva, aes(y = limite_superior_logit), linetype = "dashed") +
theme_bw() +
labs(title = "Modelo regresión logística cancer ~ riesgo_genetico",
y = "P(cancer = 1 | riesgo_genetico)", x = "riesgo_genetico") +
theme(legend.position = "none",
plot.title = element_text(hjust = 0.5))
La base de datos cuenta con 100 observaciones y dos variables: riesgo_genetico, que es una variable continua que oscila entre 0 y 1, y cancer, que es una variable binaria que señala si una persona tiene cáncer (1) o no (0). La probabilidad de que alguien tenga cáncer se generó usando una función logística que depende del riesgo genético, lo que refleja una relación creciente y no lineal.
El código demuestra cómo modelar adecuadamente una variable binaria mediante regresión logística y compara sus resultados con los de un modelo lineal, que resulta no necesarimente malo en este contexto, pero que idealmente se debe usar el regresion logistica. Las visualizaciones reafirman esta ventaja al mostrar cómo el modelo logístico captura correctamente la forma en S de la relación entre el riesgo genético y la probabilidad de cáncer. Además, se incluyen predicciones puntuales, intervalos de confianza y representaciones gráficas robustas, lo que convierte al flujo de trabajo en una guía completa para el análisis de variables binarias en R, con aplicaciones directas en contextos medicos, sociales y científicos.