Trabalho 3
Janaílson e José Lucas
2024-10-08
#1 Um modelo de múltiplo decremento com duas causas de decremento é especificado pelas seguintes forças de decremento: # ux1(t) = 1/(100-(x+t)) # ux2(t) = 2/(100-(x+t)); t < 100-x
#a) Fdp da distribuição conjunta
#Cálculo dos decrementos 1, 2 e total:
x <- 50
t <- seq(0, 50, 1)
ux1 <- 1/(100-x+t)
ux1## [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.01000000ux2 <- 2/(100-x+t)
ux2## [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.02000000uxt <- ux1 + ux2
uxt## [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.000000fTJ2 <- (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.000000b) Fdp da distribuição marginal
#Cálculo da distribuição marginal
fT <- tpx * uxt
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+00c) fdp da distribuição marginal
#Cáculo da probabilidade em que o decremento por todas as causas ocorra até o tempo t:
fq1 <- function(t)((50-t)^2)/(50^3)
fq2 <- function(t)(2*((50-t)^2))/(50^3)
q1 <- integrate(fq1, lower = 0, upper = 50)$value;
q1## [1] 0.3333333q2 <- integrate(fq2, lower = 0, upper = 50)$value;
q2## [1] 0.6666667#d) Fdp da distribuição condicional de J, dado um decremento no tempo
#Calculando a distribuição com a condicional de J dado um decremento no tempo t
fJT1 <- ux1/uxt
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.3333333fJT2 <- ux2/uxt
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.6666667e) Prepare uma tabela e desenhe o gráfico de tpx(T) para t = 1, 2, …, 10 e para x = 50
#Tabela tpx
tab.1 <- seq(1, 10,1)
idade <- x+tab.1
idade## [1] 51 52 53 54 55 56 57 58 59 60tpx.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.512000df <- data.frame(Idade = idade, tpx = tpx.1)
kable(df, caption = "Tabela tPx", align = "cc")| 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 |
#Produção do Gráfico
plot(idade, tpx.1, "o", pch = 20, cex=1.0, main ="Gráfico tPx", xlab = "Idade", ylab = "tpx", col = "green")
f) Prepare uma tabela e desenhe o gráfico de tqx(1) e tqx(2) para t = 1, 2, …, 10 e para x = 50
Preparo da Tabela
t <- c(1:10)
fq1.1 <- function(t)((50-t)^2)/(50^3)
fq2.1 <- function(t)(2*((50-t)^2))/(50^3)
for (i in t) {
q1[i] <- integrate(fq1.1, lower = 0, upper = i)$value
q2[i] <- integrate(fq2.1, 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.16266667q2## [1] 0.03920533 0.07684267 0.11294400 0.14754133 0.18066667 0.21235200
## [7] 0.24262933 0.27153067 0.29908800 0.32533333df.1 <- data.frame( Idade = idade, tqx1 = q1, tqx2 = q2)
kable(df.1, caption = "Tabela tqx1 e tqx2", align = "ccc")| 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 |
#Preparo do Gráfico tqx1
plot(idade, q1, "o", pch = 20, cex = 1.0, main = "Grafico tqx1", xlab = "Idade", ylab = "tqx1", col = "red")
##Preparo do Gráfico tqx2
plot(idade, q2, "o", pch = 20, cex = 1.0, main = "Grafico tqx2", xlab = "Idade", ylab = "tqx2", col = "red")
# g) Encontre a distribuição de J(x) para x = 50.
df.2 <- round(data.frame(Idade = x, J1 = fJT1[1], J2 = fJT2[1]), 3)
kable(df.2, caption = "Tabela de J", align = "ccc")| Idade | J1 | J2 |
|---|---|---|
| 50 | 0.333 | 0.667 |
h) Encontre a distribuição condicional de J(x) dado T(x) = 10 para x = 50
x.h <- 60
df.3 <- round(data.frame(Idade = x.h, J1 = fJT1[10], J2 = fJT2[10]), 3)
kable(df.3, caption = "Tabela de J", align = "ccc")| Idade | J1 | J2 |
|---|---|---|
| 60 | 0.333 | 0.667 |
#2) 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:
site = "https://raw.githubusercontent.com/hvsfg0/BdT/main/Bdtset2022.csv"
banco_de_tabuas = read.csv(site,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")#II. Entrada em invalidez: ALVARO VINDAS:
invalidez <- banco_de_tabuas$ALVARO.VINDAS
invalidez <- invalidez[is.na(invalidez)==FALSE]
alvaroVindas <- c(invalidez,rep(0,length(tabua@x)-length(invalidez)
))
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#III. Rotatividade:
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#IV. Aposentadoria
aposentados <- c(rep(0,55),0.1,0.03,0.03,0.03,0.03,1, rep(1,116-61))
i <- 0.06
v <- 1/(1+i)Construção dos decrementos e da tábua
tabua <- data.frame("Mortalidade"=at2000,"Invalidez"=alvaroVindas,
"Rotatividade"=rotatividade,"Aposentadoria"=aposentados)[31:116,]
tabua <- data.frame("x" = 30:115,tabua)
tabua#Mortalidade de decremento principal
Mortalidade_decremento <- 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))
Mortalidade_decremento## [1] 0.0007759260 0.0007808706 0.0007808656 0.0007818494 0.0007828325
## [6] 0.0007838139 0.0007857842 0.0008144728 0.0008629513 0.0009351766
## [11] 0.0010321357 0.0011558054 0.0013081611 0.0014891971 0.0016969295
## [16] 0.0019273918 0.0021746418 0.0024366895 0.0027105575 0.0029952448
## [21] 0.0032937052 0.0036433275 0.0039755603 0.0043256317 0.0046915121
## [26] 0.0048158313 0.0053737811 0.0057619650 0.0061576712 0.0065775341
## [31] 0.0035784084 0.0038489993 0.0041642203 0.0045344563 0.0049690596
## [36] 0.0054778430 0.0060705544 0.0067563972 0.0075424866 0.0084254043
## [41] 0.0093996610 0.0104591738 0.0115977389 0.0128144841 0.0141241795
## [46] 0.0155481953 0.0171045222 0.0188135869 0.0206771848 0.0227436742
## [51] 0.0249753122 0.0273880500 0.0299829999 0.0327622189 0.0357258546
## [56] 0.0388764711 0.0422085921 0.0457182825 0.0493919113 0.0531914481
## [61] 0.0570725452 0.0674305000 0.0727875000 0.0783635000 0.0841450000
## [66] 0.0901225000 0.0962825000 0.1026145000 0.1093415000 0.1166855000
## [71] 0.1248705000 0.1341185000 0.1446525000 0.1566955000 0.1704700000
## [76] 0.1861990000 0.2041050000 0.2244115000 0.2473405000 0.2731155000
## [81] 0.3019585000 0.3340930000 0.3697415000 0.4091270000 0.4524725000
## [86] 0.5000000000#Invalidez como decremento principal
Invalidez_decremento <- 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))
Invalidez_decremento## [1] 0.0005987160 0.0006086106 0.0006214756 0.0006363194 0.0006531425
## [6] 0.0006739239 0.0006966842 0.0007243828 0.0007560313 0.0007926166
## [11] 0.0008351257 0.0008835554 0.0009388911 0.0010031071 0.0010761995
## [16] 0.0011611318 0.0012569118 0.0013674895 0.0014938475 0.0016379548
## [21] 0.0018017752 0.0020103275 0.0022265603 0.0024736317 0.0027555121
## [26] 0.0029272313 0.0033909761 0.0038028000 0.0042713962 0.0048055191
## [31] 0.0027514084 0.0031034993 0.0035047203 0.0039614563 0.0044815596
## [36] 0.0050728430 0.0057475544 0.0065138972 0.0073859866 0.0083784043
## [41] 0.0095071610 0.0107906738 0.0122512389 0.0139119841 0.0158001795
## [46] 0.0179471953 0.0203875222 0.0231605869 0.0272966848 0.0298891742
## [51] 0.0339533122 0.0385670500 0.0438049999 0.0497492189 0.0564943546
## [56] 0.0641159711 0.0728220921 0.0826592825 0.0938089113 0.1064439481
## [61] 0.1207605452 0.0000000000 0.0000000000 0.0000000000 0.0000000000
## [66] 0.0000000000 0.0000000000 0.0000000000 0.0000000000 0.0000000000
## [71] 0.0000000000 0.0000000000 0.0000000000 0.0000000000 0.0000000000
## [76] 0.0000000000 0.0000000000 0.0000000000 0.0000000000 0.0000000000
## [81] 0.0000000000 0.0000000000 0.0000000000 0.0000000000 0.0000000000
## [86] 0.0000000000#Aposentadoria de decremento Principal
Aposentadoria_decremento <- 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))
Aposentadoria_decremento## [1] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
## [7] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
## [13] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
## [19] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
## [25] 0.00000000 0.09959222 0.02986643 0.02985423 0.02984105 0.02982649
## [31] 0.99367018 0.99304750 0.99233106 0.99150409 0.99054938 0.98944931
## [37] 0.98818189 0.98672971 0.98507153 0.98319619 0.98109318 0.97875015
## [43] 0.97615102 0.97327353 0.97007564 0.96650461 0.96250796 0.95802583
## [49] 0.95202613 0.94736715 0.94107138 0.93404490 0.92621200 0.91748856
## [55] 0.90777979 0.89700756 0.88496932 0.87162243 0.85679918 0.84036460
## [61] 0.82216691 0.93256950 0.92721250 0.92163650 0.91585500 0.90987750
## [67] 0.90371750 0.89738550 0.89065850 0.88331450 0.87512950 0.86588150
## [73] 0.85534750 0.84330450 0.82953000 0.81380100 0.79589500 0.77558850
## [79] 0.75265950 0.72688450 0.69804150 0.66590700 0.63025850 0.59087300
## [85] 0.54752750 0.50000000#Rotatividade como decremento principal
Rotatividade_decremento <- 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))
Rotatividade_decremento## [1] 0.01998611 0.01998596 0.01998583 0.01998567 0.01998549 0.01998527
## [7] 0.01998502 0.01998445 0.01998364 0.01998255 0.01998114 0.01997940
## [13] 0.01997730 0.01997482 0.01997198 0.01996880 0.01996533 0.01996156
## [19] 0.01995752 0.01995318 0.01994851 0.00000000 0.00000000 0.00000000
## [25] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
## [31] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
## [37] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
## [43] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
## [49] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
## [55] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
## [61] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
## [67] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
## [73] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
## [79] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
## [85] 0.00000000 0.00000000#q com todas as causas
tabua$qxt <- Mortalidade_decremento+Invalidez_decremento+Aposentadoria_decremento+Invalidez_decremento
tabua$qxt## [1] 0.001973358 0.001998092 0.002023817 0.002054488 0.002089117 0.002131662
## [7] 0.002179153 0.002263238 0.002375014 0.002520410 0.002702387 0.002922916
## [13] 0.003185943 0.003495411 0.003849328 0.004249655 0.004688465 0.005171669
## [19] 0.005698253 0.006271154 0.006897256 0.007663982 0.008428681 0.009272895
## [25] 0.010202536 0.110262517 0.042022167 0.043221797 0.044541511 0.046015065
## [31] 1.002751408 1.003103499 1.003504720 1.003961456 1.004481560 1.005072843
## [37] 1.005747554 1.006513897 1.007385987 1.008378404 1.009507161 1.010790674
## [43] 1.012251239 1.013911984 1.015800179 1.017947195 1.020387522 1.023160587
## [49] 1.027296685 1.029889174 1.033953312 1.038567050 1.043805000 1.049749219
## [55] 1.056494355 1.064115971 1.072822092 1.082659283 1.093808911 1.106443948
## [61] 1.120760545 1.000000000 1.000000000 1.000000000 1.000000000 1.000000000
## [67] 1.000000000 1.000000000 1.000000000 1.000000000 1.000000000 1.000000000
## [73] 1.000000000 1.000000000 1.000000000 1.000000000 1.000000000 1.000000000
## [79] 1.000000000 1.000000000 1.000000000 1.000000000 1.000000000 1.000000000
## [85] 1.000000000 1.000000000#p com todas as causas
tabua$pxt <- 1-tabua$qxt
tabua$pxt## [1] 0.998026642 0.998001908 0.997976183 0.997945512 0.997910883
## [6] 0.997868338 0.997820847 0.997736762 0.997624986 0.997479590
## [11] 0.997297613 0.997077084 0.996814057 0.996504589 0.996150672
## [16] 0.995750345 0.995311535 0.994828331 0.994301747 0.993728846
## [21] 0.993102744 0.992336018 0.991571319 0.990727105 0.989797464
## [26] 0.889737483 0.957977833 0.956778203 0.955458489 0.953984935
## [31] -0.002751408 -0.003103499 -0.003504720 -0.003961456 -0.004481560
## [36] -0.005072843 -0.005747554 -0.006513897 -0.007385987 -0.008378404
## [41] -0.009507161 -0.010790674 -0.012251239 -0.013911984 -0.015800179
## [46] -0.017947195 -0.020387522 -0.023160587 -0.027296685 -0.029889174
## [51] -0.033953312 -0.038567050 -0.043805000 -0.049749219 -0.056494355
## [56] -0.064115971 -0.072822092 -0.082659283 -0.093808911 -0.106443948
## [61] -0.120760545 0.000000000 0.000000000 0.000000000 0.000000000
## [66] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [71] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [76] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [81] 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
## [86] 0.000000000#lx e dx para 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))#Cx
tabua$Cx = tabua$dx * (v^(tabua$x + 1))#Mx
for (i in 1:nrow(tabua))
{
tabua$Mx[i] = sum(tabua$Cx[i:nrow(tabua)])
}#a) Calcule a taxa de entrada em invalidez para a idade de 45 anos.
tabua$Invalidez[tabua$x == 45]## [1] 0.001174#b) 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.1130435#c) 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.14747