library(survival)
library(ggplot2)

1 Datos simulados base

set.seed(123)
n <- 100
tiempo <- rexp(n, rate = 0.05)
tiempo
##   [1]  16.86914522  11.53220542  26.58109736   0.63154718   1.12421952
##   [6]   6.33002433   6.28454584   2.90533608  54.52472929   0.58306894
##  [11]  20.09660115   9.60429455   5.62027255   7.54235662   3.76568082
##  [16]  16.99572259  31.26407079   9.57520833  11.81869671  80.82023423
##  [21]  16.86299462  19.31742422  29.70551588  26.96088971  23.37057969
##  [26]  32.11704686  29.93485737  31.41305094   0.63535488  11.95699383
##  [31]  43.35679491  10.13231457   5.19115635  51.93784233  24.58051464
##  [36]  15.81363518  12.58560156  25.09282006  11.77369284  22.58580068
##  [41]   8.40729605 144.22015152  16.91443930   4.51084013  22.00677635
##  [46]  44.96611385  27.27468599  11.52783336  54.50551700  26.24326085
##  [51]   1.81182700   6.12407700  21.34426139   6.27032512  19.49280301
##  [56]  37.75646631  11.29177205  51.53922658  20.95391496  20.48882684
##  [61]  20.55739231   5.69336921  31.26103777   0.84176586   1.97261780
##  [66]   1.97138624   5.60770323   5.91573917  19.44859298  18.48054448
##  [71]  32.84809053  32.39825535  50.72291080  30.43099247   7.60028406
##  [76]   4.77025934   9.32974847   0.84542903   6.39353799  12.87221841
##  [81]  11.45126207   4.32111005  89.97346796  37.14181106  13.70917276
##  [86]  28.78905252  34.62307967  24.89566600  29.26601120  30.74787957
##  [91]   0.09198253  22.17530936   5.99940635  23.84006014  22.29857407
##  [96]   1.34751782   9.61337442  31.40908678   5.19892214  37.13844575
evento <- rbinom(n, 1, 0.8)
datos <- data.frame(tiempo, evento)
datos
##           tiempo evento
## 1    16.86914522      0
## 2    11.53220542      1
## 3    26.58109736      1
## 4     0.63154718      1
## 5     1.12421952      1
## 6     6.33002433      1
## 7     6.28454584      0
## 8     2.90533608      1
## 9    54.52472929      0
## 10    0.58306894      1
## 11   20.09660115      1
## 12    9.60429455      1
## 13    5.62027255      1
## 14    7.54235662      1
## 15    3.76568082      1
## 16   16.99572259      1
## 17   31.26407079      0
## 18    9.57520833      0
## 19   11.81869671      1
## 20   80.82023423      1
## 21   16.86299462      0
## 22   19.31742422      1
## 23   29.70551588      0
## 24   26.96088971      1
## 25   23.37057969      1
## 26   32.11704686      1
## 27   29.93485737      1
## 28   31.41305094      1
## 29    0.63535488      1
## 30   11.95699383      0
## 31   43.35679491      1
## 32   10.13231457      1
## 33    5.19115635      1
## 34   51.93784233      0
## 35   24.58051464      1
## 36   15.81363518      1
## 37   12.58560156      1
## 38   25.09282006      1
## 39   11.77369284      1
## 40   22.58580068      1
## 41    8.40729605      1
## 42  144.22015152      1
## 43   16.91443930      1
## 44    4.51084013      1
## 45   22.00677635      1
## 46   44.96611385      1
## 47   27.27468599      0
## 48   11.52783336      0
## 49   54.50551700      1
## 50   26.24326085      0
## 51    1.81182700      1
## 52    6.12407700      1
## 53   21.34426139      1
## 54    6.27032512      1
## 55   19.49280301      1
## 56   37.75646631      1
## 57   11.29177205      1
## 58   51.53922658      0
## 59   20.95391496      1
## 60   20.48882684      1
## 61   20.55739231      1
## 62    5.69336921      1
## 63   31.26103777      1
## 64    0.84176586      1
## 65    1.97261780      1
## 66    1.97138624      0
## 67    5.60770323      1
## 68    5.91573917      0
## 69   19.44859298      1
## 70   18.48054448      1
## 71   32.84809053      1
## 72   32.39825535      1
## 73   50.72291080      1
## 74   30.43099247      1
## 75    7.60028406      1
## 76    4.77025934      0
## 77    9.32974847      0
## 78    0.84542903      1
## 79    6.39353799      1
## 80   12.87221841      1
## 81   11.45126207      1
## 82    4.32111005      1
## 83   89.97346796      1
## 84   37.14181106      1
## 85   13.70917276      1
## 86   28.78905252      1
## 87   34.62307967      1
## 88   24.89566600      0
## 89   29.26601120      0
## 90   30.74787957      0
## 91    0.09198253      1
## 92   22.17530936      0
## 93    5.99940635      1
## 94   23.84006014      1
## 95   22.29857407      1
## 96    1.34751782      1
## 97    9.61337442      1
## 98   31.40908678      1
## 99    5.19892214      0
## 100  37.13844575      1
# Kaplan-Meier
km_fit <- survfit(Surv(tiempo, evento) ~ 1, data = datos)
km_df <- data.frame(time = km_fit$time, surv = km_fit$surv)
t <- seq(0, max(datos$tiempo), length = 200)

2 Modelo Exponencial con diferentes lambdas

lambda1 <- 0.02
lambda2 <- 0.05
lambda3 <- 0.10

S_exp1 <- exp(-lambda1 * t)
S_exp2 <- exp(-lambda2 * t)
S_exp3 <- exp(-lambda3 * t)

exp_df <- rbind(
  data.frame(time = t, surv = S_exp1, modelo = "λ=0.02"),
  data.frame(time = t, surv = S_exp2, modelo = "λ=0.05"),
  data.frame(time = t, surv = S_exp3, modelo = "λ=0.10")
)

ggplot() +
  geom_step(data = km_df, aes(x = time, y = surv), color = "black", size = 1) +
  geom_line(data = exp_df, aes(x = time, y = surv, color = modelo), size = 1) +
  labs(title = "Curvas Exponenciales vs Kaplan-Meier",
       x = "Tiempo", y = "Supervivencia") +
  theme_minimal()

Interpretación: Valores altos de λ hacen que la supervivencia caiga más rápido, mientras que valores pequeños de λ implican mayor supervivencia esperada.

3 Modelo Weibull con diferentes gammas

# usamos la funcion lapply para agrupar todas las gamma y crear el data frame y que sea menos extenso que el codigo anterior
theta <- 20
gammas <- c(0.5, 1.5, 2)
weib_models <- lapply(gammas, function(g){
  data.frame(time=t, surv=exp(-(t/theta)^g), gamma=g)
})
weib_df <- do.call(rbind, weib_models)

ggplot() +
  geom_step(data=km_df, aes(x=time, y=surv), color="black", size=1) +
  geom_line(data=weib_df, aes(x=time, y=surv, color=factor(gamma)), size=1.2) +
  labs(title="Supervivencia Weibull con diferentes γ vs KM",
       x="Tiempo", y="Supervivencia", color="γ") +
  theme_minimal()

Interpretación: Con γ<1 el riesgo decrece, con γ=1 se comporta como exponencial, y con γ>1 el riesgo aumenta con el tiempo.

4 Comparación Weibull vs Exponencial vs KM

lambda <- 0.05
gamma<- 1.5
theta <- 20

S_exp <- exp(-lambda * t)
S_weib <- exp(-(t/theta)^gamma)

comp_df <- rbind(
  data.frame(time = t, surv = S_exp, modelo = "Exponencial"),
  data.frame(time = t, surv = S_weib, modelo = "Weibull"),
  data.frame(time = km_df$time, surv = km_df$surv, modelo = "Kaplan-Meier")
)

ggplot(comp_df, aes(x = time, y = surv, color = modelo, linetype = modelo)) +
  geom_line(size = 1) +
  labs(title = "Comparación de Modelos de Supervivencia",
       x = "Tiempo", y = "Supervivencia") +
  theme_minimal()

Interpretación: En este gráfico se observa que la curva de Kaplan-Meier (verde) representa los datos empíricos de supervivencia, mientras que los modelos teóricos (Exponencial en rojo y Weibull en azul) buscan aproximarla. El modelo exponencial ajustado sigue bastante bien la tendencia general, aunque suaviza los saltos característicos del KM. En cambio, el modelo Weibull muestra una caída más rápida al inicio, lo que indica mayor sensibilidad a eventos tempranos, pero pierde precisión en la cola.

5 Riesgo de Exponencial con diferentes λ

R_exp1 <- rep(lambda1, length(t))
R_exp2 <- rep(lambda2, length(t))
R_exp3 <- rep(lambda3, length(t))

R_exp_df <- rbind(
  data.frame(Tiempo = t, riesgo = R_exp1, modelo = "λ=0.02"),
  data.frame(Tiempo = t, riesgo = R_exp2, modelo = "λ=0.05"),
  data.frame(Tiempo = t, riesgo = R_exp3, modelo = "λ=0.1")
)

ggplot(R_exp_df, aes(x = Tiempo, y = riesgo, color = modelo)) +
  geom_line(size = 1) +
  labs(title = "Función de Riesgo Exponencial",
       x = "Tiempo", y = "Riesgo h(t)") +
  theme_minimal()

Interpretación: El riesgo en la exponencial es constante y depende únicamente de λ.

6 Riesgo de Weibull con diferentes γ

gamma1 <- 0.5
gamma2 <- 1.5
gamma3 <- 2
R_weib1 <- (gamma1/theta) * (t/theta)^(gamma1-1)
R_weib2 <- (gamma2/theta) * (t/theta)^(gamma2-1)
R_weib3 <- (gamma3/theta) * (t/theta)^(gamma3-1)

R_weib_df <- rbind(
  data.frame(tiempo = t, riesgo = R_weib1, modelo = "γ=0.5"),
  data.frame(tiempo = t, riesgo = R_weib2, modelo = "γ=1"),
  data.frame(tiempo = t, riesgo = R_weib3, modelo = "γ=2")
)

ggplot(R_weib_df, aes(x = tiempo, y = riesgo, color = modelo)) +
  geom_line(size = 1) +
  labs(title = "Función de Riesgo Weibull",
       x = "Tiempo", y = "Riesgo h(t)") +
  theme_minimal()

Interpretación: Weibull modela riesgos crecientes o decrecientes, mostrando mayor flexibilidad.

7 Comparación del Riesgo Weibull vs Exponencial

R_exp <- rep(lambda, length(t))
R_weib <- (gamma/theta) * (t/theta)^(gamma-1)

R_comp <- rbind(
  data.frame(tiempo = t, riesgo = R_exp, modelo = "Exponencial"),
  data.frame(tiempo = t, riesgo = R_weib, modelo = "Weibull")
)

ggplot(R_comp, aes(x = tiempo, y = riesgo, color = modelo)) +
  geom_line(size = 1) +
  labs(title = "Comparación de Riesgo Weibull vs Exponencial (Estimados)",
       x = "Tiempo", y = "Riesgo h(t)") +
  theme_minimal()

Interpretación: El modelo Exponencial mantiene un riesgo plano; Weibull captura la variación del riesgo con el tiempo.

8 Supervivencia y Riesgo Exponencial

S_exp <- exp(-lambda * t)
R_exp <- rep(lambda, length(t))   

exp_df <- data.frame(tiempo = t, 
                     Supervivencia = S_exp, 
                     Riesgo = R_exp)

maxS <- max(S_exp)
maxR <- max(R_exp)

ggplot(exp_df, aes(x = tiempo)) +
  geom_line(aes(y = Supervivencia, color = "Supervivencia"), size = 1) +
  geom_line(aes(y = Riesgo / maxR * maxS, color = "Riesgo"), 
            size = 1, linetype = "dashed") +
  scale_y_continuous(
    name = "Supervivencia S(t)",
    sec.axis = sec_axis(~ . / maxS * maxR, name = "Riesgo h(t)")
  ) +
  labs(title = "Curva de Supervivencia y Riesgo (Exponencial Estimado)",
       x = "Tiempo") +
  scale_color_manual(values = c("Supervivencia" = "blue", "Riesgo" = "red")) +
  theme_minimal() +
  theme(legend.title = element_blank())

Interpretación: En el modelo exponencial, la supervivencia decrece de forma constante, mientras el riesgo se mantiene fijo en el tiempo