library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(knitr)
library(kableExtra)
##
## Attaching package: 'kableExtra'
## The following object is masked from 'package:dplyr':
##
## group_rows
library(ggplot2)
Survival_time = c(13,52,6,40,10,7,66,10,10,14,16,4,65,5,11,10,15,5,76,56,88,24,51,4,40,8,18,5,16,50,40,1,36,5,10,91,18,1,18,6,1,23,15,18,12,12,17,3)
Status = c(1,0,1,1,1,0,1,0,rep(1,6),0,1,0,1,0,0,rep(1,4),0,rep(1,11),0,1,0,rep(1,5),0,1,1,0)
Age = c(66,66,53,69,65,57,52,60,70,70,68,50,59,60,66,51,55,67,60,66,63,67,60,74,72,55,51,70,53,74,70,67,63,77,61,58,69,57,59,61,75,56,62,60,71,60,65,59)
Sex = c(1,1,2,1,1,2,rep(1,5),2,1,1,2,2,1,2,rep(1,4),2,rep(1,4),2,1,1,2,rep(1,4),2,2,1,2,2,1,rep(2,6),1)
D<-data.frame(Survival_time,Status,Sex,Age)
#Creacion de los intervalos de la tabla de vida
D$Interval <- D$Survival_time
D$Interval[D$Interval<12] <- 1
D$Interval[D$Interval>=12 & D$Interval<24] <- 2
D$Interval[D$Interval>=24 & D$Interval<36] <- 3
D$Interval[D$Interval>=36 & D$Interval<48] <- 4
D$Interval[D$Interval>=48 & D$Interval<60] <- 5
D$Interval[D$Interval>=60] <- 6
#Creación de tabla de vida
suma_regresiva <- function(vector){
c <- sum(vector)
for(i in 1:length(vector)-1){
c[i+1] <- sum(vector[1:(length(vector)-i)])
}
c
}
suma_a_saltos <- function(vector){
c <- sum(vector)
for(i in 2:length(vector)){
c[i] <- sum(vector[i:(length(vector))])
}
c
}
Ej4 <- D %>% group_by(Interval) %>% mutate(d_j = sum(Status)) %>% ungroup() %>% mutate(Status = 1-Status) %>% group_by(Interval) %>% mutate(C_j = sum(Status)) %>% group_by(Interval,d_j,C_j) %>% summarise(n_j = n()) %>% ungroup() %>% mutate(n_j = suma_a_saltos(n_j)) %>% mutate(n_j_p = n_j-C_j/2) %>% mutate(p_j = (n_j_p-d_j)/n_j_p) %>% mutate("S(t)" = cumprod(p_j), "Time period" = c("0-", "12-", "24-", "36-", "48-", "60-")) %>% select(Interval, "Time period", d_j, C_j, n_j, n_j_p, p_j, "S(t)")
Ej4%>% kable(booktabs = T, align=rep('c'), caption = 'Tabla de Vida') %>% kable_styling(bootstrap_options = "striped", full_width = F)
Tabla de Vida
|
Interval
|
Time period
|
d_j
|
C_j
|
n_j
|
n_j_p
|
p_j
|
S(t)
|
|
1
|
0-
|
16
|
4
|
48
|
46.0
|
0.6521739
|
0.6521739
|
|
2
|
12-
|
10
|
4
|
28
|
26.0
|
0.6153846
|
0.4013378
|
|
3
|
24-
|
1
|
0
|
14
|
14.0
|
0.9285714
|
0.3726708
|
|
4
|
36-
|
3
|
1
|
13
|
12.5
|
0.7600000
|
0.2832298
|
|
5
|
48-
|
2
|
2
|
9
|
8.0
|
0.7500000
|
0.2124224
|
|
6
|
60-
|
4
|
1
|
5
|
4.5
|
0.1111111
|
0.0236025
|
Ej4 %>% mutate(Time = c(0,12,24,36,48,60)) %>%
rename(S="S(t)") %>%
ggplot(aes(y = S, x = Time))+ geom_step() + ggtitle("Curva de Supervivencia, Tabla de Vida. Ejemplo 1")+labs(x = "Tiempo de supervivencia", y = "Probabilidad de supervivencia")
