Taller 3_Modelos Lineales Generalizados
JOHN JAIRO PRADO
2024-10-26
2. Se midió el tiempo de muerte en semanas de dos grupos de pacientes con leucemia de acuerdo a una variable morfológica (AG) (1 positivo y 2 negativo). Los datos se encuentran en la base leukwbc y se tiene el número de células blancas en la sangre de cada sujeto antes de su fallecimiento.
(2a) Ajuste un modelo de regresión que permita determinar el tiempo de muerte en semanas de los pacientes con leucemia. Muestre las medidas de bondad de ajuste.
Descripcion del Ejercicio
WBC: el recuento de glóbulos blancos; un vector numérico
Time: el tiempo hasta la muerte en semanas; un vector numérico
AG: la variable morfológica, el factor ag; un vector numérico donde 1 significa ag positivo y 2 significa ag negativo
Detalles: Los datos proporcionan los tiempos de muerte (en semanas) y los recuentos de glóbulos blancos de dos grupos de pacientes con leucemia, Ag positivos y Ag negativos. Los dos grupos no han sido creados mediante asignación aleatoria.
suppressPackageStartupMessages(library(AER))
suppressPackageStartupMessages(library(GLMsData))
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(MASS, exclude = "select"))
suppressPackageStartupMessages(library(plotly))data(leukwbc)
glimpse(leukwbc)Rows: 33
Columns: 3
$ WBC <int> 2300, 750, 4300, 2600, 6000, 10500, 10000, 17000, 5400, 7000, 940…
$ Time <int> 65, 156, 100, 134, 16, 108, 121, 4, 39, 143, 56, 26, 22, 1, 1, 5,…
$ AG <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2,…hist(leukwbc$Time)
Se observa una asimetría positiva.
# Crear la variable dummy para AG
leukwbc$AG <- ifelse(leukwbc$AG == 1, 1, 0)
# Crear las variables dummy para WBC
leukwbc$WBC_Bajo <- ifelse(leukwbc$WBC <= 5000, 1, 0)
leukwbc$WBC_Medio <- ifelse(leukwbc$WBC > 5000 & leukwbc$WBC <= 10000, 1, 0)
leukwbc$WBC_Alto <- ifelse(leukwbc$WBC > 10000, 1, 0)
# Verificar el resultado
head(leukwbc) WBC Time AG WBC_Bajo WBC_Medio WBC_Alto
1 2300 65 1 1 0 0
2 750 156 1 1 0 0
3 4300 100 1 1 0 0
4 2600 134 1 1 0 0
5 6000 16 1 0 1 0
6 10500 108 1 0 0 1# Eliminar columnas asignando a NULL
leukwbc$WBC <- NULL
head(leukwbc) Time AG WBC_Bajo WBC_Medio WBC_Alto
1 65 1 1 0 0
2 156 1 1 0 0
3 100 1 1 0 0
4 134 1 1 0 0
5 16 1 0 1 0
6 108 1 0 0 1Verificar si es Poisson o Binomial negativa:
modelo_poi_leukwbc=glm(Time~.,data=leukwbc,family=poisson(link="log"))
barplot(leukwbc$Time)
dispersiontest(modelo_poi_leukwbc, trafo=1)
Overdispersion test
data: modelo_poi_leukwbc
z = 3.6, p-value = 1e-04
alternative hypothesis: true alpha is greater than 0
sample estimates:
alpha
23.94 La fuerte evidencia sugiere que los datos presentan sobre dispersión.
Ajustar el modelo de regresión binomial negativa
modelo_nb_leukwbc <- glm.nb(Time ~ ., data = leukwbc)Seleccion del Mejor Subconjunto de Variables
step(modelo_nb_leukwbc)Start: AIC=298.8
Time ~ AG + WBC_Bajo + WBC_Medio + WBC_Alto
Step: AIC=298.8
Time ~ AG + WBC_Bajo + WBC_Medio
Df Deviance AIC
<none> 36.7 299
- WBC_Medio 1 39.3 299
- WBC_Bajo 1 46.8 307
- AG 1 47.3 307
Call: glm.nb(formula = Time ~ AG + WBC_Bajo + WBC_Medio, data = leukwbc,
init.theta = 1.107254174, link = log)
Coefficients:
(Intercept) AG WBC_Bajo WBC_Medio
2.319 1.164 1.261 0.669
Degrees of Freedom: 32 Total (i.e. Null); 29 Residual
Null Deviance: 59.6
Residual Deviance: 36.7 AIC: 301mejor_modelo_nb_leukwbc <- glm.nb(Time ~ AG + WBC_Bajo + WBC_Medio, data = leukwbc)
summary(mejor_modelo_nb_leukwbc)
Call:
glm.nb(formula = Time ~ AG + WBC_Bajo + WBC_Medio, data = leukwbc,
init.theta = 1.107254087, link = log)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.319 0.291 7.96 1.7e-15 ***
AG 1.164 0.342 3.40 0.00067 ***
WBC_Bajo 1.261 0.415 3.04 0.00237 **
WBC_Medio 0.669 0.419 1.60 0.11064
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for Negative Binomial(1.107) family taken to be 1)
Null deviance: 59.576 on 32 degrees of freedom
Residual deviance: 36.742 on 29 degrees of freedom
AIC: 300.8
Number of Fisher Scoring iterations: 1
Theta: 1.107
Std. Err.: 0.265
2 x log-likelihood: -290.835 Medidas de Bondad de Ajuste
Pseudo R^2
library(DescTools)
Adjuntando el paquete: 'DescTools'The following object is masked from 'package:car':
RecodePseudoR2(modelo_nb_leukwbc, 'Nagelkerke')Nagelkerke
0.4207 Nota: x < 0.2 El estadistico Nagelkerke recomienda una mala explicacion del modelo de la variable de interes.
0.21 > x < 0.4 El estadistico Nagelkerke recomienda que es una buena explicacion del modelo de la variable de interes.
x > 0.41 El estadistico Nagelkerke recomienda una excelente explicacion del modelo de la variable de interes.
El modelo de regresion binomial negativa explica de manera buena el tiempo hasta la muerte (en semanas) en pacientes con leucemia, considerando los recuentos de glóbulos blancos en dos grupos: aquellos con morfología AG positiva y aquellos con morfología AG negativa.
Prueba de la Deviance
summary(mejor_modelo_nb_leukwbc)
Call:
glm.nb(formula = Time ~ AG + WBC_Bajo + WBC_Medio, data = leukwbc,
init.theta = 1.107254087, link = log)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.319 0.291 7.96 1.7e-15 ***
AG 1.164 0.342 3.40 0.00067 ***
WBC_Bajo 1.261 0.415 3.04 0.00237 **
WBC_Medio 0.669 0.419 1.60 0.11064
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for Negative Binomial(1.107) family taken to be 1)
Null deviance: 59.576 on 32 degrees of freedom
Residual deviance: 36.742 on 29 degrees of freedom
AIC: 300.8
Number of Fisher Scoring iterations: 1
Theta: 1.107
Std. Err.: 0.265
2 x log-likelihood: -290.835 Null deviance: 59.576 on 32 degrees of freedom Residual deviance: 36.742 on 29 degrees of freedom
deviance_inv_leukwbc = 1-pchisq(59.576-36.742, 32-29); deviance_inv_leukwbc [1] 4.373e-05Rechazo de la Hipótesis Nula, dado que el valor p es tan bajo, se rechaza la hipótesis nula. Esto indica que hay evidencia estadística significativa para concluir que el modelo más complejo proporciona un mejor ajuste que el modelo más simple.
Prueba de Coeficientes Estimados
summary(modelo_nb_leukwbc)
Call:
glm.nb(formula = Time ~ ., data = leukwbc, init.theta = 1.107254087,
link = log)
Coefficients: (1 not defined because of singularities)
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.319 0.291 7.96 1.7e-15 ***
AG 1.164 0.342 3.40 0.00067 ***
WBC_Bajo 1.261 0.415 3.04 0.00237 **
WBC_Medio 0.669 0.419 1.60 0.11064
WBC_Alto NA NA NA NA
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for Negative Binomial(1.107) family taken to be 1)
Null deviance: 59.576 on 32 degrees of freedom
Residual deviance: 36.742 on 29 degrees of freedom
AIC: 300.8
Number of Fisher Scoring iterations: 1
Theta: 1.107
Std. Err.: 0.265
2 x log-likelihood: -290.835 La estimación del intercepto indica el valor esperado de la variable dependiente (tiempo hasta la muerte) cuando todas las variables independientes son cero es 2.319.
La estimación para AG es 1.164 con un error estándar de 0.342.
La estimación para la categoría WBC_Bajo es 1.261 con un error estándar de 0.415.
La estimación para WBC_Medio es 0.669 con un error estándar de 0.419.
No se proporciona una estimación para WBC_Alto, lo que indica que puede haber un problema de referencia (o que es la categoría base en el modelo). Esto significa que los resultados para esta categoría se interpretan en relación con las otras.
CONCLUSIONES:
Los resultados del modelo indican que tanto la morfología AG como los diferentes niveles de recuento de glóbulos blancos (WBC) tienen un impacto significativo en el tiempo hasta la muerte en pacientes con leucemia. Los pacientes con recuentos de glóbulos blancos más bajos y aquellos con morfología AG positiva tienden a tener tiempos de supervivencia más prolongados en comparación con los otros grupos.
Interpretacion del coeficiente del modelo
coef(modelo_nb_leukwbc)(Intercept) AG WBC_Bajo WBC_Medio WBC_Alto
2.3189 1.1640 1.2613 0.6691 NA CONCLUSIONES
Intercepto (2.3189):
Este valor representa el logaritmo del tiempo esperado hasta la muerte en semanas cuando todas las variables independientes son cero.
Variable AG (1.1640): La estimación para AG indica que los pacientes con morfología AG positiva tienen un tiempo hasta la muerte que es aproximadamente e^1.1640 ≈ 3.21 veces mayor que el de los pacientes AG negativos. Esto sugiere que la morfología AG positiva está asociada con una mayor supervivencia.
WBC_Bajo (1.2613): Esta estimación sugiere que los pacientes con un bajo recuento de glóbulos blancos (WBC_Bajo) tienen un tiempo hasta la muerte que es aproximadamente e^1.2613 ≈ 3.54 veces mayor que aquellos con un recuento normal. Esto implica que un recuento de glóbulos blancos bajo puede estar asociado con una mayor supervivencia.
WBC_Medio (0.6691):
La estimación para WBC_Medio sugiere que los pacientes con un recuento de glóbulos blancos medio tienen un tiempo hasta la muerte que es aproximadamente e^0.6691 ≈ 1.96 veces mayor que los de recuento normal, lo que también sugiere una mayor supervivencia en este grupo, aunque en menor medida que los de WBC_Bajo.
WBC_Alto (NA): La ausencia de una estimación para WBC_Alto indica que esta categoría es la referencia en el modelo. Por lo tanto, las comparaciones se hacen en relación con este grupo.
Los resultados del modelo indican que la morfología AG y los niveles de recuento de glóbulos blancos influyen significativamente en el tiempo hasta la muerte en pacientes con leucemia. En particular, los pacientes con morfología AG positiva y aquellos con recuentos de glóbulos blancos más bajos tienen un tiempo de supervivencia más prolongado en comparación con sus contrapartes. Estos hallazgos resaltan la importancia de estas variables en la prognosis de los pacientes.
Child
exp(c(1.1640, 1.2613, 0.6691))[1] 3.203 3.530 1.952Los resultados indican que tanto la morfología AG como los niveles de recuento de glóbulos blancos influyen significativamente en el tiempo hasta la muerte en pacientes con leucemia. En particular, los pacientes con morfología AG positiva y recuentos de glóbulos blancos bajos tienen un tiempo de supervivencia más prolongado. Estos hallazgos resaltan la importancia de estas variables en la prognosis de los pacientes.
summary(mejor_modelo_nb_leukwbc)
Call:
glm.nb(formula = Time ~ AG + WBC_Bajo + WBC_Medio, data = leukwbc,
init.theta = 1.107254087, link = log)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.319 0.291 7.96 1.7e-15 ***
AG 1.164 0.342 3.40 0.00067 ***
WBC_Bajo 1.261 0.415 3.04 0.00237 **
WBC_Medio 0.669 0.419 1.60 0.11064
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for Negative Binomial(1.107) family taken to be 1)
Null deviance: 59.576 on 32 degrees of freedom
Residual deviance: 36.742 on 29 degrees of freedom
AIC: 300.8
Number of Fisher Scoring iterations: 1
Theta: 1.107
Std. Err.: 0.265
2 x log-likelihood: -290.835 coef(mejor_modelo_nb_leukwbc)(Intercept) AG WBC_Bajo WBC_Medio
2.3189 1.1640 1.2613 0.6691 exp(c(1.1640, 1.2613, 0.6691))[1] 3.203 3.530 1.952Los resultados indican que tanto la morfología AG como los niveles de recuento de glóbulos blancos influyen significativamente en el tiempo hasta la muerte en pacientes con leucemia. En particular, los pacientes con morfología AG positiva y aquellos con recuentos de glóbulos blancos bajos tienen un tiempo de supervivencia más prolongado. Estos hallazgos subrayan la importancia de considerar estas variables en la prognosis de los pacientes con leucemia.
(2b) Estime el tiempo de vida que le resta a un paciente con un conteo de células blancas en la sangre de 1000 y positivo en AG.
# Crear un nuevo dataframe para el paciente
nuevo_dato <- data.frame(
WBC_Bajo = ifelse(1000 < 5000, 1, 0), # 1 si bajo, 0 si no
WBC_Medio = ifelse(1000 >= 5000 & 1000 < 10000, 1, 0), # 1 si medio, 0 si no
WBC_Alto = 0, # 0 porque no es alto
AG = 1 # Positivo en AG
)
# Estimar el tiempo de vida restante
prediccion <- predict(mejor_modelo_nb_leukwbc, newdata = nuevo_dato, type = "response"); prediccion 1
114.9 La estimación del tiempo de vida restante para un paciente con un conteo de células blancas de 1000 y positivo en AG es de 114.9 semanas.
Este resultado sugiere que, de acuerdo con el modelo de regresión ajustado, este paciente podría esperar vivir aproximadamente 115 semanas más.
((2c) ¿Existen datos atípicos?. Muestre los residuos (le deviance y pearson).
Verificar datos atípicos
par(mfrow=c(1,2))
plot(abs(residuals(mejor_modelo_nb_leukwbc)))
abline(h=2,col = 'red')
plot(abs(residuals(mejor_modelo_nb_leukwbc,type = 'pearson')))
abline(h=2,col = 'red')
# Crear un dataframe con los residuos
residuos_nb_leukwbc = data.frame(
deviance = abs(residuals(mejor_modelo_nb_leukwbc)),
pearson = abs(residuals(mejor_modelo_nb_leukwbc, type='pearson'))
)
# Filtrar los residuos que cumplen la condición
resultados_filt_nb_leukwbc = residuos_nb_leukwbc[residuos_nb_leukwbc$deviance > 2 & residuos_nb_leukwbc$pearson > 2, ]
# Mostrar los resultados filtrados
resultados_filt_nb_leukwbc[1] deviance pearson
<0 rows> (o 0- extensión row.names)La filtración de residuos en resultados_filt_inv_blocks no devolvió filas, lo que indica que no hay residuos que cumplan con las condiciones especificadas (deviance > 2 y pearson > 2). Esto sugiere que, en tu modelo, los residuos están dentro de un rango que no se considera problemático según esos umbrales.
Datos Influyentes
par(mfrow = c(1,1))
library(car)
influencePlot(mejor_modelo_nb_leukwbc)
StudRes Hat CookD
6 1.5734 0.09383 0.1643115
14 -2.0678 0.09383 0.0287406
15 -2.0678 0.09383 0.0287406
22 -0.2017 0.17137 0.0024567
23 0.1037 0.17137 0.0007714
33 1.9947 0.08470 0.2633688Puntos 14 y 15 tienen residuos estudiantiles que podrían considerarse como influyentes, pero no cumplen con los criterios de leverage ni de CookD. Los demás puntos no son influyentes según ninguno de los criterios. En resumen, parece que no hay puntos que cumplan las tres reglas de influencia.