El objetivo de este trabajo es poner en práctica los conocimientos adquiridos sobre los Modelos de Supervivencia.
Los detalles específicos de este trabajo los escontrarán en el siguiente enlace
Introducción
Los datos que se nos asignaron están relacionados con campañas de marketing (llamadas telefónicas) de una institución bancaria portuguesa. El objetivo de la clasificación es ver si el cliente suscribirá o no un depósito a plazo.
Antes de continuar daremos una pequeña explicación de lo que es un déposito a plazo. Los Depósitos a Plazo son sumas de dinero entregadas a una institución financiera, con el propósito de generar intereses en un período de tiempo determinado, basicamente son instrumetos de ahorro
Se clasifican en
Depósitos a plazo fijo: la institución se obliga a pagar en un día prefijado los reajustes e intereses obtenidos hasta esa fecha.
Depósitos a plazo renovable: contemplan condiciones similares a los depósitos a plazo fijo, pero con la posibilidad de prorrogar automáticamente el depósito por un nuevo período, de la misma cantidad de días, en caso de que el depositante no retire el dinero en la fecha pactada.
Depósitos a plazo indefinido: en los depósitos a plazo indefinido no se pacta una fecha o plazo determinados de vencimiento por lo que el banco deberá pagar los intereses y reajustes devengados desde la fecha se hace el depósito hasta la fecha avisada para su retiro.
Sabemos que el creciente número de campañas de marketing a lo largo del tiempo ha reducido su efecto sobre el público. Las presiones económicas y la competencia han llevado a los gerentes de marketing a invertir en campañas dirigidas con una estricta y rigurosa selección de contactos: se deben hacer menos contactos, con mayor tasa de éxito.
Base de datos
La base de datos la descargamos de aquí
Vamos a cargarla
banco <- read_csv2("bank-full.csv") #read_csv2() lee archivos separados por ';'
head(banco) %>% kbl(align = c(rep('c', times = 17))) %>%
kable_paper() %>% scroll_box(width = "100%", height = "300px")| age | job | marital | education | default | balance | housing | loan | contact | day | month | duration | campaign | pdays | previous | poutcome | y |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 58 | management | married | tertiary | no | 2143 | yes | no | unknown | 5 | may | 261 | 1 | -1 | 0 | unknown | no |
| 44 | technician | single | secondary | no | 29 | yes | no | unknown | 5 | may | 151 | 1 | -1 | 0 | unknown | no |
| 33 | entrepreneur | married | secondary | no | 2 | yes | yes | unknown | 5 | may | 76 | 1 | -1 | 0 | unknown | no |
| 47 | blue-collar | married | unknown | no | 1506 | yes | no | unknown | 5 | may | 92 | 1 | -1 | 0 | unknown | no |
| 33 | unknown | single | unknown | no | 1 | no | no | unknown | 5 | may | 198 | 1 | -1 | 0 | unknown | no |
| 35 | management | married | tertiary | no | 231 | yes | no | unknown | 5 | may | 139 | 1 | -1 | 0 | unknown | no |
[1] 45211Cada una de las filas del dataset representan a un cliente individual, en total contamos con la información de 45,211 clientes
Nuestra base esta compuesta por las siguientes variables
Datos del cliente
age: edad (numérica)
job: tipo de trabajo (categórica) -‘admin.’, ‘blue-collar’, ‘entrepreneur’, ‘housemaid’, ‘management’, ‘retired’, ‘self-employed’, ‘services’, ‘student’, ‘technician’, ‘unemployed’, ‘unknown’-
marital : estado civil (categórica) -‘divorced’, ‘married’, ‘single’, ‘unknown’- nota: ‘divorced’ significa divorciado o viudo
education (categórica) -‘basic.4y’, ‘basic.6y’, ‘basic.9y’, ‘high.school’, ‘illiterate’, ‘professional.course’, ‘university.degree’, ‘unknown’-
default: ¿Tiene crédito en mora? (categórica) -‘no’, ‘yes’, ‘unknown’-
balance: saldo medio anual, en euros (numérico)
housing: ¿Tiene préstamo para vivienda? (categórica) -‘no’, ‘yes’, ‘unknown’-
loan: ¿Tiene préstamo personal? (categórica) -‘no’, ‘yes’, ‘unknown’-
Relacionado con el último contacto de la campaña actual
contact: tipo de comunicación (categórica) -‘cellular’, ‘telephone’-
month: último mes de contacto (categórica) -‘jan’, ‘feb’, ‘mar’, …, ‘nov’, ‘dec’-
day: último día de contacto de la semana (categórico) -‘mon’, ‘tue’, ‘wed’, ‘thu’, ‘fri’-
duration: duración del último contacto, en segundos (numérico)
Otros atributos
campaign: número de contactos realizados durante esta campaña y para este cliente (numérico)
pdays: número de días que pasaron después de que el cliente fue contactado por última vez desde una campaña anterior (numeric; 999 means client was not previously contacted)
previous: número de contactos realizados antes de esta campaña y para este cliente (numérico)
poutcome: resultado de la campaña de marketing anterior (categorical) -‘failure’, ‘nonexistent’, ‘success’- _nota: por comodidad vamos a considerar que ‘nonexistent’ es lo mismo que ‘failure’
Variable de salida (objetivo deseado):
- y: ¿el cliente ha suscrito un depósito a plazo? (binario: ‘sí’, ‘no’)
Las variables “previous” y “poutcome” representan información histórica que junto con la información de la campaña actual “campaign” & “y” usaremos para medir la cantidad de contactos hasta la suscripción de un depósito a plazos.
Para empezar a trabajar realizamos algunas modificaciones a nuestro dataset
# "y" & "poutcome" son variables binarias, es decir, se realizo (si, success) o no se
# realizo (no, failure) el depósito a plazos, vamos a convertirlas en 1's y 0's
banco <- banco %>% mutate(y = if_else(y == "si", 1, 0)) %>%
mutate(poutcome = if_else(poutcome == "success", 1, 0))
# Queremos ver de manera total si el cliente suscribio un depósito a plazos en el
# pasado o presente, vamos a sumar estás variables. Como solo nos interesa si
# existio el depósito o no, vamos restringir a y_total a ser binaria
banco <- banco %>% mutate(y_total = poutcome + y) %>%
mutate(y_total = if_else(y_total == 0, 0, 1))
# Ahora vamos a sumar "campaign" y "previous" para obtener el número total de contactos
# que se han hecho a cada cliente
banco <- banco %>% mutate(global = campaign + previous)
# Como estamos trabajando con información histórica las variables que hacen referencia
# a la campaña acutal ya no son de utilidad para nosotros así que las vamos a retirar
banco2 <- banco %>% select(-c(pdays,duration, contact, day, month))
banco2 <- banco2 %>% select(-c(campaign, previous, poutcome, y))
head(banco2) %>% kbl(align = c(rep('c', times = 10))) %>%
kable_paper() %>% scroll_box(width = "100%", height = "300px")| age | job | marital | education | default | balance | housing | loan | y_total | global |
|---|---|---|---|---|---|---|---|---|---|
| 58 | management | married | tertiary | no | 2143 | yes | no | 0 | 1 |
| 44 | technician | single | secondary | no | 29 | yes | no | 0 | 1 |
| 33 | entrepreneur | married | secondary | no | 2 | yes | yes | 0 | 1 |
| 47 | blue-collar | married | unknown | no | 1506 | yes | no | 0 | 1 |
| 33 | unknown | single | unknown | no | 1 | no | no | 0 | 1 |
| 35 | management | married | tertiary | no | 231 | yes | no | 0 | 1 |
Nosotros queremos estudiar si la cantidad de llamadas hechas a un cliente influye en las suscripción del depósito.
Antes de continuar, veamos cuantas llamadas se hicieron en promedio a cada cliente
prom_llamada <- mean(banco2$global)
paste("Se hicieron en promedio", prom_llamada, "llamadas por cliente")[1] "Se hicieron en promedio 3.34416403087744 llamadas por cliente"Vamos a revisar si tenemos outliners sobre el número de llamadas echas a cada cliente
Los valores atípicos (outliers en inglés) son aquellos puntos que están mas allá del límite inferior o superior
Podemos ver que tenemos un valor que se aleja demasiado de la distribución principal, por lo tanto vamos a retirar ese valor para tener un mejor ajuste en nuestros modelos
Algunas gráficas
suscribio <- banco3 %>% select(y_total) %>% mutate(y_total = if_else(y_total == 1, "si", "no"))
tabla <- as_tibble(table(suscribio)) %>% rename("Conteo" = n) %>%
mutate(Porcentaje = (Conteo/sum(Conteo))*100)
tabla %>% kbl() %>%
kable_styling(bootstrap_options = "striped", full_width = F)| suscribio | Conteo | Porcentaje |
|---|---|---|
| no | 43699 | 96.657819 |
| si | 1511 | 3.342181 |
ggplot(tabla, aes(x="",y = Porcentaje, fill = suscribio)) +
geom_bar(stat = "identity", color = "white") +
geom_text(aes(label = percent(Porcentaje/100)),
position = position_stack(vjust = 0.5),color = "white",size = 6)+
coord_polar(theta = "y") +
scale_fill_manual(values=c("#57C164","steelblue")) +
theme_void() +
labs(title = "Proporción de personas que suscribieron un déposito a plazo")
Como podemos observar la mayor parte de la población estudiada decidió no suscribir un deposito a plazo, más específicamente el 96.6578% por lo que no desean adquirir un instrumento que además de ahorrar les permita ganar un poco de dinero.
banco4 <- banco3 %>% mutate(y_total = if_else(y_total == 1, "si", "no"))
# Comparar loan (préstamo)
g1 <- ggplot(data = banco4, aes(x = y_total, fill = loan)) + ylab("Clientes") +
geom_bar(position = "dodge") + xlab(label = "Depósito a plazo") +
scale_fill_manual(values = c('#1AB554','#1AA2B5')) +
theme(plot.title = element_text(size = 11)) +
labs(title = "Tienen un depósito a plazo y \n un préstamo personal")
# Comparar housing(préstamo de vivienda)
g2 <- ggplot(data = banco4, aes(x = y_total, fill = housing)) + ylab("Clientes") +
geom_bar(position = "dodge") + xlab(label = "Depósito a plazo") +
labs(title = "Tienen un depósito a plazo y \n un préstamo para vivienda") +
scale_fill_manual(values = c('#1AB554','#1AA2B5')) +
theme(plot.title = element_text(size = 11))
# Comparar la ocupación
g3 <- ggplot(data = banco4, aes(x = y_total, fill = job)) + ylab("Clientes") +
geom_bar(position = "dodge") + xlab(label = "Depósito a plazo") +
labs(title = "Tienen un depósito a plazo y \n en que trabajan") +
theme(plot.title = element_text(size = 11))
# Comparar el estado civil
g4 <- ggplot(data = banco4, aes(x = y_total, fill = marital)) + ylab("Clientes") +
geom_bar(position = "dodge") + xlab(label = "Depósito a plazo") +
labs(title = "Tienen un depósito a plazo y \n su estado civil") +
scale_fill_manual(values = c('#1AB522','#1AB570', '#1AADB5')) +
theme(plot.title = element_text(size = 11))
# Comparar el nivel educativo
g5 <- ggplot(data = banco4, aes(x = y_total, fill = education)) + ylab("Clientes") +
geom_bar(position = "dodge") + xlab(label = "Depósito a plazo") +
labs(title = "Tienen un depósito a plazo y \n su nivel educativo") +
theme(plot.title = element_text(size = 11))
# Comparar la morosidad
g6 <- ggplot(data = banco4, aes(x = y_total, fill = default)) + ylab("Clientes") +
geom_bar(position = "dodge") + xlab(label = "Depósito a plazo") +
labs(title = "Tienen un depósito a plazo y \n su morosidad") +
theme(plot.title = element_text(size = 11)) 
Grafica izquierda: En su mayoría, las personas no cuentan con un depósito a plazo ni un préstamo personal. La diferencia es muy notable al comparar con las personas que cuentan con ambos prestamos
Gráfica derecha: De los clientes que cuentan con un depósito a plazo menos de la mitad tienen un crédito hipotecario. Sin embargo, la cantidad de personas que tienen un crédito hipotecario y que no tienen un instrumento de ahorro superan por mucho al primer grupo
Gráfica izquierda: Es difícil dar una interpretación acerca de esta gráfica, ya que el tipo de empleo que tienen no da una buena referencia de porque si o porque no las personas suscriben un depósito a plazos. Lo que si podemos ver es que las cantidades de empleados que no tienen un depósito a plazo es muy grande a comparación de los que si lo tienen, lo cual es muy coherente con los análisis anteriores.
Gráfica derecha: Un contraste muy interesante para este gráfico es el de los clientes que están casados pues son los que tienen el número más grande de los que no cuentan con un depósito a plazo y así mismo los que tienen el número más grande de los que si cuentan con un depósito a plazo.
Gráfica derecha: a pesar de tener diferentes grados de estudio la mayoría de las personas no cuentan con un depósito a plazos y de los que sí cuentan con uno podemos notar hay una notoria diferencia (más de la mitad ) entre los que tienen un nivel educativo de “secundary” y “tertiary” con los que son de “primary”.
Estimación no-paramétrica de la función de supervivencia
Estimador de Kaplan-Meier
Por nivel educativo
#Estimación Kaplan Meier
banco3edu_km <- survfit(banco3.surv ~ education, data = banco3, type = "kaplan-meier")
ggsurvplot(banco3edu_km, size = 0.5, #Tamaño de la línea
linetype = "strata", #Tipo de línea por grupos
#break.time.by = 5000, #Intervalos de tiempo
palette = c("#984646", "#5A9846", "#469893", "#98467A"), #Paleta de colores
conf.int = TRUE, #Intervalo de confianza
title = "Curvas de Supervivencia",
xlab = "Tiempo (No. de contactos)",
ylab = "Probabilidad de supervivencia",
legend.title = "Estimador K-M",
legend.labs = c("primary", "secondary", "tertiary", "unknown")
)
Por ocupación
banco3job_km <- survfit(banco3.surv ~ job, data = banco3, type = "kaplan-meier") #Estimación Kaplan Meier
ggsurvplot(banco3job_km, size = 0.5, #Tamaño de la línea
linetype = "strata", #Tipo de línea por grupos
#break.time.by = 5000, #Intervalos de tiempo
#palette = c("#984646", "#5A9846", "#469893", "#98467A"), #Paleta de colores
conf.int = TRUE, #Intervalo de confianza
title = "Curvas de Supervivencia",
xlab = "Tiempo (No. de contactos)",
ylab = "Probabilidad de supervivencia",
legend.title = "Estimador K-M",
legend.labs = c("admin.", "blue-collar", "entrepreneur",
"housemaid", "management", "retired",
"self-employed", "services", "student",
"technician", "unemployed", "unknown")
)
Por estado civil
banco3mar_km <- survfit(banco3.surv ~ marital, data = banco3, type = "kaplan-meier") #Estimación Kaplan Meier
ggsurvplot(banco3mar_km, size = 0.5, #Tamaño de la línea
linetype = "strata", #Tipo de línea por grupos
#break.time.by = 5000, #Intervalos de tiempo
palette = c("#984646", "#5A9846", "#469893"), #Paleta de colores
conf.int = TRUE, #Intervalo de confianza
title = "Curvas de Supervivencia",
xlab = "Tiempo (No. de contactos)",
ylab = "Probabilidad de supervivencia",
legend.title = "Estimador K-M",
legend.labs = c("divorced", "married", "single")
)
Algunas estimaciones importantes
Estimadores de la Función de Riesgo Acumulada
Por nivel educativo
banco3edu_ra <- banco3edu_km %>% fortify %>% group_by(strata) %>%
mutate(CumHaz = cumsum(n.event/n.risk))
ggsurvplot(banco3edu_km, fun = "cumhaz",
xlab = "Tiempo (No. de contactos)",
censor = T,
palette = c("#984646", "#5A9846", "#469893", "#98467A"),
ylab = "Riesgo Acumulado",
title = "Riesgo Acumulado",
legend.title = "Nivel educativo",
legend.labs = c("primary", "secondary", "tertiary", "unknown")
)
Por ocupación
banco3job_ra <- banco3job_km %>% fortify %>% group_by(strata) %>%
mutate(CumHaz = cumsum(n.event/n.risk))
ggsurvplot(banco3job_km, fun = "cumhaz",
xlab = "Tiempo (No. de contactos)",
censor = T,
ylab = "Riesgo Acumulado",
title = "Riesgo Acumulado",
legend.title = "Ocupación",
legend.labs = c("admin.", "blue-collar", "entrepreneur",
"housemaid", "management", "retired",
"self-employed", "services", "student",
"technician", "unemployed", "unknown")
)
Por estado civil
banco3mar_ra <- banco3mar_km %>% fortify %>% group_by(strata) %>%
mutate(CumHaz = cumsum(n.event/n.risk))
ggsurvplot(banco3mar_km, fun = "cumhaz",
xlab = "Tiempo (No. de contactos)",
censor = T,
palette = c("#984646", "#5A9846", "#469893"),
ylab = "Riesgo Acumulado",
title = "Riesgo Acumulado",
legend.title = "Estado civil",
legend.labs = c("divorced", "married", "single")
)
Estimación de la media, mediana y percentiles de los tiempos de supervivencia.
Por nivel educativo
Call: survfit(formula = banco3.surv ~ education, data = banco3, type = "kaplan-meier")
n events *rmean *se(rmean) median 0.95LCL 0.95UCL
education=primary 6851 133 52.3 0.910 NA NA NA
education=secondary 23202 675 49.3 0.596 NA NA NA
education=tertiary 13300 622 45.1 0.963 NA NA NA
education=unknown 1857 81 46.3 1.900 NA NA NA
* restricted mean with upper limit = 59 Por ocupación
Call: survfit(formula = banco3.surv ~ job, data = banco3, type = "kaplan-meier")
n events *rmean *se(rmean) median 0.95LCL 0.95UCL
job=admin. 5171 204 30.1 0.615 NA NA NA
job=blue-collar 9732 148 34.4 0.317 NA NA NA
job=entrepreneur 1487 22 33.9 0.988 NA NA NA
job=housemaid 1240 29 32.4 1.069 NA NA NA
job=management 9457 387 29.6 0.519 NA NA NA
job=retired 2264 174 21.9 1.563 20 12 NA
job=self-employed 1579 55 31.8 1.009 NA NA NA
job=services 4154 85 33.8 0.445 NA NA NA
job=student 938 87 21.4 2.055 24 12 NA
job=technician 7597 245 31.6 0.467 NA NA NA
job=unemployed 1303 64 24.6 2.005 NA 15 NA
job=unknown 288 11 33.0 1.214 NA NA NA
* restricted mean with upper limit = 37 Por estado civil
Call: survfit(formula = banco3.surv ~ marital, data = banco3, type = "kaplan-meier")
n events *rmean *se(rmean) median 0.95LCL 0.95UCL
marital=divorced 5207 152 49.8 1.124 NA NA NA
marital=married 27213 836 48.0 0.502 NA NA NA
marital=single 12790 523 45.4 1.017 NA NA NA
* restricted mean with upper limit = 58 Prueba de igualdad de poblaciones
Por nivel educativo
Call:
survdiff(formula = banco3.surv ~ education, data = banco3, rho = 0)
N Observed Expected (O-E)^2/E (O-E)^2/V
education=primary 6851 133 226.0 38.24 45.71
education=secondary 23202 675 754.3 8.34 16.93
education=tertiary 13300 622 470.4 48.87 72.14
education=unknown 1857 81 60.3 7.07 7.48
Chisq= 104 on 3 degrees of freedom, p= <2e-16 Por ocupación
Call:
survdiff(formula = banco3.surv ~ job, data = banco3, rho = 0)
N Observed Expected (O-E)^2/E (O-E)^2/V
job=admin. 5171 204 166.3 8.53e+00 9.75e+00
job=blue-collar 9732 148 318.4 9.12e+01 1.17e+02
job=entrepreneur 1487 22 49.3 1.51e+01 1.59e+01
job=housemaid 1240 29 39.6 2.82e+00 2.95e+00
job=management 9457 387 339.1 6.77e+00 8.88e+00
job=retired 2264 174 65.6 1.79e+02 1.90e+02
job=self-employed 1579 55 55.0 4.16e-05 4.39e-05
job=services 4154 85 132.4 1.70e+01 1.89e+01
job=student 938 87 30.6 1.04e+02 1.08e+02
job=technician 7597 245 268.6 2.07e+00 2.55e+00
job=unemployed 1303 64 35.1 2.38e+01 2.48e+01
job=unknown 288 11 11.1 8.35e-04 8.56e-04
Chisq= 458 on 11 degrees of freedom, p= <2e-16 Por estado civil
Call:
survdiff(formula = banco3.surv ~ marital, data = banco3, rho = 0)
N Observed Expected (O-E)^2/E (O-E)^2/V
marital=divorced 5207 152 163 0.698 0.796
marital=married 27213 836 933 10.009 26.581
marital=single 12790 523 416 27.680 38.827
Chisq= 39 on 2 degrees of freedom, p= 3e-09 Modelo de riesgos proporcionales de Cox
Modelo ocupación - edad
Call:
coxph(formula = banco3.surv ~ job + age, data = banco3)
n= 45210, number of events= 1511
coef exp(coef) se(coef) z Pr(>|z|)
jobblue-collar -0.984321 0.373693 0.108006 -9.114 < 2e-16 ***
jobentrepreneur -1.041118 0.353060 0.224512 -4.637 3.53e-06 ***
jobhousemaid -0.582462 0.558522 0.199418 -2.921 0.003491 **
jobmanagement -0.079730 0.923366 0.086551 -0.921 0.356949
jobretired 0.569458 1.767310 0.120872 4.711 2.46e-06 ***
jobself-employed -0.215083 0.806475 0.151968 -1.415 0.156977
jobservices -0.645756 0.524266 0.129118 -5.001 5.69e-07 ***
jobstudent 0.979671 2.663581 0.133269 7.351 1.97e-13 ***
jobtechnician -0.291170 0.747388 0.094810 -3.071 0.002133 **
jobunemployed 0.397133 1.487554 0.143329 2.771 0.005592 **
jobunknown -0.287879 0.749853 0.310282 -0.928 0.353513
age 0.009581 1.009627 0.002777 3.450 0.000561 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
exp(coef) exp(-coef) lower .95 upper .95
jobblue-collar 0.3737 2.6760 0.3024 0.4618
jobentrepreneur 0.3531 2.8324 0.2274 0.5482
jobhousemaid 0.5585 1.7904 0.3778 0.8256
jobmanagement 0.9234 1.0830 0.7793 1.0941
jobretired 1.7673 0.5658 1.3945 2.2397
jobself-employed 0.8065 1.2400 0.5987 1.0863
jobservices 0.5243 1.9074 0.4070 0.6752
jobstudent 2.6636 0.3754 2.0513 3.4586
jobtechnician 0.7474 1.3380 0.6206 0.9000
jobunemployed 1.4876 0.6722 1.1232 1.9700
jobunknown 0.7499 1.3336 0.4082 1.3775
age 1.0096 0.9905 1.0041 1.0151
Concordance= 0.622 (se = 0.009 )
Likelihood ratio test= 402.6 on 12 df, p=<2e-16
Wald test = 418.2 on 12 df, p=<2e-16
Score (logrank) test = 473.7 on 12 df, p=<2e-16
Comparación de modelos
Analysis of Deviance Table
Cox model: response is banco3.surv
Model 1: ~ job + age
Model 2: ~ job
loglik Chisq Df P(>|Chi|)
1 -13832
2 -13838 11.739 1 0.0006122 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Comparación Modelo de Cox - Estimador Kaplan-Meier
plot(survfit(modelo1), conf.int = FALSE,
main = "Comparación del ajuste del modelo de Cox \n con el estimador de KM",
xlab = "Meses", ylab = "Supervivencia", col = "green")
lines(banco3job_km,lty = 2)
legend(70,0.9,legend = c("Ajuste por Cox", "Estiamdor de KM"), lty = c(1,2)) 
Modelo educación - ocupación
Call:
coxph(formula = banco3.surv ~ education + job, data = banco3)
n= 45210, number of events= 1511
coef exp(coef) se(coef) z Pr(>|z|)
educationsecondary 0.39353 1.48220 0.10150 3.877 0.000106 ***
educationtertiary 0.82247 2.27612 0.11105 7.406 1.30e-13 ***
educationunknown 0.69046 1.99463 0.14604 4.728 2.27e-06 ***
jobblue-collar -0.81024 0.44475 0.11166 -7.256 3.97e-13 ***
jobentrepreneur -1.15578 0.31481 0.22643 -5.104 3.32e-07 ***
jobhousemaid -0.38845 0.67811 0.20173 -1.926 0.054156 .
jobmanagement -0.39135 0.67614 0.10021 -3.905 9.41e-05 ***
jobretired 0.85536 2.35222 0.10648 8.033 9.48e-16 ***
jobself-employed -0.37249 0.68902 0.15541 -2.397 0.016540 *
jobservices -0.61017 0.54326 0.12925 -4.721 2.35e-06 ***
jobstudent 0.75673 2.13129 0.13015 5.814 6.08e-09 ***
jobtechnician -0.38860 0.67800 0.09594 -4.051 5.11e-05 ***
jobunemployed 0.37325 1.45244 0.14428 2.587 0.009681 **
jobunknown -0.31617 0.72894 0.31416 -1.006 0.314231
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
exp(coef) exp(-coef) lower .95 upper .95
educationsecondary 1.4822 0.6747 1.2148 1.8084
educationtertiary 2.2761 0.4393 1.8309 2.8296
educationunknown 1.9946 0.5013 1.4981 2.6557
jobblue-collar 0.4448 2.2484 0.3573 0.5536
jobentrepreneur 0.3148 3.1765 0.2020 0.4907
jobhousemaid 0.6781 1.4747 0.4567 1.0070
jobmanagement 0.6761 1.4790 0.5556 0.8229
jobretired 2.3522 0.4251 1.9092 2.8981
jobself-employed 0.6890 1.4513 0.5081 0.9344
jobservices 0.5433 1.8407 0.4217 0.6999
jobstudent 2.1313 0.4692 1.6514 2.7506
jobtechnician 0.6780 1.4749 0.5618 0.8183
jobunemployed 1.4524 0.6885 1.0947 1.9271
jobunknown 0.7289 1.3719 0.3938 1.3493
Concordance= 0.646 (se = 0.008 )
Likelihood ratio test= 460.1 on 14 df, p=<2e-16
Wald test = 480.8 on 14 df, p=<2e-16
Score (logrank) test = 535.4 on 14 df, p=<2e-16
Comparación de modelos
Analysis of Deviance Table
Cox model: response is banco3.surv
Model 1: ~ education + job
Model 2: ~ education
loglik Chisq Df P(>|Chi|)
1 -13803
2 -13980 354.16 11 < 2.2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Comparación Modelo de Cox - Estimador Kaplan-Meier
plot(survfit(modelo2), conf.int = FALSE,
main = "Comparación del ajuste del modelo de Cox \n con el estimador de KM",
xlab = "Meses", ylab = "Supervivencia", col = "green")
lines(banco3edu_km,lty = 2)
legend(70,0.9,legend = c("Ajuste por Cox", "Estiamdor de KM"), lty = c(1,2)) 
