# Cargar librería necesaria
library(stats)
library(xtable)
library(dplyr)
library(writexl)
# Crear el data frame con edades de 15 a 110 años
tabla <- data.frame(
Edad = 15:110, # Edades de 15 a 110 años
Mortalidad = c( # Tasas de mortalidad (qx)
0.001720, 0.001770, 0.001810, 0.001860, 0.001910, 0.001970, 0.002020, 0.002090,
0.002150, 0.002220,
0.002300, 0.002370, 0.002460, 0.002540, 0.002640, 0.002740, 0.002840, 0.002950,
0.003070, 0.003190,
0.003320, 0.003460, 0.003610, 0.003770, 0.003930, 0.004110, 0.004300, 0.004500,
0.004710, 0.004930,
0.005170, 0.005420, 0.005690, 0.005980, 0.006290, 0.006610, 0.006960, 0.007330,
0.007720, 0.008140,
0.008590, 0.009060, 0.009570, 0.010110, 0.010690, 0.011310, 0.011980, 0.012680,
0.013440, 0.014250,
0.015120, 0.016040, 0.017030, 0.018100, 0.019240, 0.020450, 0.021760, 0.023160,
0.024670, 0.026280,
0.028010, 0.029860, 0.031850, 0.033990, 0.036290, 0.038750, 0.041390, 0.044230,
0.047280, 0.050550,
0.054060, 0.057830, 0.061870, 0.066210, 0.070870, 0.081470, 0.092070, 0.104390,
0.118350, 0.134180,
0.152120, 0.172470, 0.195540, 0.221700, 0.251350, 0.284970, 0.323090, 0.366300,
0.415300, 0.470850,
0.533830, 0.605230, 0.686180, 0.777960, 0.882020, 1.000000
),
Rotacion = c(
0.068000, 0.066000, 0.064000, 0.062000, 0.060000, 0.058000, 0.055000, 0.053000,
0.051000, 0.049000,
0.047000, 0.045000, 0.043000, 0.041000, 0.039000, 0.037000, 0.035000, 0.033000,
0.032000, 0.030000,
0.028000, 0.027000, 0.025000, 0.024000, 0.023000, 0.022000, 0.021000, 0.021000,
0.020000, 0.019000,
0.018000, 0.017000, 0.016000, 0.015000, 0.014000, 0.013000, 0.012000, 0.011000,
0.010000, 0.009000,
0.008000, 0.007000, 0.006000, 0.005000, 0.004000, 0.002000, 0.001000, 0.000500,
0.000250, 0.000125,
0.000063, rep(NA, 45) # NA para edades superiores a 65
),
Invalidez = c(
0.001000, 0.001000, 0.001000, 0.001000, 0.001000, 0.001000, 0.001000, 0.001000,
0.001000, 0.001000,
0.001000, 0.001000, 0.001000, 0.001000, 0.001000, 0.001010, 0.001020, 0.001030,
0.001050, 0.001070,
0.001090, 0.001110, 0.001140, 0.001170, 0.001210, 0.001260, 0.001320, 0.001390,
0.001460, 0.001560,
0.001810, 0.002140, 0.002530, 0.003000, 0.003570, 0.004240, 0.005040, 0.006000,
0.007140, 0.008470,
0.010020, 0.011800, 0.013830, 0.016110, 0.018630, 0.018650, 0.018650, 0.018650,
0.018650, 0.018650,
0.018650, rep(NA, 45) # NA para edades superiores a 65
)
)
# Hipótesis financieras
tasa_interes_nominal <- 0.08 # Descuento nominal anual
incremento_salarial <- 0.04 # Incremento salarial anual
inflacion <- 0.035 # Inflación anual
# Pagos mensuales iniciales
pagos_mensuales <- c(1000, 5000, 8000)
# Calcular la tasa de interés efectiva mensual
tasa_interes_mensual <- (1 + tasa_interes_nominal / 12) - 1
# Calcular probabilidades de supervivencia acumuladas desde la tabla de mortalidad
tabla$Supervivencia <- cumprod(1 - tabla$Mortalidad)
# Inicializar columnas para los valores presentes de la anualidad
tabla$VA_Anualidad_1000 <- NA
tabla$VA_Anualidad_5000 <- NA
tabla$VA_Anualidad_8000 <- NA
# Función para calcular el valor presente de la anualidad para un pago dado
calcular_valor_anualidad <- function(edad_actual, pago_mensual) {
valor_actual_anualidad <- 0
for (t in 0:((110 - edad_actual) * 12 - 1)) { # Meses restantes de vida esperada
edad_futura <- edad_actual + floor(t / 12) # Edad futura correspondiente
if (edad_futura > 110) break # No considerar edades mayores a 110
prob_supervivencia <- tabla$Supervivencia[tabla$Edad == edad_futura]
# Ajustar el pago mensual por incremento salarial e inflación
pago_mensual_ajustado <- pago_mensual *
(1 + incremento_salarial)^(t / 12) * (1 + inflacion)^(t / 12)
# Calcular valor presente descontado y ponderado por supervivencia
valor_actual_anualidad <- valor_actual_anualidad +
(pago_mensual_ajustado / (1 + tasa_interes_mensual)^t) * prob_supervivencia
}
return(valor_actual_anualidad)
}
# Recorrer la tabla y calcular los valores presentes de la anualidad para cada
monto
for (i in 1:nrow(tabla)) {
edad_actual <- tabla$Edad[i]
if (edad_actual > 110) break # No calcular para edades mayores a 110
# Calcular anualidades para cada monto de pago
tabla$VA_Anualidad_1000[i] <- calcular_valor_anualidad(edad_actual,
pagos_mensuales[1])
tabla$VA_Anualidad_5000[i] <- calcular_valor_anualidad(edad_actual,
pagos_mensuales[2])
tabla$VA_Anualidad_8000[i] <- calcular_valor_anualidad(edad_actual,
pagos_mensuales[3])
}
head(tabla)
write_xlsx(tabla, ) ##########Agregar ruta de guardado
