PC1 SOBREVIVENCIA
UNTIVEROS CRUZADO ALONSO
2025-10-22
CASO
CASO: Duración del desempleo Piqueras Gómez, Rodríguez Morejón y Rueda Sabater (2008) desarrollaron una investigación publicada en la Revista de Psicología del Trabajo y de las Organizaciones bajo el título “Expectativas y duración del desempleo”. En este estudio se analizó la relación entre las expectativas de control percibido y el tiempo que una persona tarda en conseguir empleo, aplicando el método estadístico del análisis de supervivencia. El propósito del trabajo fue comprender cómo ciertas variables psicológicas influyen en la duración del desempleo, se consideraron en el estudio factores demográficos como la edad, el sexo y la Escala de Expectativas de Control Percibido en Búsqueda de Empleo, que evalúa componentes cognitivos y motivacionales vinculados a la conducta de búsqueda de trabajo. En el estudio participaron personas desempleadas mayores de edad, a quienes se les realizó un seguimiento durante un periodo de aproximadamente 4 años registrando el momento en que lograban insertarse laboralmente o, en su defecto, el final del periodo de observación si no lo habían conseguido. Los datos que se muestran en el archivo “datos_pc1.csv” están organizados de la siguiente manera: • tiempo_dias: número de días • evento: 1 si la persona consiguió empleo y 0 si no lo hizo, • sexo: participante es hombre o mujer, • edad: distingue entre menores y mayores de 30 años, • EXBE50: nivel de expectativas de éxito. (alto, bajo)
Datos
library(dplyr)##
## Adjuntando el paquete: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(ggplot2)
library(survminer)## Cargando paquete requerido: ggpubrlibrary(readr)
library(timereg) ## Cargando paquete requerido: survival##
## Adjuntando el paquete: 'survival'## The following object is masked from 'package:survminer':
##
## myelomalibrary(survival)
datos <- read_csv("C:/Users/Alumno10/Downloads/datos_pc1.csv")## New names:
## • `` -> `...1`## Rows: 300 Columns: 7
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): sexo, edad30, EXBE50
## dbl (4): ...1, id, tiempo_dias, evento
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.n <- nrow(datos)
y <- seq_len(n)
t_ <- datos$tiempo_dias
ev <- datos$evento == 1
head(datos)## # A tibble: 6 × 7
## ...1 id tiempo_dias evento sexo edad30 EXBE50
## <dbl> <dbl> <dbl> <dbl> <chr> <chr> <chr>
## 1 1 1 581 1 Hombre <30 bajo
## 2 2 2 1125 1 Mujer <30 bajo
## 3 3 3 394 1 Mujer <30 bajo
## 4 4 4 637 1 Mujer <30 alto
## 5 5 5 1001 0 Hombre <30 alto
## 6 6 6 1239 0 Mujer >=30 alto- ¿Cuántos participantes fueron censurados debido a la pérdida de seguimiento en el estudio?. (1 pt.)
censura_perdida <- datos %>%
filter(evento == 0,tiempo_dias==1416) %>%
nrow()
cat("Censuras por pérdida de seguimiento:", censura_perdida, "\n")## Censuras por pérdida de seguimiento: 1- ¿Cuántos participantes fueron censurados debido a temas administrativos? (1 pt.)
censura_admin <- datos %>%
filter(evento == 0,tiempo_dias<1416) %>%
nrow()
cat("Censuras administrativas:", censura_admin, "\n")## Censuras administrativas: 141- Construye e interpreta el gráfico de dispersión de censura falla en el tiempo. (2 pts)
datos <- datos %>%
mutate(sqrt_id = sqrt(seq_along(tiempo_dias)))
ggplot(datos, aes(x = sqrt_id, y = tiempo_dias)) +
geom_point(aes(shape = factor(evento)), size = 2.5, color = "black") +
scale_shape_manual(values = c("0" = 1, "1" = 16),
labels = c("0" = "Censura", "1" = "Evento"),
name = "Estado") +
labs(x = "Raíz cuadrada del conteo", y = "Tiempo (dias)") +
theme_minimal()
En la grafica podemos observar que el evento de interes se da al inicio
del estudio y al pasar el tiempo ( a partir de dia 700) se va censurando
en gran escala como muestra la dispersion
- Construye la distribución del tiempo de falla considerando intervalos de 100 días. Interpreta el resultado en el intervalo de 200 a 300 días. (2 pts)
fallas <- subset(datos, evento == 1)
ggplot(fallas, aes(x = tiempo_dias)) +
geom_histogram(binwidth = 100, boundary = 0,
color = "black", fill = "red") +
stat_bin(binwidth = 100, boundary = 0,
geom = "text",
aes(label = after_stat(count), y = after_stat(count)),
vjust = -0.3, size = 3.5) +
scale_x_continuous(expand = c(0, 0)) +
labs(x = "Tiempo (días)", y = "Frecuencia",
title = "Distribución del tiempo de falla") +
theme_minimal()
probabilidad condicional
18/(18+17+10+12+12+13+13+12+6+5+0+1)## [1] 0.1512605El grafico en el intervalo [200;300> nos indica 18 fallas en los 100 dias que presenta el intervalo con una probabilidad condicional de 0.1512
- Construye la tabla de vida actuarial considerando intervalos a 100 días, e interpreta lo siguiente: d5, w3, qhat2, Shat3, Shat8 (4 pts)
brks <- seq(0,2000,100)
evt_fac <- cut(datos$tiempo_dias[datos$evento==1], breaks = brks,
right = FALSE, include.lowest = TRUE)
cens_fac <- cut(datos$tiempo_dias[datos$evento==0], breaks = brks,
right = FALSE, include.lowest = TRUE)
K <- length(brks) - 1
di <- tabulate(evt_fac, nbins = K)
wi <- tabulate(cens_fac, nbins = K)
N <- nrow(datos)
ni <- N - c(0, head(cumsum(di + wi), -1))
ni_p <- ni - wi/2
qhat <- ifelse(ni_p>0, di/ni_p, 0)
phat <- 1 - qhat
Shat <- cumprod(phat)
life_tab <- data.frame(
intervalo = paste0("[", brks[-length(brks)], ",", brks[-1], ")"),
di, wi, ni, ni_p,
qhat = round(qhat,3),
phat = round(phat,3),
Shat = round(Shat,3)
)
life_tab## intervalo di wi ni ni_p qhat phat Shat
## 1 [0,100) 20 0 300 300.0 0.067 0.933 0.933
## 2 [100,200) 18 0 280 280.0 0.064 0.936 0.873
## 3 [200,300) 18 0 262 262.0 0.069 0.931 0.813
## 4 [300,400) 17 0 244 244.0 0.070 0.930 0.757
## 5 [400,500) 10 0 227 227.0 0.044 0.956 0.723
## 6 [500,600) 12 0 217 217.0 0.055 0.945 0.683
## 7 [600,700) 12 0 205 205.0 0.059 0.941 0.643
## 8 [700,800) 13 0 193 193.0 0.067 0.933 0.600
## 9 [800,900) 13 0 180 180.0 0.072 0.928 0.557
## 10 [900,1000) 12 32 167 151.0 0.079 0.921 0.512
## 11 [1000,1100) 6 26 123 110.0 0.055 0.945 0.484
## 12 [1100,1200) 5 29 91 76.5 0.065 0.935 0.453
## 13 [1200,1300) 0 36 57 39.0 0.000 1.000 0.453
## 14 [1300,1400) 1 17 21 12.5 0.080 0.920 0.417
## 15 [1400,1500) 0 3 3 1.5 0.000 1.000 0.417
## 16 [1500,1600) 0 0 0 0.0 0.000 1.000 0.417
## 17 [1600,1700) 0 0 0 0.0 0.000 1.000 0.417
## 18 [1700,1800) 0 0 0 0.0 0.000 1.000 0.417
## 19 [1800,1900) 0 0 0 0.0 0.000 1.000 0.417
## 20 [1900,2000) 0 0 0 0.0 0.000 1.000 0.417El valor d5=10 indica que en el quinto intervalo [400,500) ocurrieron 10 fallas, es decir, 10 individuos experimentaron el evento de interés en ese rango de tiempo en dias.
El valor w3=0 señala que en el tercer intervalo [200,300) no hubo individuos censurados, por lo que todos los que entraron al intervalo estuvieron en riesgo durante todo el periodo.
qhat2=0.064 expresa la probabilidad estimada de falla en el segundo intervalo [100,200)
Shat3=0.813 refleja la probabilidad acumulada de sobrevivir hasta el final del tercer intervalo [200,300)
Shat8 =0.600 refleja la probabilidad acumulada de sobrevivir hasta el final del octavo intervalo [700,800)
- El estudio partió de la hipótesis de que las personas con mayor sensación de expectativas de éxito tienden a encontrar trabajo más rápido, mientras que quienes perciben menor control sobre su situación permanecen más tiempo desempleados.
- Construye e interpreta la curva de sobrevivencia de Kaplan Meier. (1 pts)
- Compara e interpreta las medianas de supervivencia en ambos grupos. (2 pt)
- Prueba si las curvas de supervivencia son iguales usando un nivel de significancia de 5% (2 pt)
ekm1<-survfit(Surv(datos$tiempo_dias,datos$evento)~datos$EXBE50)
summary(ekm1)$table## records n.max n.start events rmean se(rmean) median
## datos$EXBE50=alto 148 148 148 71 957.8504 44.23557 NA
## datos$EXBE50=bajo 152 152 152 86 910.2611 41.06377 968
## 0.95LCL 0.95UCL
## datos$EXBE50=alto 927 NA
## datos$EXBE50=bajo 810 1319tiempos_interes <- c(0,100,200,300,400,500,600,700,800,900,1000,1100,1200,1300,1400,1500)
sum_times <- summary(ekm1, times = tiempos_interes)
km_tab_puntos <- tibble(
time = sum_times$time,
n_risk = sum_times$n.risk,
n_event= sum_times$n.event,
surv = sum_times$surv,
lower = sum_times$lower,
upper = sum_times$upper
)
km_tab_puntos## # A tibble: 30 × 6
## time n_risk n_event surv lower upper
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 148 0 1 1 1
## 2 100 136 12 0.919 0.876 0.964
## 3 200 126 10 0.851 0.796 0.911
## 4 300 118 8 0.797 0.735 0.865
## 5 400 111 7 0.75 0.683 0.823
## 6 500 108 3 0.730 0.662 0.805
## 7 600 102 6 0.689 0.619 0.768
## 8 700 98 4 0.662 0.590 0.743
## 9 800 92 6 0.622 0.548 0.705
## 10 900 86 6 0.581 0.507 0.666
## # ℹ 20 more rowslibrary(survminer)
p_km <- ggsurvplot(
ekm1,
data = datos,
conf.int = TRUE, # IC (Greenwood)
censor = TRUE,
# tabla de en riesgo
risk.table.height = 3,
break.time.by = 1000,
ylim = c(0,1),
xlim = c(0,1000),
xlab = "Tiempo (dias)",
ylab = "S(t)",
surv.median.line = "hv", # traza mediana en el gráfico si existe
ggtheme = theme_minimal(base_size = 12)
)## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## ℹ The deprecated feature was likely used in the ggpubr package.
## Please report the issue at <https://github.com/kassambara/ggpubr/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.p_km
- ESTAS CURVAS NO SON SIGNIFICATIVAS, SON IGUALES
La diferencia en las curvas podría ser estadísticamente significativa
las medianas se dieron de la misma manera esto indica que hay la misma probabilidad de que el estudio ocurra o no ocurra
Un nivel de expectativas de éxito bajo podría asociarse con menos componentes cognitivos y motivacionales vinculados a la conducta de búsqueda de trabajo.
Un nivel de expectativas de éxito alto podría relacionarse con expectativas de Control Percibido en Búsqueda de Empleo alto, que evalúa componentes cognitivos y motivacionales vinculados a la conducta de búsqueda de trabajo.
#Ho : So(t)= … = Sy(t) #H1 : al menos un Si(t) es diferente
logrank <- survdiff(Surv(tiempo_dias, evento) ~ EXBE50, data = datos, rho = 0)
logrank## Call:
## survdiff(formula = Surv(tiempo_dias, evento) ~ EXBE50, data = datos,
## rho = 0)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## EXBE50=alto 148 71 77.9 0.614 1.22
## EXBE50=bajo 152 86 79.1 0.605 1.22
##
## Chisq= 1.2 on 1 degrees of freedom, p= 0.3alfa <- 0.05
X2 <- 1.2
df <- 1
Xcritico <- qchisq(0.95, df)
pvalor <- pchisq(1.2 , df, lower.tail = FALSE)
cat("Estadístico crítico:", Xcritico, "\n")## Estadístico crítico: 3.841459cat("p-valor:", pvalor, "\n")## p-valor: 0.2733217#Ho : So(t)= … = Sy(t) #H1 : al menos un Si(t) es diferente alfa= 0.05 p_valor= 0.2733217
p_valor > alfa entonces NRHO
con un alfa= 0.05, tenemos suficiente evidencia estadistica para afirmar que las curvas de supervivencia son iguales.
- Construye e interpreta el Riesgo Acumulado de Nelson - Aalen para los grupos de edad. (2pts)
fit_na <- survfit(
coxph(Surv(tiempo_dias, evento) ~ EXBE50, data = datos),
type = "aalen"
)
summary(fit_na)## Call: survfit(formula = coxph(Surv(tiempo_dias, evento) ~ EXBE50, data = datos),
## type = "aalen")
##
## time n.risk n.event survival std.err lower 95% CI upper 95% CI
## 12 300 1 0.997 0.00304 0.991 1.000
## 18 299 1 0.994 0.00431 0.986 1.000
## 22 298 1 0.991 0.00529 0.981 1.000
## 23 297 2 0.985 0.00686 0.971 0.998
## 28 295 1 0.982 0.00753 0.967 0.997
## 31 294 1 0.979 0.00815 0.963 0.995
## 33 293 1 0.976 0.00873 0.959 0.993
## 35 292 1 0.973 0.00929 0.955 0.991
## 43 291 1 0.970 0.00981 0.951 0.989
## 50 290 1 0.967 0.01031 0.947 0.987
## 54 289 1 0.964 0.01079 0.943 0.985
## 56 288 1 0.961 0.01126 0.939 0.983
## 61 287 1 0.957 0.01171 0.935 0.981
## 69 286 1 0.954 0.01215 0.931 0.979
## 72 285 1 0.951 0.01257 0.927 0.976
## 75 284 1 0.948 0.01298 0.923 0.974
## 91 283 1 0.945 0.01339 0.919 0.972
## 95 282 1 0.942 0.01378 0.916 0.970
## 97 281 1 0.939 0.01417 0.912 0.967
## 104 280 2 0.933 0.01491 0.904 0.963
## 115 278 1 0.930 0.01528 0.901 0.961
## 116 277 1 0.927 0.01564 0.897 0.958
## 118 276 1 0.924 0.01599 0.893 0.956
## 119 275 1 0.921 0.01633 0.889 0.954
## 129 274 1 0.918 0.01668 0.886 0.951
## 136 273 1 0.915 0.01701 0.882 0.949
## 145 272 1 0.912 0.01734 0.878 0.946
## 146 271 1 0.909 0.01767 0.875 0.944
## 149 270 3 0.900 0.01862 0.864 0.937
## 155 267 1 0.897 0.01893 0.860 0.934
## 170 266 1 0.893 0.01924 0.857 0.932
## 171 265 1 0.890 0.01954 0.853 0.930
## 187 264 1 0.887 0.01984 0.849 0.927
## 199 263 1 0.884 0.02014 0.846 0.925
## 211 262 1 0.881 0.02043 0.842 0.922
## 220 261 1 0.878 0.02073 0.838 0.920
## 230 260 2 0.872 0.02130 0.831 0.915
## 235 258 1 0.869 0.02158 0.828 0.912
## 245 257 1 0.866 0.02186 0.824 0.910
## 248 256 1 0.863 0.02214 0.821 0.907
## 253 255 1 0.860 0.02241 0.817 0.905
## 258 254 1 0.857 0.02268 0.813 0.902
## 272 253 1 0.854 0.02295 0.810 0.900
## 277 252 1 0.851 0.02322 0.806 0.897
## 279 251 3 0.841 0.02401 0.796 0.890
## 289 248 1 0.838 0.02427 0.792 0.887
## 290 247 1 0.835 0.02453 0.789 0.885
## 292 246 1 0.832 0.02478 0.785 0.882
## 293 245 1 0.829 0.02503 0.781 0.880
## 308 244 1 0.826 0.02528 0.778 0.877
## 323 243 1 0.823 0.02553 0.774 0.874
## 324 242 1 0.820 0.02578 0.771 0.872
## 331 241 1 0.817 0.02602 0.767 0.869
## 333 240 1 0.814 0.02626 0.764 0.867
## 335 239 1 0.811 0.02650 0.760 0.864
## 338 238 1 0.807 0.02674 0.757 0.862
## 354 237 1 0.804 0.02698 0.753 0.859
## 355 236 1 0.801 0.02721 0.750 0.856
## 370 235 1 0.798 0.02744 0.746 0.854
## 371 234 1 0.795 0.02767 0.743 0.851
## 379 233 1 0.792 0.02790 0.739 0.849
## 380 232 1 0.789 0.02813 0.736 0.846
## 382 231 1 0.786 0.02835 0.732 0.843
## 384 230 1 0.783 0.02857 0.729 0.841
## 394 229 1 0.780 0.02880 0.725 0.838
## 396 228 1 0.776 0.02901 0.722 0.835
## 408 227 1 0.773 0.02923 0.718 0.833
## 410 226 1 0.770 0.02945 0.715 0.830
## 413 225 1 0.767 0.02966 0.711 0.828
## 417 224 1 0.764 0.02987 0.708 0.825
## 422 223 1 0.761 0.03008 0.704 0.822
## 468 222 1 0.758 0.03029 0.701 0.820
## 472 221 1 0.755 0.03049 0.697 0.817
## 474 220 1 0.752 0.03070 0.694 0.814
## 487 219 1 0.748 0.03090 0.690 0.812
## 494 218 1 0.745 0.03110 0.687 0.809
## 504 217 1 0.742 0.03130 0.683 0.806
## 510 216 1 0.739 0.03149 0.680 0.803
## 540 215 1 0.736 0.03169 0.676 0.801
## 549 214 2 0.730 0.03207 0.669 0.795
## 551 212 1 0.727 0.03227 0.666 0.793
## 560 211 1 0.723 0.03245 0.663 0.790
## 566 210 1 0.720 0.03264 0.659 0.787
## 567 209 1 0.717 0.03283 0.656 0.785
## 569 208 2 0.711 0.03319 0.649 0.779
## 581 206 1 0.708 0.03337 0.645 0.776
## 602 205 1 0.705 0.03355 0.642 0.774
## 605 204 1 0.702 0.03373 0.638 0.771
## 607 203 1 0.698 0.03390 0.635 0.768
## 618 202 1 0.695 0.03408 0.632 0.765
## 637 201 1 0.692 0.03425 0.628 0.763
## 640 200 1 0.689 0.03442 0.625 0.760
## 646 199 1 0.686 0.03458 0.621 0.757
## 649 198 1 0.683 0.03475 0.618 0.754
## 651 197 1 0.679 0.03492 0.614 0.751
## 665 196 1 0.676 0.03508 0.611 0.749
## 678 195 1 0.673 0.03524 0.608 0.746
## 683 194 1 0.670 0.03540 0.604 0.743
## 710 193 1 0.667 0.03555 0.601 0.740
## 711 192 1 0.664 0.03571 0.597 0.737
## 718 191 1 0.661 0.03586 0.594 0.735
## 730 190 1 0.657 0.03602 0.590 0.732
## 734 189 1 0.654 0.03617 0.587 0.729
## 747 188 1 0.651 0.03632 0.584 0.726
## 750 187 1 0.648 0.03647 0.580 0.723
## 751 186 1 0.645 0.03661 0.577 0.721
## 753 185 1 0.642 0.03676 0.573 0.718
## 772 184 1 0.638 0.03690 0.570 0.715
## 773 183 1 0.635 0.03704 0.567 0.712
## 779 182 1 0.632 0.03717 0.563 0.709
## 794 181 1 0.629 0.03731 0.560 0.706
## 807 180 1 0.626 0.03744 0.556 0.703
## 810 179 1 0.622 0.03758 0.553 0.701
## 813 178 2 0.616 0.03784 0.546 0.695
## 841 176 1 0.613 0.03797 0.543 0.692
## 847 175 1 0.610 0.03809 0.539 0.689
## 853 174 1 0.606 0.03822 0.536 0.686
## 857 173 1 0.603 0.03834 0.533 0.683
## 866 172 1 0.600 0.03846 0.529 0.680
## 877 171 1 0.597 0.03858 0.526 0.678
## 881 170 1 0.594 0.03869 0.523 0.675
## 893 169 1 0.590 0.03881 0.519 0.672
## 896 168 1 0.587 0.03892 0.516 0.669
## 919 160 1 0.584 0.03904 0.512 0.666
## 927 157 1 0.581 0.03916 0.509 0.663
## 936 153 1 0.577 0.03928 0.505 0.659
## 937 152 1 0.574 0.03940 0.501 0.656
## 944 148 1 0.570 0.03953 0.498 0.653
## 947 144 2 0.563 0.03978 0.490 0.647
## 949 140 1 0.559 0.03991 0.486 0.643
## 958 135 1 0.555 0.04005 0.482 0.640
## 966 133 1 0.552 0.04019 0.478 0.636
## 968 132 1 0.548 0.04032 0.474 0.633
## 969 131 1 0.544 0.04045 0.470 0.629
## 1004 122 1 0.540 0.04061 0.466 0.626
## 1019 119 1 0.536 0.04076 0.462 0.622
## 1020 118 1 0.532 0.04090 0.457 0.618
## 1023 117 1 0.528 0.04104 0.453 0.614
## 1057 107 1 0.523 0.04121 0.448 0.610
## 1092 96 1 0.518 0.04141 0.443 0.606
## 1124 85 1 0.513 0.04167 0.437 0.601
## 1125 84 1 0.507 0.04191 0.431 0.596
## 1136 80 1 0.501 0.04217 0.425 0.591
## 1178 64 1 0.494 0.04260 0.417 0.585
## 1199 59 1 0.487 0.04306 0.409 0.579
## 1319 16 1 0.460 0.04982 0.372 0.569NA_acum <- -log(fit_na$surv)
tabla_aalen <- data.frame(
tiempo = fit_na$time,
H_Aalen = NA_acum
)
tabla_aalen## tiempo H_Aalen
## 1 12 0.003035732
## 2 18 0.006080707
## 3 22 0.009136788
## 4 23 0.015271327
## 5 28 0.018359372
## 6 31 0.021456983
## 7 33 0.024564219
## 8 35 0.027683021
## 9 43 0.030811580
## 10 50 0.033951865
## 11 54 0.037102043
## 12 56 0.040262175
## 13 61 0.043434271
## 14 69 0.046616461
## 15 72 0.049808810
## 16 75 0.053013368
## 17 91 0.056228229
## 18 95 0.059455472
## 19 97 0.062693164
## 20 104 0.069189581
## 21 115 0.072461099
## 22 116 0.075743355
## 23 118 0.079036419
## 24 119 0.082340364
## 25 129 0.085657388
## 26 136 0.088987596
## 27 145 0.092331093
## 28 146 0.095685807
## 29 149 0.105790404
## 30 155 0.109197471
## 31 170 0.112618449
## 32 171 0.116051169
## 33 187 0.119495714
## 34 199 0.122952165
## 35 211 0.126420605
## 36 220 0.129903461
## 37 230 0.136898250
## 38 235 0.140422682
## 39 245 0.143959580
## 40 248 0.147509032
## 41 253 0.151073584
## 42 258 0.154650887
## 43 272 0.158241034
## 44 277 0.161844116
## 45 279 0.172700045
## 46 289 0.176363590
## 47 290 0.180040605
## 48 292 0.183733828
## 49 293 0.187443402
## 50 308 0.191169473
## 51 323 0.194912187
## 52 324 0.198668962
## 53 331 0.202442657
## 54 333 0.206230646
## 55 335 0.210033039
## 56 338 0.213852767
## 57 354 0.217687140
## 58 355 0.221539142
## 59 370 0.225408934
## 60 371 0.229296682
## 61 379 0.233202553
## 62 380 0.237123739
## 63 382 0.241060362
## 64 384 0.245015568
## 65 394 0.248989532
## 66 396 0.252982435
## 67 408 0.256991344
## 68 410 0.261019527
## 69 413 0.265067169
## 70 417 0.269131261
## 71 422 0.273215162
## 72 468 0.277319066
## 73 472 0.281439881
## 74 474 0.285581063
## 75 487 0.289739465
## 76 494 0.293918609
## 77 504 0.298118702
## 78 510 0.302336510
## 79 540 0.306572183
## 80 549 0.315086571
## 81 551 0.319383894
## 82 560 0.323703371
## 83 566 0.328041586
## 84 567 0.332402380
## 85 569 0.341162168
## 86 581 0.345584548
## 87 602 0.350030394
## 88 605 0.354499956
## 89 607 0.358993488
## 90 618 0.363507303
## 91 637 0.368045566
## 92 640 0.372604519
## 93 646 0.377188413
## 94 649 0.381793417
## 95 651 0.386423869
## 96 665 0.391080052
## 97 678 0.395762256
## 98 683 0.400470771
## 99 710 0.405201561
## 100 711 0.409954838
## 101 718 0.414730816
## 102 730 0.419534174
## 103 734 0.424360716
## 104 747 0.429215221
## 105 750 0.434093408
## 106 751 0.439000162
## 107 753 0.443935820
## 108 772 0.448900724
## 109 773 0.453895224
## 110 779 0.458914794
## 111 794 0.463964616
## 112 807 0.469040068
## 113 810 0.474141412
## 114 813 0.484406598
## 115 841 0.489592425
## 116 847 0.494810547
## 117 853 0.500061371
## 118 857 0.505345308
## 119 866 0.510657313
## 120 877 0.516003210
## 121 881 0.521377839
## 122 893 0.526787167
## 123 896 0.532231644
## 124 901 0.532231644
## 125 904 0.532231644
## 126 905 0.532231644
## 127 910 0.532231644
## 128 912 0.532231644
## 129 914 0.532231644
## 130 919 0.537961926
## 131 922 0.537961926
## 132 923 0.537961926
## 133 927 0.543799026
## 134 929 0.543799026
## 135 930 0.543799026
## 136 934 0.543799026
## 137 936 0.549789525
## 138 937 0.555816126
## 139 941 0.555816126
## 140 942 0.555816126
## 141 944 0.561991596
## 142 945 0.561991596
## 143 946 0.561991596
## 144 947 0.574702071
## 145 948 0.574702071
## 146 949 0.581231316
## 147 952 0.581231316
## 148 954 0.581231316
## 149 958 0.587998586
## 150 960 0.587998586
## 151 966 0.594867822
## 152 968 0.601784571
## 153 969 0.608758893
## 154 970 0.608758893
## 155 977 0.608758893
## 156 983 0.608758893
## 157 989 0.608758893
## 158 990 0.608758893
## 159 995 0.608758893
## 160 996 0.608758893
## 161 1001 0.608758893
## 162 1004 0.616232586
## 163 1012 0.616232586
## 164 1018 0.616232586
## 165 1019 0.623911769
## 166 1020 0.631661982
## 167 1023 0.639472730
## 168 1026 0.639472730
## 169 1031 0.639472730
## 170 1034 0.639472730
## 171 1036 0.639472730
## 172 1039 0.639472730
## 173 1042 0.639472730
## 174 1048 0.639472730
## 175 1053 0.639472730
## 176 1057 0.648029408
## 177 1061 0.648029408
## 178 1069 0.648029408
## 179 1073 0.648029408
## 180 1081 0.648029408
## 181 1082 0.648029408
## 182 1085 0.648029408
## 183 1091 0.648029408
## 184 1092 0.657579879
## 185 1093 0.657579879
## 186 1095 0.657579879
## 187 1097 0.657579879
## 188 1099 0.657579879
## 189 1100 0.657579879
## 190 1102 0.657579879
## 191 1107 0.657579879
## 192 1112 0.657579879
## 193 1115 0.657579879
## 194 1123 0.657579879
## 195 1124 0.668340328
## 196 1125 0.679240764
## 197 1127 0.679240764
## 198 1129 0.679240764
## 199 1134 0.679240764
## 200 1136 0.690688637
## 201 1137 0.690688637
## 202 1138 0.690688637
## 203 1145 0.690688637
## 204 1147 0.690688637
## 205 1151 0.690688637
## 206 1161 0.690688637
## 207 1162 0.690688637
## 208 1167 0.690688637
## 209 1174 0.690688637
## 210 1175 0.690688637
## 211 1176 0.690688637
## 212 1178 0.704974746
## 213 1181 0.704974746
## 214 1189 0.704974746
## 215 1193 0.704974746
## 216 1199 0.720498451
## 217 1201 0.720498451
## 218 1202 0.720498451
## 219 1209 0.720498451
## 220 1213 0.720498451
## 221 1214 0.720498451
## 222 1216 0.720498451
## 223 1218 0.720498451
## 224 1220 0.720498451
## 225 1222 0.720498451
## 226 1227 0.720498451
## 227 1228 0.720498451
## 228 1229 0.720498451
## 229 1230 0.720498451
## 230 1231 0.720498451
## 231 1232 0.720498451
## 232 1233 0.720498451
## 233 1234 0.720498451
## 234 1235 0.720498451
## 235 1237 0.720498451
## 236 1238 0.720498451
## 237 1239 0.720498451
## 238 1256 0.720498451
## 239 1258 0.720498451
## 240 1264 0.720498451
## 241 1267 0.720498451
## 242 1268 0.720498451
## 243 1269 0.720498451
## 244 1275 0.720498451
## 245 1288 0.720498451
## 246 1291 0.720498451
## 247 1297 0.720498451
## 248 1300 0.720498451
## 249 1302 0.720498451
## 250 1303 0.720498451
## 251 1312 0.720498451
## 252 1318 0.720498451
## 253 1319 0.776255784
## 254 1323 0.776255784
## 255 1328 0.776255784
## 256 1329 0.776255784
## 257 1331 0.776255784
## 258 1332 0.776255784
## 259 1333 0.776255784
## 260 1350 0.776255784
## 261 1355 0.776255784
## 262 1361 0.776255784
## 263 1373 0.776255784
## 264 1385 0.776255784
## 265 1387 0.776255784
## 266 1410 0.776255784
## 267 1416 0.776255784
## 268 1433 0.776255784S(t)= e**-A NELSON -AALEN
Los valores obtenidos de riesgo se van acumulando y van a ir creciendo mientras pasa el tiempo en que se realiza el estudio, estos valores no son un valor de probabilidad.
plot(tabla_aalen$tiempo, tabla_aalen$H_Aalen, type = "s",
xlab = "Tiempo (días)",
ylab = "Riesgo acumulado (Aalen)",
main = "Estimador de Aalen del riesgo acumulado",
col = "blue", lwd = 2)
- Prueba si las curvas de supervivencia para hombres y mujeres son significativamente diferentes. Justifica el tipo de prueba que debería usarse para este caso. (2pts)
ekm1<-survfit(Surv(datos$tiempo_dias,datos$evento)~datos$sexo)
summary(ekm1)$table## records n.max n.start events rmean se(rmean) median
## datos$sexo=Hombre 92 92 92 65 723.444 55.47149 714.5
## datos$sexo=Mujer 208 208 208 92 1028.302 34.01386 NA
## 0.95LCL 0.95UCL
## datos$sexo=Hombre 382 949
## datos$sexo=Mujer 1057 NAlibrary(survminer)
p_km <- ggsurvplot(
ekm1,
data = datos,
conf.int = TRUE, # IC (Greenwood)
censor = TRUE,
# tabla de en riesgo
risk.table.height = 3,
break.time.by = 1000,
ylim = c(0,1),
xlim = c(0,1000),
xlab = "Tiempo (dias)",
ylab = "S(t)",
surv.median.line = "hv", # traza mediana en el gráfico si existe
ggtheme = theme_minimal(base_size = 12)
)
p_km
#Ho : So(t)= … = Sy(t) #H1 : al menos un Si(t) es diferente
#### Comparación de grupos de tratamientos ####
library(survival)
logrank <- survdiff(Surv(tiempo_dias, evento) ~ sexo, data = datos, rho = 0)
logrank## Call:
## survdiff(formula = Surv(tiempo_dias, evento) ~ sexo, data = datos,
## rho = 0)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## sexo=Hombre 92 65 39.8 15.99 21.5
## sexo=Mujer 208 92 117.2 5.43 21.5
##
## Chisq= 21.5 on 1 degrees of freedom, p= 4e-06breslow <- survdiff(Surv(tiempo_dias, evento) ~ sexo, data = datos, rho = 1)
breslow## Call:
## survdiff(formula = Surv(tiempo_dias, evento) ~ sexo, data = datos,
## rho = 1)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## sexo=Hombre 92 49.8 29.8 13.39 23.2
## sexo=Mujer 208 66.3 86.2 4.63 23.2
##
## Chisq= 23.2 on 1 degrees of freedom, p= 1e-06tarone <- survdiff(Surv(tiempo_dias, evento) ~ sexo, data = datos, rho = 0.5)
tarone## Call:
## survdiff(formula = Surv(tiempo_dias, evento) ~ sexo, data = datos,
## rho = 0.5)
##
## N Observed Expected (O-E)^2/E (O-E)^2/V
## sexo=Hombre 92 56.5 34.2 14.51 22.5
## sexo=Mujer 208 77.7 100.0 4.97 22.5
##
## Chisq= 22.5 on 1 degrees of freedom, p= 2e-06alfa <- 0.05
X2 <- 21.5
df <- 1
Xcritico <- qchisq(0.95, df)
pvalor <- pchisq(21.5 , df, lower.tail = FALSE)
cat("Estadístico crítico:", Xcritico, "\n")## Estadístico crítico: 3.841459cat("p-valor:", pvalor, "\n")## p-valor: 3.538287e-06#Ho : So(t)= … = Sy(t) #H1 : al menos un Si(t) es diferente alfa= 0.05 p_valor= 3.538287e-06
p_valor < alfa entonces RHO
con un alfa= 0.05, tenemos suficiente evidencia estadistica para afirmar que las curvas de supervivencia no son iguales por lo tanto son significativamente diferentes
SE USO LA PRUEBA logrank porque notamos una diferencia en la escala de la grafica de kaplan meier
- Redacta una breve conclusión integrando los hallazgos gráficos y estadísticos obtenidos. Incluyendo la interpretación general sobre el efecto de expectativas, la edad y el género. (1 pt.)
al realizar el estudio se puede concluir que las personas con mayor sensación de expectativas de éxito tienden a encontrar trabajo más rápido, mientras que quienes perciben menor control sobre su situación permanecen más tiempo desempleados, esta variable es la que tiene una alta influencia en cuanto al obejtivo del estudio, comparandolo con el sexo de las personas,esta no influye tanto en el estudio.