Introdução

Este estudo propõe um modelo de múltiplos decrementos com duas causas distintas e suas análises correspondentes, além de uma tabela de serviço criada para um grupo de colaboradores de uma empresa, levando em conta diferentes taxas de saída.

Modelo de Múltiplo Decremento

A intensidade de decremento para cada causa pode ser entendida como a taxa instantânea de saída de um grupo populacional em razão de uma causa específica.

Um modelo de múltiplos decrementos com duas causas de decremento é definido pelas seguintes intensidades de decremento:

Isso indica que, conforme o tempo t avança, a intensidade de decremento cresce, refletindo uma maior tendência à ocorrência dos eventos de decremento à medida que o grupo populacional envelhece.

Para os propósitos deste estudo, será considerada uma idade x=50 anos para um indivíduo:

\[ \mu_{50,1}(t) = \frac{1}{50 - t}, \quad \mu_{50,2}(t) = \frac{2}{50 - t} \]

library(readxl)
library(DT)
library(knitr)

x <- 50
t <- seq(0, 49, 1)

FDP da Distribuição Conjunta \(f_{T,J}(t,j)\)

A função de densidade de probabilidade conjunta para o tempo e o tipo de decremento pode ser calculada como:

\[ f_{T,J}(t,1) = \left(\frac{50 - t}{50}\right)^3 \cdot \frac{1}{50 - t} = \frac{(50 - t)^2}{50^3} \] \[ f_{T,J}(t,2) = \left(\frac{50 - t}{50}\right)^3 \cdot \frac{2}{50 - t} = \frac{2 \cdot (50 - t)^2}{50^3} \]

As equações oferecem uma fundação matemática robusta para estimar a probabilidade de um certo decréscimo acontecer em um instante específico 𝑡

μ1 <- 1 / (50 - t); μ1
##  [1] 0.02000000 0.02040816 0.02083333 0.02127660 0.02173913 0.02222222
##  [7] 0.02272727 0.02325581 0.02380952 0.02439024 0.02500000 0.02564103
## [13] 0.02631579 0.02702703 0.02777778 0.02857143 0.02941176 0.03030303
## [19] 0.03125000 0.03225806 0.03333333 0.03448276 0.03571429 0.03703704
## [25] 0.03846154 0.04000000 0.04166667 0.04347826 0.04545455 0.04761905
## [31] 0.05000000 0.05263158 0.05555556 0.05882353 0.06250000 0.06666667
## [37] 0.07142857 0.07692308 0.08333333 0.09090909 0.10000000 0.11111111
## [43] 0.12500000 0.14285714 0.16666667 0.20000000 0.25000000 0.33333333
## [49] 0.50000000 1.00000000
μ2 <- 2 / (50 - t); μ2
##  [1] 0.04000000 0.04081633 0.04166667 0.04255319 0.04347826 0.04444444
##  [7] 0.04545455 0.04651163 0.04761905 0.04878049 0.05000000 0.05128205
## [13] 0.05263158 0.05405405 0.05555556 0.05714286 0.05882353 0.06060606
## [19] 0.06250000 0.06451613 0.06666667 0.06896552 0.07142857 0.07407407
## [25] 0.07692308 0.08000000 0.08333333 0.08695652 0.09090909 0.09523810
## [31] 0.10000000 0.10526316 0.11111111 0.11764706 0.12500000 0.13333333
## [37] 0.14285714 0.15384615 0.16666667 0.18181818 0.20000000 0.22222222
## [43] 0.25000000 0.28571429 0.33333333 0.40000000 0.50000000 0.66666667
## [49] 1.00000000 2.00000000

Força Total de Decremento

A força total de decremento, que combina as duas causas, é a soma das forças de decremento individuais:

\[\mu{{x}^{(\tau)}}(t) = \sum{{j=1}^{m}}\mu{_{x}^{(j)}}(t)\]
\[\mu{{50}^{(\tau)}}(t) = \mu{{50}^{1}}(t) + \mu{_{50}^{2}}(t)\]
\[\mu{_{50}^{(\tau)}}(t) = \frac{1}{50-t} + \frac{2}{50-t}\]
\[\mu{_{50}^{(\tau)}}(t) = \frac{3}{50-t}\]

Essa equação fornece uma visão unificada de como diferentes causas impactam conjuntamente o grupo.

μτ <- μ1 + μ2; μτ
##  [1] 0.06000000 0.06122449 0.06250000 0.06382979 0.06521739 0.06666667
##  [7] 0.06818182 0.06976744 0.07142857 0.07317073 0.07500000 0.07692308
## [13] 0.07894737 0.08108108 0.08333333 0.08571429 0.08823529 0.09090909
## [19] 0.09375000 0.09677419 0.10000000 0.10344828 0.10714286 0.11111111
## [25] 0.11538462 0.12000000 0.12500000 0.13043478 0.13636364 0.14285714
## [31] 0.15000000 0.15789474 0.16666667 0.17647059 0.18750000 0.20000000
## [37] 0.21428571 0.23076923 0.25000000 0.27272727 0.30000000 0.33333333
## [43] 0.37500000 0.42857143 0.50000000 0.60000000 0.75000000 1.00000000
## [49] 1.50000000 3.00000000

Probabilidade de Sobrevivência

A probabilidade de que um indivíduo sobreviva até o tempo𝑡sem sofrer nenhum decremento é dada pela seguinte expressão:

\[{t}p{{x}^{(\tau)}} = e^{-\int_{0}^{t}\mu{_{x}^{(\tau)}}(t)dt}\]
\[{t}p{{50}^{(\tau)}} = e^{-\int_{0}^{t}\mu{_{50}^{(\tau)}}(t)dt}\]
Substituindo a força total de decremento:
\[{t}p{{50}^{(\tau)}} = e^{-\int_{0}^{t}\frac{3}{50 - t}dt}\]
Resolvendo a integral:
\[\int_{0}^{t}\frac{3}{50 - t} dt = - 3ln(50 - t) + 3ln(50)\]
Voltando a expressão da probabilidade:
\[{t}p{{50}^{(\tau)}} = e^{-(-3ln(50 - t) + 3ln(50))}\]
\[{t}p{{50}^{(\tau)}} = e^{3ln(50 - t) - 3ln(50)}\]
Aplicando a propriedade dos logaritmos, \[ln(a) - ln(b) = ln(\frac{a}{b})\]:
\[{t}p{{50}^{(\tau)}} = e^{3ln\frac{(50-t)}{50}}\]
\[{t}p{{50}^{(\tau)}} = (\frac{(50-t)}{50})^3\]

pτ <- ((50 - t) / 50) ^ 3; pτ
##  [1] 1.000000 0.941192 0.884736 0.830584 0.778688 0.729000 0.681472 0.636056
##  [9] 0.592704 0.551368 0.512000 0.474552 0.438976 0.405224 0.373248 0.343000
## [17] 0.314432 0.287496 0.262144 0.238328 0.216000 0.195112 0.175616 0.157464
## [25] 0.140608 0.125000 0.110592 0.097336 0.085184 0.074088 0.064000 0.054872
## [33] 0.046656 0.039304 0.032768 0.027000 0.021952 0.017576 0.013824 0.010648
## [41] 0.008000 0.005832 0.004096 0.002744 0.001728 0.001000 0.000512 0.000216
## [49] 0.000064 0.000008

FDP da Distribuição Conjunta \(f_{T,J}(t,j)\)

A função de densidade de probabilidade conjunta para o tempo e tipo de decremento pode ser calculada da seguinte maneira:

\(f_{T, J}(t, j) = {_t}p{_x^{(\tau)}} \cdot \mu{_x^{(j)}}(t)\)

\[ f_{T,J}(t,j) = \begin{cases} f_{T,J}(t,1) = (\frac{(50-t)}{50})^3 \cdot \frac{1}{50-t} = \frac{(50 - t)^2}{50^3}, t\le50 \\ f_{T,J}(t,2) = (\frac{(50-t)}{50})^3 \cdot \frac{2}{50-t} = \frac{2 \cdot (50 - t)^2}{50^3}, t\le50 \end{cases} \] AAs equações oferecem uma fundação matemática robusta para calcular a probabilidade de um certo decremento ocorrer em um momento𝑡.

FDP da Distribuição Marginal \(f_T(t)\)

\[f_{T}(t) = {_t}p{_x^{(\tau)}} \cdot \mu{_x^{(\tau)}}(t)\]
\[f_{T}(t) = (\frac{(50-t)}{50})^3 \cdot \frac{3}{50-t} = \frac{3(50-t)^2}{50^3}, t\le50\]

fT <- pτ * μτ; fT
##  [1] 0.060000 0.057624 0.055296 0.053016 0.050784 0.048600 0.046464 0.044376
##  [9] 0.042336 0.040344 0.038400 0.036504 0.034656 0.032856 0.031104 0.029400
## [17] 0.027744 0.026136 0.024576 0.023064 0.021600 0.020184 0.018816 0.017496
## [25] 0.016224 0.015000 0.013824 0.012696 0.011616 0.010584 0.009600 0.008664
## [33] 0.007776 0.006936 0.006144 0.005400 0.004704 0.004056 0.003456 0.002904
## [41] 0.002400 0.001944 0.001536 0.001176 0.000864 0.000600 0.000384 0.000216
## [49] 0.000096 0.000024

FDP da Distribuição Marginal \(f_J(j)\)

\[f_{J}(j) = {\infty}q{{x}^{(j)}}\]
Calculando a probabilidade de que o decremento ocorra até o tempo t
\[{50}q{{50}^{(1)}} = \int{_{0}^{50}}\frac{(50 - t)^2}{50^3}dt = \frac{1}{3}\]

q1 <- function(t) {
  ((50 - t) ^ 2 / 50 ^ 3)
}
funcaoq1 <- integrate(q1, 0, 50)$value; funcaoq1
## [1] 0.3333333

\[{50}q{{50}^{(2)}} = 1 - {{50}}q{{50}^{(1)}} = \frac{2}{3}\]

q2 <- 1 - funcaoq1; q2
## [1] 0.6666667

Fdp da distribuição condicional de J, dado um decremento no tempo \(t\) \(f_{J|T}(j|t)\)

\[f_{J|T}(j|t) = \frac{f_{T, J}(t, j)}{f_{T}(t)} = \frac{{t}p{_x^{(\tau)}} \cdot \mu{_x^{(j)}}(t)}{{_t}p{_x^{(\tau)}} \cdot \mu{_x^{(\tau)}}(t)} = \frac{\mu{x}^{(j)}(t)}{\mu_{x}^{(\tau)}(t)}\]
\[f_{J|T}(1|t) = \frac{\mu_{x}^{(1)}(t)}{\mu_{x}^{(\tau)}(t)} = \frac{1}{50-t} \cdot \frac{50-t}{3} = \frac{1}{3}\]

fj1 <- μ1/μτ; fj1[1]
## [1] 0.3333333

\[f_{J|T}(2|t) = \frac{\mu_{x}^{(2)}(t)}{\mu_{x}^{(\tau)}(t)} = \frac{2}{50-t} \cdot \frac{50-t}{3} = \frac{2}{3}\]

fj2 <- μ2/μτ; fj2[1]
## [1] 0.6666667

Tabela de Valores e Gráficos para \(t p_{50}\), \(t q_{50}^{(1)}\) e \(t q_{50}^{(2)}\)

Distribuição de \(J(x)\) para \(x = 50\)

t = seq(1, 10, 1)
idades <- seq(51, 60, 1)
f1 <- function(t)(50-t)^2/(50^3)
f2 <- function(t)2*(50-t)^2/(50^3)
q11 <- rep(0, 10)
q12 <- rep(0, 10)
for (i in t) {
q11[i] <- integrate(f1, 0, i)$value
q12[i] <- integrate(f2, 0, i)$value
}
graf <- data.frame(idades, t, pτ[2:11], q11, q12);graf
plot(idades, pτ[2:11], "o", pch = 20, cex=0.7, main="Gráfico",xlab="x+t", ylab="10p50(τ)")

plot(t, q11, type="o", pch=20, cex=0.7, col="blue", main=" ", xlab="t", ylab=bquote(q[x]), ylim=c(0, 0.35))
lines(t, q12, type="o", pch=20, cex=0.7, col="red")
legend("topleft", legend=c(bquote(q[50]^{(1)}), bquote(q[50]^{(2)})), col=c("blue", "red"), pch=20)

f) Prepare uma tabela e desenhe o gráfico de \({t}q{x}^{(1)}\) e \({t}q{x}^{(2)}\) para \(t = 1, 2, . . . , 10\) e para \(x = 50\).

f1 <- function(t)(50-t)^2/(50^3)
f2 <- function(t)2*(50-t)^2/(50^3)
q11 <- rep(0, 10)
q12 <- rep(0, 10)
for (i in t) {
q11[i] <- integrate(f1, 0, i)$value
q12[i] <- integrate(f2, 0, i)$value
}
dfq10 <- data.frame(t, q11, q12); dfq10

g) Encontre a distribuição de J(x) para x = 50.

\[f_{J} = {t}q{x}^{(j)}\]
\[{t}q{50}^{(j)} = \int_{0}^{50}f_{T, J}(t, j) dt\]
\[{50}q{50}^{(1)} = \int_{0}^{50}\frac{(50 - t)^2}{50^3} dt\]

fq501 <- function(t) (50 - t)^2 / (50^3)
q501 <- integrate(fq501, 0, 50)$value; q501
## [1] 0.3333333

\[{50}q{50}^{(2)} = \int_{0}^{50} \frac{2 \cdot (50 - t)^2}{50^3} dt\]

fq502 <- function(t) 2 * (50 - t)^2 / (50^3)
q502 <- integrate(fq502, 0, 50)$value; q502
## [1] 0.6666667

h) Encontre a distribuição condicional de J(x) dado T(x) = 10 para x = 50.

\[f_{J|T}(1|10) = \frac{\mu_{50}^{(1)}(10)}{\mu_{50}^{(\tau)}(10)} = \frac{1}{50-10} \cdot \frac{50-10}{3} = \frac{1}{3}\]
\[f_{J|T}(2|10) = \frac{\mu_{50}^{(2)}(10)}{\mu_{50}^{(\tau)}(10)} = \frac{2}{50-10} \cdot \frac{50-10}{3} = \frac{2}{3}\]

Tábua de Serviço para Funcionários da Empresa X

Para este estudo, foi desenvolvida uma tábua de serviço considerando um grupo de 100 funcionários, todos com idade inicial de 30 anos. As taxas e premissas utilizadas são descritas a seguir:

Hipóteses Demográficas

  • Mortalidade: Tábua AT-2000 Male.
  • Invalidez: Álvaro Vindas.
  • Rotatividade: 2% até 50 anos.
  • Aposentadoria: Probabilidades variando de 10% aos 55 anos até 100% para 60 anos ou mais.
  • Taxa de juros: 6% ao ano.

Cálculo das Taxas Ajustadas

As taxas de mortalidade (\(q_{ax}\)), invalidez (\(i_{ax}\)), rotatividade (\(r_{ax}\)), e aposentadoria (\(A_{ax}\)) foram ajustadas considerando interações entre as causas de saída do grupo, conforme a fórmula:

#importando tabuas de invalidez e mortalidade
tabua_invalidez <- read_excel("ALVARO_VINDAS.xlsx")
tabua_vida <- read_excel('AT-2000-male.xlsx')

#unindo as tabuas em um unico df
tabua_servico <- merge(tabua_vida, tabua_invalidez, by = "x")

#acrescentando a coluna de rotatividade
tabua_servico$rotatividade <- ifelse(tabua_servico$x >= 30 & tabua_servico$x <= 50, 0.02, 0)

#acrescentando a coluna de aposentadoria
tabua_servico$aposentadoria <- ifelse(tabua_servico$x == 55, 0.1, ifelse(tabua_servico$x >= 56 & tabua_servico$x <= 59, 0.03,
ifelse(tabua_servico$x >= 60, 1.0, 0)))

#filtrando a tabua de servico entre 30 e 60 anos
tabua_servico <- tabua_servico[tabua_servico$x >= 30 & tabua_servico$x <= 60, ]

# q_d taxa de mortalidade
tabua_servico$q_d <- tabua_servico$`mortalidade` * (1 - 1/2 * (tabua_servico$`invalidez` + tabua_servico$rotatividade + tabua_servico$aposentadoria) + 1/3 * (tabua_servico$`invalidez` * tabua_servico$rotatividade + tabua_servico$`invalidez` * tabua_servico$aposentadoria + tabua_servico$rotatividade * tabua_servico$aposentadoria) - 1/4 * tabua_servico$`invalidez` * tabua_servico$rotatividade * tabua_servico$aposentadoria)

# q_i taxa de invalidez
tabua_servico$q_i <- tabua_servico$`invalidez` * (1 - 1/2 * (tabua_servico$`mortalidade` + tabua_servico$rotatividade + tabua_servico$aposentadoria) + 1/3 * (tabua_servico$`mortalidade` * tabua_servico$rotatividade + tabua_servico$`mortalidade` * tabua_servico$aposentadoria + tabua_servico$rotatividade * tabua_servico$aposentadoria) - 1/4 * tabua_servico$`mortalidade` * tabua_servico$rotatividade * tabua_servico$aposentadoria)

# q_r taxa de rotatividade
tabua_servico$q_r <- tabua_servico$rotatividade * (1 - 1/2 * (tabua_servico$`mortalidade` + tabua_servico$`invalidez` + tabua_servico$aposentadoria) + 1/3 * (tabua_servico$`mortalidade` * tabua_servico$`invalidez` + tabua_servico$`mortalidade` * tabua_servico$aposentadoria + tabua_servico$`invalidez` * tabua_servico$aposentadoria) - 1/4 * tabua_servico$`mortalidade` * tabua_servico$`invalidez` * tabua_servico$aposentadoria)

# q_a taxa de aposentadoria
tabua_servico$q_a <- tabua_servico$aposentadoria * (1 - 1/2 * (tabua_servico$`mortalidade` + tabua_servico$`invalidez` + tabua_servico$rotatividade) + 1/3 * (tabua_servico$`mortalidade` * tabua_servico$`invalidez` + tabua_servico$`mortalidade` * tabua_servico$rotatividade + tabua_servico$`invalidez` * tabua_servico$rotatividade) - 1/4 * tabua_servico$`mortalidade` * tabua_servico$`invalidez` * tabua_servico$rotatividade)

# q_t taxa total
tabua_servico$q_t <- tabua_servico$q_d + tabua_servico$q_i + tabua_servico$q_r + tabua_servico$q_a
tabua_servico$p_t <- 1 - tabua_servico$q_t

# criando colunas lx_t e dx_t
for (i in 1:nrow(tabua_servico)) {
  if (i == 1) {
    tabua_servico$lx_t[i] <- 100
    tabua_servico$dx_t[i] <- tabua_servico$lx_t[i] * tabua_servico$q_t[i]
  } else {
    tabua_servico$lx_t[i] <- tabua_servico$lx_t[i-1] - tabua_servico$dx_t[i-1]
    tabua_servico$dx_t[i] <- tabua_servico$lx_t[i] * tabua_servico$q_t[i]
  }
}

# criando colunas de comutação Dx e Cx
v <- 1/(1+0.06)
tabua_servico$Dx <- tabua_servico$lx_t * v^tabua_servico$x
tabua_servico$Cx <- tabua_servico$dx_t * v^(tabua_servico$x+1)
for (i in 1:nrow(tabua_servico))
{
tabua_servico$Mx[i] = sum(tabua_servico$Cx[i:nrow(tabua_servico)])
}

tabua_servico <- round(tabua_servico, 6)
#tabua_servico
kable(tabua_servico, format = "pandoc")
x mortalidade invalidez rotatividade aposentadoria q_d q_i q_r q_a q_t p_t lx_t dx_t Dx Cx Mx
31 30 0.000784 0.000605 0.02 0.00 0.000776 0.000599 0.019986 0.000000 0.021361 0.978639 100.00000 2.136076 17.411013 0.350861 5.711661
32 31 0.000789 0.000615 0.02 0.00 0.000781 0.000609 0.019986 0.000000 0.021375 0.978625 97.86392 2.091885 16.074623 0.324153 5.360800
33 32 0.000789 0.000628 0.02 0.00 0.000781 0.000621 0.019986 0.000000 0.021388 0.978612 95.77204 2.048389 14.840586 0.299446 5.036647
34 33 0.000790 0.000643 0.02 0.00 0.000782 0.000636 0.019986 0.000000 0.021404 0.978596 93.72365 2.006046 13.701107 0.276657 4.737201
35 34 0.000791 0.000660 0.02 0.00 0.000783 0.000653 0.019985 0.000000 0.021421 0.978579 91.71760 1.964726 12.648915 0.255621 4.460544
36 35 0.000792 0.000681 0.02 0.00 0.000784 0.000674 0.019985 0.000000 0.021443 0.978557 89.75288 1.924572 11.677318 0.236223 4.204923
37 36 0.000794 0.000704 0.02 0.00 0.000786 0.000697 0.019985 0.000000 0.021467 0.978533 87.82831 1.885453 10.780114 0.218323 3.968699
38 37 0.000823 0.000732 0.02 0.00 0.000814 0.000724 0.019984 0.000000 0.021523 0.978477 85.94285 1.849775 9.951596 0.202067 3.750377
39 38 0.000872 0.000764 0.02 0.00 0.000863 0.000756 0.019984 0.000000 0.021603 0.978397 84.09308 1.816631 9.186231 0.187214 3.548309
40 39 0.000945 0.000801 0.02 0.00 0.000935 0.000793 0.019983 0.000000 0.021710 0.978290 82.27645 1.786249 8.479042 0.173663 3.361095
41 40 0.001043 0.000844 0.02 0.00 0.001032 0.000835 0.019981 0.000000 0.021848 0.978152 80.49020 1.758582 7.825433 0.161295 3.187432
42 41 0.001168 0.000893 0.02 0.00 0.001156 0.000884 0.019979 0.000000 0.022019 0.977981 78.73162 1.733572 7.221189 0.150002 3.026137
43 42 0.001322 0.000949 0.02 0.00 0.001308 0.000939 0.019977 0.000000 0.022224 0.977776 76.99804 1.711232 6.662441 0.139687 2.876135
44 43 0.001505 0.001014 0.02 0.00 0.001489 0.001003 0.019975 0.000000 0.022467 0.977533 75.28681 1.691478 6.145634 0.130259 2.736448
45 44 0.001715 0.001088 0.02 0.00 0.001697 0.001076 0.019972 0.000000 0.022745 0.977255 73.59533 1.673934 5.667509 0.121611 2.606189
46 45 0.001948 0.001174 0.02 0.00 0.001927 0.001161 0.019969 0.000000 0.023057 0.976943 71.92140 1.658315 5.225095 0.113657 2.484578
47 46 0.002198 0.001271 0.02 0.00 0.002175 0.001257 0.019965 0.000000 0.023397 0.976603 70.26309 1.643937 4.815678 0.106294 2.370920
48 47 0.002463 0.001383 0.02 0.00 0.002437 0.001367 0.019962 0.000000 0.023766 0.976234 68.61915 1.630785 4.436798 0.099475 2.264626
49 48 0.002740 0.001511 0.02 0.00 0.002711 0.001494 0.019958 0.000000 0.024162 0.975838 66.98836 1.618568 4.086183 0.093142 2.165151
50 49 0.003028 0.001657 0.02 0.00 0.002995 0.001638 0.019953 0.000000 0.024586 0.975414 65.36979 1.607207 3.761748 0.087253 2.072009
51 50 0.003330 0.001823 0.02 0.00 0.003294 0.001802 0.019949 0.000000 0.025044 0.974956 63.76259 1.596870 3.461566 0.081784 1.984757
52 51 0.003647 0.002014 0.00 0.00 0.003643 0.002010 0.000000 0.000000 0.005654 0.994346 62.16572 0.351464 3.183844 0.016981 1.902972
53 52 0.003980 0.002231 0.00 0.00 0.003976 0.002227 0.000000 0.000000 0.006202 0.993798 61.81426 0.383379 2.986645 0.017475 1.885991
54 53 0.004331 0.002479 0.00 0.00 0.004326 0.002474 0.000000 0.000000 0.006799 0.993201 61.43088 0.417685 2.800115 0.017961 1.868516
55 54 0.004698 0.002762 0.00 0.00 0.004692 0.002756 0.000000 0.000000 0.007447 0.992553 61.01319 0.454367 2.623657 0.018432 1.850555
56 55 0.005077 0.003089 0.00 0.10 0.004816 0.002927 0.000000 0.099592 0.107335 0.892665 60.55882 6.500099 2.456715 0.248766 1.832122
57 56 0.005465 0.003452 0.00 0.03 0.005374 0.003391 0.000000 0.029866 0.038631 0.961369 54.05873 2.088353 2.068890 0.075400 1.583356
58 57 0.005861 0.003872 0.00 0.03 0.005762 0.003803 0.000000 0.029854 0.039419 0.960581 51.97037 2.048620 1.876383 0.069778 1.507956
59 58 0.006265 0.004350 0.00 0.03 0.006158 0.004271 0.000000 0.029841 0.040270 0.959730 49.92175 2.010355 1.700394 0.064599 1.438178
60 59 0.006694 0.004895 0.00 0.03 0.006578 0.004806 0.000000 0.029826 0.041210 0.958790 47.91140 1.974407 1.539546 0.059853 1.373579
61 60 0.007170 0.005516 0.00 1.00 0.003578 0.002751 0.000000 0.993670 1.000000 0.000000 45.93699 45.936991 1.392549 1.313726 1.313726 
datatable(tabua_servico, options = list(pageLength = 31, scrollY = "300px", scrollX = TRUE))

Cálculos Utilizando a Tábua de Serviço

Para calcular a probabilidade de entrada em invalidez na idade de 45 anos:

q_i_45 <- tabua_servico$q_i[tabua_servico$x == 45]
q_i_45
## [1] 0.001161

Para calcular a quantidade provável de ativos que entraram em invalidez aos 45 anos e irão sobreviver:

n_i_45 <- tabua_servico$lx_t[tabua_servico$x == 45] * tabua_servico$q_i[tabua_servico$x == 45] * (1 - tabua_servico$q_d[tabua_servico$x == 45]/2)
n_i_45
## [1] 0.08342029

Para calcular o prêmio de um seguro temporário de 10 anos para um indivíduo de 48 anos que cobre sua saída do fundo de pensão, utilizou-se a seguinte equação:

pup <- (tabua_servico$Mx[tabua_servico$x == 48] - tabua_servico$Mx[tabua_servico$x == 58]) / tabua_servico$Dx[tabua_servico$x == 48]

pup <- paste("RS", format(pup, decimal.mark = ",", big.mark = ".", nsmall = 2, digits = 6))

pup
## [1] "RS 0,17791"