suppressPackageStartupMessages({
library(lifecontingencies)
library(tidyverse)
library(readxl)
})Tábuas Mínimas
Introdução
A inspiração para a elaboração deste documento surgiu a partir da leitura do Art. 36 da Portaria 1467/2022 a seguir reproduzido:
“Art. 36. A utilização de tábuas biométricas para a projeção da longevidade e da entrada em invalidez deverá observar os seguintes critérios:
I - para a taxa de sobrevivência de válidos e inválidos, o limite mínimo:
será dado pela tábua anual de mortalidade do Instituto Brasileiro de Geografia e Estatísticas - IBGE, segregada obrigatoriamente por sexo, divulgada pela SPREV; e
será averiguado por meio da comparação entre a Expectativa de Vida - Ex estimada por essa tábua com aquela gerada pelas tábuas utilizadas na avaliação atuarial, com base na idade média geral da massa de segurados do RPPS; e
II - para a taxa de entrada em invalidez, o limite mínimo:
será dado pela tábua Álvaro Vindas; e
será averiguado com a comparação das probabilidades de entrada em invalidez de segurados em atividade indicadas por essa tábua mínima com aquelas geradas pela tábua utilizada na avaliação atuarial, com base no somatório de ix, de idade a idade, desde a idade média do grupo de segurados até a idade prevista na regra constitucional para aposentadoria voluntária do servidor do gênero masculino.
A primeira “questão” que surge é: o que seria esse “limite mínimo”? Se existe um limite mínimo, será que existe um limite máximo? Como interpretar isso? E mais, como avaliar isso na prática?
Assim, esse documento tem por objetivo mostrar como comparar uma tábua biométrica de mortalidade ou invalidez, com uma tábua referencial tida por “mínima” conforme determina a Portaria 1467/2022 no citado artigo 36.
Esse dispositivo tem por objetivo limitar o uso de tábuas biométricas de forma a que não se utilize tábuas que “encurtem” demasiadamente a expectativa de vida da massa de beneficiários do RPPS subestimando o custo dos benefícios a serem pagos.
Por outro lado, a tábua a ser utilizada deve ser aderente à massa de beneficiários conforme comprovado por testes de aderência. Na prática o dispositivo tem por objetivo eliminar as tábuas que tenham passado no teste de aderência mas não abedeçam a esse limite mínimo.
Por quê “limite mínimo”?
Ao dizer que determinadas tábuas serão o “limite mínimo”, o normativo diz que tábuas que produzam expectativa de vida (no caso das tábuas de mortalidade) inferior à da tábua referencial (ou “mínima”) não poderão ser utilizadas.
No caso das tábuas de entrada em invalidez, a regra de comparação se baseia no somatório dos \(i_x\) das idades compreendidas entre a idade média dos segurados e 65 anos. Assim, o somatório dos \(i_x\) das tábuas não podem ser inferiores ao mesmo somatório feito para a tábua referencial (ou “mínima”).
Vamos a seguir mostrar como fazer essas verificações usando o R.
Tábuas de Mortalidade
Para dar uma ideia do que devemos entender por “tábua mínima” vamos a seguir fazer um gráfico das expectativas de vida (\(e_x\)) para cada ano da tábua de mortalidade. Vamos ilustrar com as tábuas IBGE 2022 Ambos os Sexos e a tábua CSO 58.
Antes vamos importar os pacotes necessários:
Agora vamos importar os dados relativos às idades (\(x\)) e correspondentes taxas de mortalidade (\(q_x\)) de ambas as tábuas:
IBGE2022A.txt e CSO58.txt contém, cada um duas colunas: uma com as idades (\(x\)) e outra com as taxas de mortalidade (\(q_x\))A figura a seguir mostra parte do arquivo CSO58.txt.
Os demais arquivos utilizados neste documento possuem a mesma estrutura.
ibge <- read.delim2("IBGE2022A.txt", header=FALSE, col.names = c("x", "qx"))
cso58 <- read.delim2("CSO58.txt", header=FALSE, col.names = c("x", "qx")) Importados os dados, vamos elaborar um gráfico “comparando” as expectativas de vida dadas pelas duas tábuas. Para isso vamos precisar do pacote {lifecontingencies} para obtermos os valores de \(e_x\).
Vamos, inicialmente, criar objetos da classe lifetable que representam as tábuas de mortalidade e para isso vamos usar a função probs2lifetable():
ibge_ltb <- probs2lifetable(probs = ibge$qx, type = "qx", name="IBGE2022A")
summary(ibge_ltb)This is lifetable: IBGE2022A
Omega age is: 110
Expected curtated lifetime at birth is: 74.95785
cso58_ltb <- probs2lifetable(probs = cso58$qx, type = "qx", name="CSO58")
summary(cso58_ltb)This is lifetable: CSO58
Omega age is: 99
Expected curtated lifetime at birth is: 67.79667
Agora podemos calcular as expectativas de vida para cada idade nas duas tábuas. O cálculo das expectativas de vida será feito com a função exn() com a ajuda da função map_dbl() do pacote {purrr}
ibge <- ibge %>%
mutate(ex = map_dbl(x, \(k) exn(ibge_ltb, x = k)))
head(ibge) %>% knitr::kable()| x | qx | ex |
|---|---|---|
| 0 | 0.0128397 | 74.95785 |
| 1 | 0.0008959 | 74.93280 |
| 2 | 0.0006759 | 74.00000 |
| 3 | 0.0005138 | 73.05005 |
| 4 | 0.0003969 | 72.08760 |
| 5 | 0.0003147 | 71.11622 |
cso58 <- cso58 %>%
mutate(ex = map_dbl(x, \(k) exn(cso58_ltb, x = k)))
head(cso58) %>% knitr::kable()| x | qx | ex |
|---|---|---|
| 0 | 0.00708 | 67.79667 |
| 1 | 0.00176 | 67.28010 |
| 2 | 0.00152 | 66.39872 |
| 3 | 0.00146 | 65.49980 |
| 4 | 0.00140 | 64.59557 |
| 5 | 0.00135 | 63.68613 |
Calculados os valores dos \(e_x\) para as duas tábuas, estamos em condições de elaborar o gráfico, o que faremos a seguir:
full_join(ibge, cso58, by='x', suffix = c("_ibge", "_cso58")) %>%
pivot_longer(starts_with("ex"), names_to = "tabua", values_to = "ex") %>%
ggplot(aes(x = x, y = ex, color = tabua)) +
geom_line(linewidth = 1.2) +
theme_bw()Warning: Removed 12 rows containing missing values (`geom_line()`).
O gráfico mostra claramente que as expectativas de vida para a CSO58 são inferiores às apresentadas pela IBGE2022A.
Esse gráfico nos permite entender a ideia do “limite mínimo” se considerarmos que nenhuma outra tábua pode ter a curva dos \(e_x\) passando “por baixo” da curva da tábua mínima (IBGE), como ocorre no gráfico acima. Logo, a CSO58 não poderia ser usada nas avaliações atuariais dos RPPS em função do disposto no Art. 36, visto que está “abaixo do limite mínimo”.
Cálculo da idade média
Vimos acima como calcular as expectativas de vida para todas as idades de uma tábua de mortalidade e “compará-las” visualmente por intermédio de um gráfico. Mas o Art. 36 da Portaria 1467/2022 dispõe que as expectivas de vida devem ser comparadas na idade média da massa de segurados, para as tábuas de mortalidade.
Então vamos ver como calcular a idade média a partir de uma base de dados fictícia.
ativos <- read_excel("BaseDadosVanzilota.xlsx", sheet = "ATIVOS")
aposentados <- read_excel("BaseDadosVanzilota.xlsx", sheet = "APOSENTADOS")
pensionistas <- read_excel("BaseDadosVanzilota.xlsx", sheet = "PENSIONISTAS")head(ativos) %>% knitr::kable()| IDENTIF | DT NASC | DT ADMISSÃO | DT ADESÃO | SEXO | SALARIO | RESGATE |
|---|---|---|---|---|---|---|
| 1 | 1962-10-15 | 1980-02-15 | 1983-03-15 | M | 18844.5 | 289620.5 |
| 2 | 1955-02-17 | 1981-05-15 | 1981-06-06 | M | 20604.0 | 453101.0 |
| 3 | 1963-05-17 | 1983-11-18 | 1983-11-18 | M | 12665.0 | 177650.0 |
| 4 | 1954-03-12 | 1986-02-22 | 1986-02-22 | M | 9401.0 | 178211.0 |
| 5 | 1968-02-05 | 1990-03-18 | 1990-03-18 | F | 5652.5 | 44591.0 |
| 6 | 1970-04-05 | 1992-03-28 | 1992-03-28 | M | 19764.0 | 331423.5 |
head(aposentados)%>% knitr::kable() | IDENTIF | DT NASC | DIB | SEXO | BENEFICIO |
|---|---|---|---|---|
| 101 | 1946-11-03 | 2002-12-31 | M | 6570 |
| 102 | 1934-05-28 | 1992-08-08 | M | 4635 |
| 103 | 1942-12-22 | 1997-12-22 | F | 2583 |
| 104 | 1949-08-26 | 2019-01-03 | M | 3987 |
| 105 | 1950-05-28 | 1996-05-21 | M | 1323 |
| 106 | 1939-12-27 | 2017-08-02 | M | 12465 |
head(pensionistas)%>% knitr::kable()| IDENTIF | DT NASC | DIB | SEXO | PENSAO |
|---|---|---|---|---|
| 201 | 1949-05-21 | 2002-10-26 | F | 330 |
| 202 | 1957-06-24 | 2020-03-27 | F | 880 |
| 203 | 1953-05-25 | 2012-05-20 | F | 1120 |
| 204 | 1940-03-24 | 1998-01-20 | F | 680 |
| 205 | 1979-09-05 | 2005-10-18 | M | 670 |
| 206 | 1949-09-27 | 2015-06-28 | F | 1550 |
Para o cálculo da idade média precisamos apenas da variável relativa à data de nascimento dos beneficiários.
Vamos reunir em um único conjunto de dados as variáveis relativas à identificação do registro, à data de nascimento e ao sexo das três bases de dados.
Essas variáveis possuem o mesmo nome nas três bases de dados.
dt_nascimento <- bind_rows(select(ativos, IDENTIF, `DT NASC`, SEXO),
select(aposentados, IDENTIF, `DT NASC`, SEXO),
select(pensionistas, IDENTIF, `DT NASC`, SEXO))head(dt_nascimento) %>% knitr::kable()| IDENTIF | DT NASC | SEXO |
|---|---|---|
| 1 | 1962-10-15 | M |
| 2 | 1955-02-17 | M |
| 3 | 1963-05-17 | M |
| 4 | 1954-03-12 | M |
| 5 | 1968-02-05 | F |
| 6 | 1970-04-05 | M |
Agora vamos calcular a idade de cada beneficário. Vamos usar como data de referência o dia 31/12/2019.
dt_nascimento <- dt_nascimento %>%
mutate(idade = as.integer(dmy("31/12/2019") - as.Date(`DT NASC`)) / 365.25)Obtida a idade de cada beneficiário, basta agora calcular a média das idades:
mean(dt_nascimento$idade)[1] 53.26288
O que nos dá uma idade média de 53 anos. Mas como se distribuem as idades dos segurados? Vamos elaborar um histograma para ter essa visualização.
dt_nascimento %>%
ggplot(aes(x = idade)) +
geom_histogram(fill="orange", color="white") +
geom_vline(xintercept = 53.26288, color="blue", linewidth = 1.5) +
theme_bw()`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Uma boa prática ao descrever um conjunto de dados, como é feito com frequência em relatórios de avaliação atuarial, é apresentar um resumo das variáveis estudadas em vez de apenas apresentar uma única estatística descritiva como a média.
summary(dt_nascimento$idade) Min. 1st Qu. Median Mean 3rd Qu. Max.
28.22 40.72 52.10 53.26 66.61 85.59
Podemos ver agora que a distribuição das idades varia de um mínimo de 28 anos, até um máximo de 85 anos. A idade mediana é de 52 anos, bem próxima da idade média de 53 anos.
O gráfico nos mostra uma distribuição bimodal, onde a idade média divide a população de beneficiários em duas submassas.
Agora é só calcular \(e_{53}^{ibge}\) e \(e_{53}^{cso58}\)
e53_ibge <- exn(ibge_ltb, x = 53.26288)
e53_cso58 <- exn(cso58_ltb, x = 53.26288)e53_ibge[1] 26.82436
e53_cso58[1] 20.54464
O resultado naturalmente confirma o que já se percebia a partir da análise do gráfico das expectativas de vida.
Tábuas de Invalidez
O procedimento para a comparação de tábuas de entrada em invalidez possui uma metodologia um pouco diferente conforme se depreende do texto do citado Art. 36.
Vamos comparar a tábua Alvaro Vindas com a Hunters, uma outra tábua de entrada em invalidez.
O primeiro passo é importar os dados:
alvaro_vindas <- read.delim2("ALVARO.VINDAS.txt", header=FALSE, col.names = c("x", "ix"))
hunters <- read.delim2("HUNTERS.txt", header=FALSE, col.names = c("x", "ix")) head(alvaro_vindas) %>% knitr::kable()| x | ix |
|---|---|
| 0 | 0 |
| 1 | 0 |
| 2 | 0 |
| 3 | 0 |
| 4 | 0 |
| 5 | 0 |
head(hunters) %>% knitr::kable()| x | ix |
|---|---|
| 0 | 0.00710 |
| 1 | 0.00687 |
| 2 | 0.00665 |
| 3 | 0.00644 |
| 4 | 0.00624 |
| 5 | 0.00605 |
Antes de avançarmos na metodologia de cálculo, vamos fazer um gráfico comparando as taxas de entrada em invalidez de ambas as tábuas para ver se já conseguimos alguma intuição quanto a Hunters atender ou não ao critério da “tábua mínima”.
full_join(alvaro_vindas, hunters, by='x', suffix = c("_av", "_h")) %>%
pivot_longer(starts_with("ix"), names_to = "tabua", values_to = "ix") %>%
ggplot(aes(x = x, y = log(ix), color = tabua)) +
geom_line(linewidth = 1.5) +
geom_vline(xintercept = c(53,65), color = "blue", linewidth=1.2) +
theme_bw()Warning: Removed 8 rows containing missing values (`geom_line()`).
O que o gráfico nos diz? A tábua Alvaro Vindas não considera a possibilidade de invalidez até os 14 anos, o que não parece ser realista, mas por outro lado, devemos considerar que pela legislação brasileira não deveríamos ter trabalhadores com idades iguais ou inferiores a essa. Então isso não parece ser um grande problema. Nesse aspecto, a Hunters parece ser mais realista.
As taxas de invalidez da Hunters são superiores às da Alvaro Vindas até próximo aos 75 anos, quando há uma inversão.
Mas considerando o trecho compreendido entre as linhas verticais azuis que demarcam as idades entre a média das idades da massa de beneficiários (ativos, aposentados e pensionistas) e 65 anos, fica claro que a soma dos \(i_x\) será maior para a Hunters fazendo com que passe no teste da “tábua mínima”, podendo ser utilizada nos cálculos atuariais dos RPPS desde que também passe nos testes de aderência.
Vamos agora à operacionalização da metodologia no R.
alvaro_vindas %>%
filter(between(x, 53, 65)) %>%
pull(ix) %>%
sum()[1] 0.07079
hunters %>%
filter(between(x, 53, 65)) %>%
pull(ix) %>%
sum()[1] 0.19089
O resultado confirma as conclusões obtidas a partir da análise gráfica. O valor obtido para a Hunters é superior ao “limite mínimo” dado pela tábua Alvaro Vindas para essa massa de beneficiários específica e esse limite superior de 65 anos válido para a União.
Esperamos que tenha ficado clara a ideia do Art. 36 da Portaria 1467/2022 no que diz respeito a tal “tábua mínima”.
Até a próxima elucubração atuarial!