install.packages("knitr")

## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)

library(knitr)

install.packages("ggplot2")

## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)

library(ggplot2)

install.packages("lifecontingencies")

## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)

library(lifecontingencies)

## Package:  lifecontingencies
## Authors:  Giorgio Alfredo Spedicato [aut, cre]
##     (<https://orcid.org/0000-0002-0315-8888>),
##   Christophe Dutang [ctb] (<https://orcid.org/0000-0001-6732-1501>),
##   Reinhold Kainhofer [ctb] (<https://orcid.org/0000-0002-7895-1311>),
##   Kevin J Owens [ctb],
##   Ernesto Schirmacher [ctb],
##   Gian Paolo Clemente [ctb] (<https://orcid.org/0000-0001-6795-4595>),
##   Ivan Williams [ctb]
## Version:  1.3.12
## Date:     2024-09-29 22:40:06 UTC
## BugReport: https://github.com/spedygiorgio/lifecontingencies/issues

Um modelo de múltiplo decremento com duas causas de decremento é especificado pelas seguintes forças de decremento:

\[μ_x^1(t) = \frac{1}{100-(x+t)}\]

\[μ_x^2(t) = \frac{2}{100-(x+t)};t<100-x\]

A partir deste modelo, para um indivíduo de idade x=50 anos, obtenha as expressões para:

Fdp da distribuição conjunta - 𝑓𝑇,𝐽(𝑡,𝑗)

\[f_{T,J}(t,j) = _{t}p_x^{(τ)}*μ_x^{(j)}(t)\]

\[_{t}p_x^{(τ)}= e^{-\int_{0}^{t}μ_x^{(τ)}(t)dt}\]

\[μ_x^{(τ)}(t)= \sum_{j=1}^{m}μ_x^{(j)}(t) = \frac{1}{50-t} + \frac{2}{50-t} = \frac{3}{50-t}\]

Então, a Probabilidade de que o indivíduo não sofra nenhum decremento até o tempo t

\[_{t}p_{50}^{(τ)}= e^{-\int_{0}^{t}\frac{3}{50-t} dt}\] ´ \[_{t}p_{50}^{(τ)}= e^{3(ln|50-t|-ln|50|)} = (\frac{50-t}{50})^3\]

Portanto, as expressões obtidas para a fdp da distribuição conjunta de T e J

\[f_{T,J}(t,j) = _{t}p_x^{(τ)}*μ_x^{(j)}(t) = \left\{ \begin{array}{cc} f_{T,J}(t,1) & = & \frac{(50-t)^2}{50^3} \\ f_{T,J}(t,2) & = & \frac{2(50-t)^2}{50^3} \\ \end{array} \right.\]

Cálculo dos decrementos 1 e 2 e total

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

u1 <- 1/(100-x+t);u1

##  [1] 0.02000000 0.01960784 0.01923077 0.01886792 0.01851852 0.01818182
##  [7] 0.01785714 0.01754386 0.01724138 0.01694915 0.01666667 0.01639344
## [13] 0.01612903 0.01587302 0.01562500 0.01538462 0.01515152 0.01492537
## [19] 0.01470588 0.01449275 0.01428571 0.01408451 0.01388889 0.01369863
## [25] 0.01351351 0.01333333 0.01315789 0.01298701 0.01282051 0.01265823
## [31] 0.01250000 0.01234568 0.01219512 0.01204819 0.01190476 0.01176471
## [37] 0.01162791 0.01149425 0.01136364 0.01123596 0.01111111 0.01098901
## [43] 0.01086957 0.01075269 0.01063830 0.01052632 0.01041667 0.01030928
## [49] 0.01020408 0.01010101 0.01000000

u2 <- 2/(100-x+t);u2

##  [1] 0.04000000 0.03921569 0.03846154 0.03773585 0.03703704 0.03636364
##  [7] 0.03571429 0.03508772 0.03448276 0.03389831 0.03333333 0.03278689
## [13] 0.03225806 0.03174603 0.03125000 0.03076923 0.03030303 0.02985075
## [19] 0.02941176 0.02898551 0.02857143 0.02816901 0.02777778 0.02739726
## [25] 0.02702703 0.02666667 0.02631579 0.02597403 0.02564103 0.02531646
## [31] 0.02500000 0.02469136 0.02439024 0.02409639 0.02380952 0.02352941
## [37] 0.02325581 0.02298851 0.02272727 0.02247191 0.02222222 0.02197802
## [43] 0.02173913 0.02150538 0.02127660 0.02105263 0.02083333 0.02061856
## [49] 0.02040816 0.02020202 0.02000000

ut <- u1 + u2;ut

##  [1] 0.06000000 0.05882353 0.05769231 0.05660377 0.05555556 0.05454545
##  [7] 0.05357143 0.05263158 0.05172414 0.05084746 0.05000000 0.04918033
## [13] 0.04838710 0.04761905 0.04687500 0.04615385 0.04545455 0.04477612
## [19] 0.04411765 0.04347826 0.04285714 0.04225352 0.04166667 0.04109589
## [25] 0.04054054 0.04000000 0.03947368 0.03896104 0.03846154 0.03797468
## [31] 0.03750000 0.03703704 0.03658537 0.03614458 0.03571429 0.03529412
## [37] 0.03488372 0.03448276 0.03409091 0.03370787 0.03333333 0.03296703
## [43] 0.03260870 0.03225806 0.03191489 0.03157895 0.03125000 0.03092784
## [49] 0.03061224 0.03030303 0.03000000

Cálculo do tpx

tpx <- ((50-t)/50)^3;tpx

##  [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 0.000000

Cálculo da distribuição conjunta de T e J

ftj1 <- ((50-t)^2/(50)^3);ftj1

##  [1] 0.020000 0.019208 0.018432 0.017672 0.016928 0.016200 0.015488 0.014792
##  [9] 0.014112 0.013448 0.012800 0.012168 0.011552 0.010952 0.010368 0.009800
## [17] 0.009248 0.008712 0.008192 0.007688 0.007200 0.006728 0.006272 0.005832
## [25] 0.005408 0.005000 0.004608 0.004232 0.003872 0.003528 0.003200 0.002888
## [33] 0.002592 0.002312 0.002048 0.001800 0.001568 0.001352 0.001152 0.000968
## [41] 0.000800 0.000648 0.000512 0.000392 0.000288 0.000200 0.000128 0.000072
## [49] 0.000032 0.000008 0.000000

ftj2 <- (2*(50-t)^2/(50)^3);ftj2

##  [1] 0.040000 0.038416 0.036864 0.035344 0.033856 0.032400 0.030976 0.029584
##  [9] 0.028224 0.026896 0.025600 0.024336 0.023104 0.021904 0.020736 0.019600
## [17] 0.018496 0.017424 0.016384 0.015376 0.014400 0.013456 0.012544 0.011664
## [25] 0.010816 0.010000 0.009216 0.008464 0.007744 0.007056 0.006400 0.005776
## [33] 0.005184 0.004624 0.004096 0.003600 0.003136 0.002704 0.002304 0.001936
## [41] 0.001600 0.001296 0.001024 0.000784 0.000576 0.000400 0.000256 0.000144
## [49] 0.000064 0.000016 0.000000

Fdp da distribuição marginal - 𝑓𝑇(𝑡)

\[f_{T}(t) = _{t}p_x^{(τ)}*μ_x^{(τ)}(t)\]

\[f_{T}(t) = (\frac{50-t}{50})^3*\frac{3}{50-t} = \frac{3(50-t)^2}{50^3} \]

Cálculo da da distribuição marginal - 𝑓𝑇(𝑡)

ft <- tpx*ut;ft

##  [1] 6.000000e-02 5.536424e-02 5.104246e-02 4.701419e-02 4.326044e-02
##  [6] 3.976364e-02 3.650743e-02 3.347663e-02 3.065710e-02 2.803566e-02
## [11] 2.560000e-02 2.333862e-02 2.124077e-02 1.929638e-02 1.749600e-02
## [16] 1.583077e-02 1.429236e-02 1.287296e-02 1.156518e-02 1.036209e-02
## [21] 9.257143e-03 8.244169e-03 7.317333e-03 6.471123e-03 5.700324e-03
## [26] 5.000000e-03 4.365474e-03 3.792312e-03 3.276308e-03 2.813468e-03
## [31] 2.400000e-03 2.032296e-03 1.706927e-03 1.420627e-03 1.170286e-03
## [36] 9.529412e-04 7.657674e-04 6.060690e-04 4.712727e-04 3.589213e-04
## [41] 2.666667e-04 1.922637e-04 1.335652e-04 8.851613e-05 5.514894e-05
## [46] 3.157895e-05 1.600000e-05 6.680412e-06 1.959184e-06 2.424242e-07
## [51] 0.000000e+00

Fdp da distribuição marginal - 𝑓𝐽(𝑗)

\[f_{J}(j) = _{t}q_x^{(j)}\]

\[ _{t}q_x^{(j)} ={\int_{0}^{t}f_{T,J}(t,j)dt}\]

\[ _{50}q_x^{(1)} ={\int_{0}^{50}\frac{(50-t)^2}{50^3}dt}\]

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

Cálculando a probabilidade de que o decremento por todas as causas ocorra até o tempo t

f.q1 <- function(t)(50-t)^2/(50^3)
f.q2 <- function(t)2*(50-t)^2/(50^3)

q1 <- integrate(f.q1, lower = 0, upper = 50)$value;q1

## [1] 0.3333333

q2 <- integrate(f.q2, lower = 0, upper = 50)$value;q2

## [1] 0.6666667

Fdp da distribuição condicional de 𝐽, dado um decremento no tempo 𝑡 – 𝑓𝐽|𝑇 (𝑗|𝑡)

\[f_{J|T}(j|t) = \frac{μ_x^{(j)}(t)}{μ_x^{(τ)}(t)}\]

\[f_{J|T}(1|t) = \frac{μ_x^{(1)}(t)}{μ_x^{(τ)}(t)}\]

\[f_{J|T}(2|t) = \frac{μ_x^{(2)}(t)}{μ_x^{(τ)}(t)}\]

\[f_{J|T}(1|t) = \frac{\frac{1}{50-t}}{\frac{3}{50-t}}= \frac{1}{50-t}*\frac{50-t}{3} = \frac{1}{3}\]

\[f_{J|T}(2|t) = \frac{\frac{2}{50-t}}{\frac{3}{50-t}}= \frac{2}{50-t}*\frac{50-t}{3} = \frac{2}{3}\]

Cálculo da distribuição condicional de 𝐽, dado um decremento no tempo 𝑡

fjt1 <- u1/ut;fjt1

##  [1] 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333
##  [8] 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333
## [15] 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333
## [22] 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333
## [29] 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333
## [36] 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333
## [43] 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333 0.3333333
## [50] 0.3333333 0.3333333

fjt2 <- u2/ut;fjt2

##  [1] 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667
##  [8] 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667
## [15] 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667
## [22] 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667
## [29] 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667
## [36] 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667
## [43] 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667
## [50] 0.6666667 0.6666667

Prepare uma tabela e desenhe o gráfico de 𝑡p𝑥(𝜏) para t = 1, 2,…, 10 e para x = 50

Tabela

t.1 <- seq(1, 10, 1)
idade <- x+t.1;idade

##  [1] 51 52 53 54 55 56 57 58 59 60

tpx.1 <- tpx[2:11];tpx.1

##  [1] 0.941192 0.884736 0.830584 0.778688 0.729000 0.681472 0.636056 0.592704
##  [9] 0.551368 0.512000

df <- data.frame(Idade = idade, tpx = tpx.1)

kable(df, caption = "Tabela de tpx", align = "cc")

Tabela de tpx
Idade	tpx
51	0.941192
52	0.884736
53	0.830584
54	0.778688
55	0.729000
56	0.681472
57	0.636056
58	0.592704
59	0.551368
60	0.512000

Gráfico

plot(idade, tpx.1, "o", pch = 20, cex=0.7, main="Gráfico de 𝑡p𝑥(𝜏)",xlab="Idade", ylab="tpx", col = "blue")

Prepare uma tabela e desenhe o gráfico de 𝑡𝑞𝑥(1) e 𝑡𝑞𝑥(2)) para t = 1, 2,. . . , 10 e para x = 50

Tabela

t <- c(1:10)

f.q1.1 <- function(t)(50-t)^2/(50^3)
f.q2.2 <- function(t)2*(50-t)^2/(50^3)

for (i in t) {
  q1[i] <- integrate(f.q1.1, lower = 0, upper = i)$value
  q2[i] <- integrate(f.q2.2, lower = 0, upper = i)$value
}

q1

##  [1] 0.01960267 0.03842133 0.05647200 0.07377067 0.09033333 0.10617600
##  [7] 0.12131467 0.13576533 0.14954400 0.16266667

q2

##  [1] 0.03920533 0.07684267 0.11294400 0.14754133 0.18066667 0.21235200
##  [7] 0.24262933 0.27153067 0.29908800 0.32533333

df.1 <- data.frame(Idade = idade, tqx1 = q1, tqx2 = q2 )

kable(df.1, caption = "Tabela de tqx1 e tqx2", align = "ccc")

Tabela de tqx1 e tqx2
Idade	tqx1	tqx2
51	0.0196027	0.0392053
52	0.0384213	0.0768427
53	0.0564720	0.1129440
54	0.0737707	0.1475413
55	0.0903333	0.1806667
56	0.1061760	0.2123520
57	0.1213147	0.2426293
58	0.1357653	0.2715307
59	0.1495440	0.2990880
60	0.1626667	0.3253333

Gráfico tqx1

plot(idade, q1, "o", pch = 20, cex=0.7, main="Gráfico de tqx1",xlab="Idade", ylab="tqx1", col = "darkred")

Gráfico tqx2

plot(idade, q2, "o", pch = 20, cex=0.7, main="Gráfico de tqx2",xlab="Idade", ylab="tqx2", col = "darkcyan")

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

df <- round(data.frame(Idade = x, J1 = fjt1[1], J2 = fjt2[1]), 3)

kable(df, caption = "Tabela de J", align = "ccc")

Tabela de J
Idade	J1	J2
50	0.333	0.667

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

x.1 <- 60
df.1 <- round(data.frame(Idade = x.1, J1 = fjt1[10], J2 = fjt2[10]), 3)

kable(df.1, caption = "Tabela de J", align = "ccc")

Tabela de J
Idade	J1	J2
60	0.333	0.667

Elabore uma tábua de serviço para um grupo de 100 funcionários da empresa X, que participam do seu fundo de pensão. Considere que todos tenham a idade de 30 anos, o plano tenha taxa de juros de 6% a.a. e as seguintes taxas decrementais como hipóteses demográficas do plano:

url = "https://raw.githubusercontent.com/hvsfg0/BdT/main/Bdtset2022.csv"

banco_de_tabuas = read.csv(url,row.names=NULL)

I. Mortalidade a tabela: AT-2000 Male

at2000 <- banco_de_tabuas$AT.2000.MALE
at2000 <- at2000[is.na(at2000)==FALSE]
tabua <- probs2lifetable(at2000, type = "qx", name = "AT-2000");tabua

## Life table AT-2000 
## 
##       x           lx       px         ex
## 1     0 1.000000e+04 0.997689 79.5691091
## 2     1 9.976890e+03 0.999094 78.7534193
## 3     2 9.967851e+03 0.999496 77.8248346
## 4     3 9.962827e+03 0.999592 76.8640781
## 5     4 9.958762e+03 0.999643 75.8954514
## 6     5 9.955207e+03 0.999676 74.9225558
## 7     6 9.951982e+03 0.999699 73.9468385
## 8     7 9.948986e+03 0.999714 72.9691032
## 9     8 9.946141e+03 0.999672 71.9899784
## 10    9 9.942878e+03 0.999638 71.0135988
## 11   10 9.939279e+03 0.999610 70.0393151
## 12   11 9.935403e+03 0.999587 69.0666410
## 13   12 9.931299e+03 0.999569 68.0951774
## 14   13 9.927019e+03 0.999554 67.1245390
## 15   14 9.922591e+03 0.999542 66.1544899
## 16   15 9.918047e+03 0.999530 65.1848026
## 17   16 9.913385e+03 0.999519 64.2154538
## 18   17 9.908617e+03 0.999505 63.2463563
## 19   18 9.903712e+03 0.999490 62.2776788
## 20   19 9.898661e+03 0.999472 61.3094566
## 21   20 9.893435e+03 0.999451 60.3418451
## 22   21 9.888003e+03 0.999427 59.3749910
## 23   22 9.882338e+03 0.999401 58.4090324
## 24   23 9.876418e+03 0.999373 57.4440403
## 25   24 9.870226e+03 0.999343 56.4800803
## 26   25 9.863741e+03 0.999314 55.5172121
## 27   26 9.856974e+03 0.999286 54.5553231
## 28   27 9.849936e+03 0.999262 53.5943034
## 29   28 9.842667e+03 0.999242 52.6338852
## 30   29 9.835206e+03 0.999226 51.6738120
## 31   30 9.827594e+03 0.999216 50.7138385
## 32   31 9.819889e+03 0.999211 49.7536293
## 33   32 9.812141e+03 0.999211 48.7929160
## 34   33 9.804399e+03 0.999210 47.8314440
## 35   34 9.796654e+03 0.999209 46.8692607
## 36   35 9.788905e+03 0.999208 45.9063636
## 37   36 9.781152e+03 0.999206 44.9427503
## 38   37 9.773386e+03 0.999177 43.9784632
## 39   38 9.765342e+03 0.999128 43.0146873
## 40   39 9.756827e+03 0.999055 42.0522288
## 41   40 9.747607e+03 0.998957 41.0920058
## 42   41 9.737440e+03 0.998832 40.1349095
## 43   42 9.726067e+03 0.998678 39.1818419
## 44   43 9.713209e+03 0.998495 38.2337088
## 45   44 9.698590e+03 0.998285 37.2913373
## 46   45 9.681957e+03 0.998052 36.3554018
## 47   46 9.663097e+03 0.997802 35.4263603
## 48   47 9.641857e+03 0.997537 34.5043990
## 49   48 9.618109e+03 0.997260 33.5895932
## 50   49 9.591756e+03 0.996972 32.6818815
## 51   50 9.562712e+03 0.996670 31.7811428
## 52   51 9.530868e+03 0.996353 30.8873276
## 53   52 9.496109e+03 0.996020 30.0003860
## 54   53 9.458315e+03 0.995669 29.1202647
## 55   54 9.417351e+03 0.995302 28.2469332
## 56   55 9.373108e+03 0.994923 27.3802636
## 57   56 9.325521e+03 0.994535 26.5199826
## 58   57 9.274557e+03 0.994139 25.6657107
## 59   58 9.220199e+03 0.993735 24.8170243
## 60   59 9.162434e+03 0.993306 23.9734832
## 61   60 9.101101e+03 0.992830 23.1350431
## 62   61 9.035846e+03 0.992286 22.3021193
## 63   62 8.966143e+03 0.991652 21.4754953
## 64   63 8.891294e+03 0.990907 20.6562819
## 65   64 8.810445e+03 0.990032 19.8458331
## 66   65 8.722623e+03 0.989007 19.0456481
## 67   66 8.626735e+03 0.987812 18.2573441
## 68   67 8.521592e+03 0.986428 17.4826102
## 69   68 8.405937e+03 0.984840 16.7231487
## 70   69 8.278503e+03 0.983054 15.9805742
## 71   70 8.138216e+03 0.981080 15.2560493
## 72   71 7.984241e+03 0.978929 14.5502602
## 73   72 7.816005e+03 0.976612 13.8634479
## 74   73 7.633204e+03 0.974129 13.1954511
## 75   74 7.435725e+03 0.971448 12.5458970
## 76   75 7.223421e+03 0.968523 11.9146357
## 77   76 6.996049e+03 0.965314 11.3018614
## 78   77 6.753384e+03 0.961775 10.7079638
## 79   78 6.495236e+03 0.957868 10.1335435
## 80   79 6.221579e+03 0.953573  9.5792693
## 81   80 5.932729e+03 0.948872  9.0456591
## 82   81 5.629401e+03 0.943750  8.5330657
## 83   82 5.312747e+03 0.938191  8.0416590
## 84   83 4.984371e+03 0.932174  7.5714518
## 85   84 4.646301e+03 0.925678  7.1223590
## 86   85 4.300979e+03 0.918674  6.6942079
## 87   86 3.951198e+03 0.911137  6.2868154
## 88   87 3.600082e+03 0.903042  5.8999672
## 89   88 3.251026e+03 0.894369  5.5334361
## 90   89 2.907617e+03 0.885142  5.1869722
## 91   90 2.573653e+03 0.875388  4.8600453
## 92   91 2.252945e+03 0.865139  4.5518756
## 93   92 1.949111e+03 0.854425  4.2614384
## 94   93 1.665369e+03 0.843273  3.9874927
## 95   94 1.404361e+03 0.831710  3.7285905
## 96   95 1.168021e+03 0.819755  3.4830415
## 97   96 9.574910e+02 0.807435  3.2488811
## 98   97 7.731117e+02 0.794771  3.0237061
## 99   98 6.144468e+02 0.781317  2.8044998
## 100  99 4.800777e+02 0.766629  2.5894519
## 101 100 3.680415e+02 0.750259  2.3777118
## 102 101 2.761264e+02 0.731763  2.1691880
## 103 102 2.020591e+02 0.710695  1.9643314
## 104 103 1.436024e+02 0.686609  1.7639584
## 105 104 9.859870e+01 0.659060  1.5690872
## 106 105 6.498246e+01 0.627602  1.3807956
## 107 106 4.078312e+01 0.591790  1.2001135
## 108 107 2.413504e+01 0.551177  1.0279381
## 109 108 1.330268e+01 0.505319  0.8649872
## 110 109 6.722098e+00 0.453769  0.7117647
## 111 110 3.050280e+00 0.396083  0.5685618
## 112 111 1.208164e+00 0.331814  0.4354613
## 113 112 4.008857e-01 0.260517  0.3123656
## 114 113 1.044375e-01 0.181746  0.1990219
## 115 114 1.898110e-02 0.095055  0.0950550

Entrada em invalidez: ALVARO VINDAS;

alvaroVindas <- banco_de_tabuas$ALVARO.VINDAS
alvaroVindas <- alvaroVindas[is.na(alvaroVindas)==FALSE]
alvaroVindas <- c(alvaroVindas,rep(0,length(tabua@x)-length(alvaroVindas))); alvaroVindas

##   [1] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
##   [9] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000575
##  [17] 0.000573 0.000572 0.000570 0.000569 0.000569 0.000569 0.000569 0.000570
##  [25] 0.000572 0.000575 0.000579 0.000583 0.000589 0.000596 0.000605 0.000615
##  [33] 0.000628 0.000643 0.000660 0.000681 0.000704 0.000732 0.000764 0.000801
##  [41] 0.000844 0.000893 0.000949 0.001014 0.001088 0.001174 0.001271 0.001383
##  [49] 0.001511 0.001657 0.001823 0.002014 0.002231 0.002479 0.002762 0.003089
##  [57] 0.003452 0.003872 0.004350 0.004895 0.005516 0.006223 0.007029 0.007947
##  [65] 0.008993 0.010183 0.011542 0.013087 0.014847 0.016852 0.019135 0.021734
##  [73] 0.024695 0.028066 0.031904 0.036275 0.041252 0.046919 0.055371 0.060718
##  [81] 0.069084 0.078608 0.089453 0.101800 0.115859 0.131805 0.150090 0.170840
##  [89] 0.194465 0.221363 0.251988 0.000000 0.000000 0.000000 0.000000 0.000000
##  [97] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
## [105] 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000
## [113] 0.000000 0.000000 0.000000 0.000000

Rotatividade: função monótona não crescente por idade no valor de 2% até 50 anos;

rotatividade <- c(rep(0.02,51),rep(0,116-51));rotatividade

##   [1] 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02
##  [16] 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02
##  [31] 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02
##  [46] 0.02 0.02 0.02 0.02 0.02 0.02 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
##  [61] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
##  [76] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
##  [91] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
## [106] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00

Aposentadoria, segundo as probabilidades assumidas pela entidade fechada de previdência complementar, no período de 1998 a 2003:

aposentadoria <- c(rep(0,55),0.1,0.03,0.03,0.03,0.03,1, rep(1,116-61))

Obtendo os dados para os decrementos

i <-  0.06
v <-  1/(1+i)

# Construção da tábua

tabua <- data.frame("Mortalidade"=at2000,"Invalidez"=alvaroVindas,
"Rotatividade"=rotatividade,"Aposentadoria"=aposentadoria)[31:116,]

tabua <- data.frame("x" = 30:115,tabua)

Mortalidade como decremento principal

qx1 <-  tabua$Mortalidade *
(1 - (1/2) * (tabua$Invalidez + tabua$Rotatividade + tabua$Aposentadoria) +
(1/3) * (tabua$Invalidez * tabua$Rotatividade +
tabua$Invalidez * tabua$Aposentadoria +
tabua$Rotatividade * tabua$Aposentadoria) -
(1/4) * (tabua$Invalidez * tabua$Rotatividade * tabua$Aposentadoria))

Invalidez como decremento principal

qx2 <-  tabua$Invalidez *
(1 - (1/2) * (tabua$Aposentadoria + tabua$Rotatividade + tabua$Mortalidade) +
(1/3) * (tabua$Aposentadoria * tabua$Rotatividade +
tabua$Aposentadoria * tabua$Mortalidade +
tabua$Rotatividade * tabua$Mortalidade) -
(1/4) * (tabua$Aposentadoria * tabua$Rotatividade * tabua$Mortalidade))

Aposentadoria como decremento principal

qx3 <- tabua$Aposentadoria *
(1 - (1/2) * (tabua$Invalidez + tabua$Rotatividade + tabua$Mortalidade) +
(1/3) * (tabua$Invalidez * tabua$Rotatividade +
tabua$Invalidez * tabua$Mortalidade +
tabua$Rotatividade * tabua$Mortalidade) -
(1/4) * (tabua$Invalidez * tabua$Rotatividade * tabua$Mortalidade))

Rotatividade como decremento principal

qx4 <-  tabua$Rotatividade *
(1 - (1/2) * (tabua$Aposentadoria + tabua$Invalidez + tabua$Mortalidade) +
(1/3) * (tabua$Aposentadoria * tabua$Invalidez +
tabua$Aposentadoria * tabua$Mortalidade +
tabua$Invalidez * tabua$Mortalidade) -
(1/4) * (tabua$Aposentadoria * tabua$Invalidez * tabua$Mortalidade))

q todas as causas

tabua$qxt <- qx1+qx2+qx3+qx4

p todas as causas

tabua$pxt <- 1-tabua$qxt

lx e dx todas as causas

for (i in 1:nrow(tabua)) {
if(i==1){
tabua$lx[i] = 100
} else{
tabua$lx[i] = tabua$lx[i-1] - tabua$dx[i-1]
}
tabua$dx[i] = tabua$lx[i] * tabua$qxt[i]
}

Dx

tabua$Dx = tabua$lx * (v^(tabua$x))

tabua$Cx = tabua$dx * (v^(tabua$x + 1))

for (i in 1:nrow(tabua))
{
tabua$Mx[i] = sum(tabua$Cx[i:nrow(tabua)])
}

Calcule a taxa de entrada em invalidez para a idade de 45 anos.

tabua$Invalidez[tabua$x == 45]

## [1] 0.001174

O número de ativos que provavelmente entraram em invalidez aos 45 anos e iram sobreviver

tabua$Invalidez[tabua$x == 45] * tabua$lx[tabua$x == 45]

## [1] 0.08443572

Para um indivíduo de idade x=48 anos, calcule o prêmio único de um seguro temporário de 10 anos (B=1) que cobre a sua saída do fundo de pensão por todas as causas.

(tabua$Mx[tabua$x == 48] - tabua$Mx[tabua$x == 58]) / tabua$Dx[tabua$x == 48]

## [1] 0.17791

Trabalho Final

Beatriz/Cristiane/Margarett

2024-09-27

Dx