PRACTICA DE SUPERVIVENCIA

Usando los datos y el script como guía haga un breve análisis de los tiempos de reincidencia criminal. Replique los resultados adjuntos e interprete. Importamos librerias

library(tidyverse)

Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
-- Attaching packages ---------------------------------------------------- tidyverse 1.3.1 --
v ggplot2 3.3.5     v purrr   0.3.4
v tibble  3.1.4     v dplyr   1.0.7
v tidyr   1.1.4     v stringr 1.4.0
v readr   2.0.2     v forcats 0.5.1
-- Conflicts ------------------------------------------------------- tidyverse_conflicts() --
x dplyr::filter() masks stats::filter()
x dplyr::lag()    masks stats::lag()

library(survival)
library(survminer)

Loading required package: ggpubr
Registered S3 method overwritten by 'data.table':
  method           from
  print.data.table     

Attaching package: 㤼㸱survminer㤼㸲

The following object is masked from 㤼㸱package:survival㤼㸲:

    myeloma

library(flexsurv)
library(dplyr)
library(ggplot2)

Evento ser rearestado despues de prision

El seguimiento duro tres años

Importamos datos

henning <- read.csv("C:/Users/doria/OneDrive/Escritorio/Cuestionario_2/PRACTICA DE SUPERVIVENCIA/data/Henning.txt", sep="")

Encabezados

head(henning)

id ientificacion del preso

months cuantos meses tarda la persona en ser rearrestada

censor indica si se censuro o no la persona ,1 obserbaste y no ocurrio el evento, 0 si ocurrio el evento

naturaleza del registro criminal

personal, 1 ,antecednetes criminales con respecto a personas

propeti, 1, antecednetes criminales con respecto hacia una propiedad

cage, edad centrada, diferencia entre edad y edad promedio

Explicar evento respecto a edad

Evento de interes ser arrestado

Creamos la variable event (evento)

henning <- henning %>% 
  mutate(event = case_when(
    censor == 0 ~ 1,
    TRUE ~ 0
  ))

Agrupamos

henning %>% 
  group_by(event) %>% # agrupamos por evento
  summarise(avg_months = mean(months), # tiempo promedio de censura
            avg_personal = mean(personal),# tiempo promedio incidente persona
            avg_property = mean(property),# tiempo promedioincidente propiedad
            avg_cage = mean(cage))# proemdio edad centrada

NA

Funcion intro_surv grafica si la variable es censurada o no

intro_surv

intro_surv<- function(data=NULL,n=NULL){
    muestra=sample_n(data,n) # seleccionamos una muestra de n
    muestra$id=seq(1,n)# renombramos los id
    time=muestra$months
    event=muestra$event
    ggplot(muestra)+
    geom_point(aes(x =id, y = time,  shape= as.factor(event)))+
    geom_linerange(aes(x =id, ymin = 0, ymax = time), linetype = "dotdash")+
    theme_classic()+
    labs(title ='Survival times plot',
         shape = 'Event',
         x = 'sample',
         y='Times')+
    coord_flip()
}

llamamos la funcion, n=10

intro_surv(data=henning,n=10)

Objeto de sobrevivencia

Regresion entre el logaritmo de la supervivencia y los tiempos

sfit <- survfit(Surv(months, event) ~ 1, data = henning)

Graficacion simple

plot(sfit)

Graficando con ggsurplot

Probabilidad sobrevivencia S(t)

ggsurvplot(sfit, data = henning)

Riesgo acumulada de hazard H(t)

ggsurvplot(sfit, data = henning, fun = "cumhaz")

Estimadores de la Función de Riesgo Acumulada

Regresion entre el logaritmo de la supervivencia y los tiempos

diagnos_surv <- function(times= NULL, surv=NULL) {
  data.frame(times = times, surv = surv) %>% 
    ggplot()+
    geom_point(aes(x = log(surv), y = times))+
    geom_smooth(aes(x = log(surv), y = times), method = "lm")+
    theme_classic()
}

llamamos la funcion

diagnos_surv(times=sfit$time,surv=sfit$surv)

Aproximacion con lineas exponencial Exponencial diagnostico

Seguimiento, relacionado con personas

0 Aquellos que no cometen crimenes en contra de personas 1 Aquellos que cometen crimenes en contra de personas

sfit_personal <- survfit(Surv(months, event) ~ personal, data = henning)
ggsurvplot(sfit_personal, data = henning)

Seguimiento, relacionado con propiedad

0 Aquellos que no cometen crimenes en contra de propiedades 1 Aquellos que cometen crimenes en contra de propiedades

sfit_property <- survfit(Surv(months, event) ~ property, data = henning)
ggsurvplot(sfit_property, data = henning)

Calculamos la distancia entre las curvas

Las curvas con discretas

max_distancia <- function(sfitp = NULL,p=NULL) {
  # Strata primeros valores
  f1 <- sfitp$strata[1]
  # strata valor final
  f2 <- length(sfitp$surv)
  #obtenemos tiempo y supervivencia de los 2 conjuntos
  t1<-sfitp$time[1:f1]# tiempo pesonal
  s1<-sfitp$surv[1:f1]# sobrevivencia 1
  t2<-sfitp$time[(f1+1):f2]# tiempo 2
  s2<-sfitp$surv[(f1+1):f2]# sobrevivencia 2
  
  #suavizamos ambas funciones de supervivencia y las evaluamos sobre el mismo conjunto
  s1aprox <- approxfun(s1,t1)
  s2aprox <- approxfun(s2,t2)
  df1<-data.frame(s=s2,ta1=s1aprox(s2), ta2=s2aprox(s2))
  # diferencia entre los tiempos para las funciones suavizadas
  df1$distancia<-abs(df1$ta1-df1$ta2)
  # Eliminamos NAs 
  df1 <- df1[!is.na(df1$distancia),]
  # Conservamos las S(t)>p
  df<-df1[df1$s>p,]
  # Obtenemos la mayor de las distancias entre las gráficas
  maxima<-max(df1$distancia)
  # Seleccionamos el renglon que corresponda a la distancia maxima
  d<-df1[df1$distancia==maxima,]
  max<-as.character(round(maxima,6))
  max
  grafica<-ggplot()+ 
    geom_step(aes(t1,s1, color="1"),size=0.5)+# personal=0
    geom_step(aes(t2,s2, color="0"),size=0.5)+# persoaml=1
    labs(title=paste("Máxima Distancia entre","personal=0","y","personal=1", sep = " "), 
         x="Tiempo", y="St")+
    theme_classic()+ # graficamos puntos maximo
    geom_hline(yintercept = d$s, linetype="dashed", color = "gray50", size=0.7)+
    labs(color = "blue") +
    geom_vline(xintercept = d$ta1, linetype="dashed", color = "gray50", size=0.7)+
    geom_vline(xintercept = d$ta2, linetype="dashed", color = "gray50", size=0.7)+ 
    annotate("text", x =min(d$ta1,d$ta2), y = d$s+0.02, label = paste("Distancia=",max,sep =""))
  return(grafica)
}

Con respecto a personas

max_distancia(sfitp =sfit_personal,p=0.5)

collapsing to unique 'x' valuescollapsing to unique 'x' values

Con respecto a propiedad

max_distancia(sfitp =sfit_property,p=0)

collapsing to unique 'x' valuescollapsing to unique 'x' values