Bibliotecas

rm(list=ls())               # limpa os objetos da ultima execução
options(scipen = 9999,      # inibe exibição de resultaos em notação científica
        digits = 8,         # limita o número de digitos das saídas do programa
        max.print = 6)      # limita o tamanho da saída do programa

library(demography)         # pacote para manipulação de dados demográficos
library(sidrar)             # pacote para manipulação de dados do SIDRA
library(magrittr)           # pacote para operadores semânticos %>%, %$%
library(dplyr)              # pacote para manipulação de dados
library(tidyr)              # pacote para manipulação de dados
library(kableExtra)         # pacote para formatar tabelas
library(readxl)             # pacote para ler e manipular arquivos xlsx
library(ggplot2)            # pacote para elaboração de gráficos
library(MortalityTables)    # pacote para manipulação de tábuas biométricas
library(knitr)              # pacote para visualização 
library(DT)                 # pacote para formatar tabelas
library(janitor)            # pacote para limpeza de nomes de colunas
library(LexisPlotR)         # pacote para criar diagramas de Lexis

Questão 1

Acesse o site https://datasus.saude.gov.br/informacoes-de-saude-tabnet/ e colete os dados da região da Paraíba referentes aos nascimentos por local de residência, segundo o grupo etário da mulher, no ano de 2018. Em seguida, obtenha os dados da população da Paraíba por grupo etário e sexo, de acordo com os censos de 2000 e 2010. Com base nesses dados, projete a população para o ano de 2018 utilizando o modelo de crescimento geométrico.

# Dados populacionais dos censos 2000 e 2010
pop_data <- list(
  pop_2000 <- get_sidra(x = 200, period = '2000', geo = 'State', geo.filter = 25),
  pop_2010 <- get_sidra(x = 200, period = '2010', geo = 'State', geo.filter = 25)
)

# Renomear colunas
pop_data <- lapply(pop_data, function(data) {
  data %>%
    clean_names()  # Remove caracteres problemáticos
})

process_population_data <- function(data) {
  data %>%
    filter(situacao_do_domicilio == "Total") %>%
    select(unidade_da_federacao, ano, sexo, grupo_de_idade, valor) %>%
    pivot_wider(
      names_from = sexo,
      values_from = valor
    ) %>%
    mutate(grupo_de_idade = factor(grupo_de_idade, levels = c(
      "0 a 4 anos", "1 a 4 anos", "5 a 9 anos", "10 a 14 anos", 
      "15 a 19 anos", "20 a 24 anos", "25 a 29 anos", "30 a 34 anos", "35 a 39 anos",
      "40 a 44 anos", "45 a 49 anos", "50 a 54 anos", "55 a 59 anos", "60 a 64 anos", 
      "65 a 69 anos", "70 a 74 anos", "75 a 79 anos", "80 a 84 anos", "85 a 89 anos", 
      "90 a 94 anos", "95 a 99 anos", "100 anos ou mais", "Total"))) %>%
    arrange(grupo_de_idade) %>%
    drop_na(grupo_de_idade)
}

# Aplicar a função a todos os conjuntos de dados
pop_data <- lapply(pop_data, process_population_data)

# Diferença de data para projeção populacional
data_2010 <- as.Date("2010-08-01", format = "%Y-%m-%d")
data_2018 <- as.Date("2018-07-01", format = "%Y-%m-%d")
diff_data <- as.numeric(difftime(data_2018, data_2010, units = "days")) / 365.25
diff_censo <- 2010 - 2000

# Função para calcular a taxa de crescimento anual
calcular_taxa_crescimento <- function(pop_2000, pop_2010, diff_censo) {
  taxa_crescimento <- (pop_2010 / pop_2000)^(1 / diff_censo) - 1
  return(taxa_crescimento)
}

# Aplicar a taxa de crescimento para projetar a população em 2018
projetar_populacao <- function(pop_2010, taxa_crescimento, diff_data) {
  pop_2018 <- pop_2010 * (1 + taxa_crescimento)^diff_data
  return(pop_2018)
}

# Criar um dataframe com as populações projetadas para 2018
projecao_populacao <- pop_data[[2]] %>%
  mutate(
    # Calcular taxa de crescimento para Homens
    taxa_crescimento_homens = calcular_taxa_crescimento(pop_data[[1]]$Homens, pop_data[[2]]$Homens, diff_censo),
    Homens_2018 = as.integer(projetar_populacao(Homens, taxa_crescimento_homens, diff_data)),
    
    # Calcular taxa de crescimento para Mulheres
    taxa_crescimento_mulheres = calcular_taxa_crescimento(pop_data[[1]]$Mulheres, pop_data[[2]]$Mulheres, diff_censo),
    Mulheres_2018 = as.integer(projetar_populacao(Mulheres, taxa_crescimento_mulheres, diff_data)),
    
    # Calcular taxa de crescimento para o Total (Homens + Mulheres)
    taxa_crescimento_total = calcular_taxa_crescimento(pop_data[[1]]$Homens + pop_data[[1]]$Mulheres, 
                                                       pop_data[[2]]$Homens + pop_data[[2]]$Mulheres, diff_censo),
    Total_2018 = as.integer(projetar_populacao(Homens + Mulheres, taxa_crescimento_total, diff_data)),
    
    # Definir o ano como 2018
    ano = 2018
  ) %>%
  select(unidade_da_federacao, ano, grupo_de_idade, Homens_2018, Mulheres_2018, Total_2018)

# Exibir o dataframe com as projeções
kable(projecao_populacao, format = "html") %>%
  kable_styling("striped", full_width = F)
unidade_da_federacao ano grupo_de_idade Homens_2018 Mulheres_2018 Total_2018
Paraíba 2018 0 a 4 anos 131778 126658 258435
Paraíba 2018 5 a 9 anos 145772 139114 284880
Paraíba 2018 10 a 14 anos 163183 155791 318961
Paraíba 2018 15 a 19 anos 164111 162466 326576
Paraíba 2018 20 a 24 anos 181495 183829 365320
Paraíba 2018 25 a 29 anos 194110 198058 392121
Paraíba 2018 30 a 34 anos 172246 178158 350330
Paraíba 2018 35 a 39 anos 144061 154716 298776
Paraíba 2018 40 a 44 anos 150971 163705 314652
Paraíba 2018 45 a 49 anos 137671 144693 282181
Paraíba 2018 50 a 54 anos 98565 108530 207044
Paraíba 2018 55 a 59 anos 81646 100450 182096
Paraíba 2018 60 a 64 anos 73107 83519 156472
Paraíba 2018 65 a 69 anos 57087 72572 129656
Paraíba 2018 70 a 74 anos 44464 61772 106174
Paraíba 2018 75 a 79 anos 22412 36959 58993
Paraíba 2018 80 a 84 anos 18256 29997 48044
Paraíba 2018 85 a 89 anos 12268 18826 30939
Paraíba 2018 90 a 94 anos 5700 11222 16791
Paraíba 2018 95 a 99 anos 2805 4360 7143
Paraíba 2018 100 anos ou mais 559 735 1224
Paraíba 2018 Total 1954356 2088012 4042354 
# Dados de nascimentos por local de residência e grupo etário da mulher
nascidos_2018 <- read.csv("C:/Users/cleod/Downloads/sinasc_cnv_nvpb103842179_183_190_89.csv",
                          skip = 3, header = TRUE, sep = ";", encoding = 'latin1')

# Eliminar linhas desnecessárias
nascidos_2018 <- nascidos_2018[-c(12:29),]

# Exibir o dataframe com os dados de nascimentos
kable(nascidos_2018, format = "html") %>%
  kable_styling("striped", full_width = F)
Idade.da.mãe Masc Fem Ign Total
10 a 14 anos 231 237
468
15 a 19 anos 4983 4746
9729
20 a 24 anos 7607 7314 3 14924
25 a 29 anos 7301 6954 3 14258
30 a 34 anos 6353 6028 1 12382
35 a 39 anos 3489 3287 1 6777
40 a 44 anos 806 781
1587
45 a 49 anos 35 39
74
50 a 54 anos 2 2
4
60 a 64 anos 1 1
2
Total 30808 29389 8 60205

Questão 2

Calcule a Taxa Bruta de Natalidade.

# Calcular a Taxa Bruta de Natalidade
tbn <- (nascidos_2018$'Total'[11] / projecao_populacao$Total_2018[22]) * 1000

tbn <- round(tbn, 2)

Resposta

A Taxa Bruta de Natalidade é dada pela fórmula:

\[ TBN = \frac{\text{Nascidos Vivos}}{\text{Pessoas-Ano}} \times 1.000 \] Assim, a TBN para o ano de 2018 foi de 14.89 nascimentos por mil habitantes.

Questão 3

Calcule a Taxa de Fecundidade Geral.

# Calcular a Taxa de Fecundidade Geral
tfg <- (nascidos_2018$'Total'[11] / sum(projecao_populacao$Mulheres_2018[4:10])) * 1000

tfg <- round(tfg, 2)

Resposta

A Taxa de Fecundidade Geral é dada pela fórmula:

\[ TFG = \frac{\text{Nascidos Vivos}}{_{35}Pop_{15}^{fem}} \times 1.000 \]

Assim, a TFG para o ano de 2018 foi de 50.78 nascimentos por mil mulheres.

Questão 4

Calcule as Taxas Específicas de Fecundidade por idade da mulher.

# Função para calcular a taxa específica de fecundidade
calcular_taxa_fecundidade <- function(nascidos, populacao) {
  # Merge dos dados de nascidos e população por faixa etária
  dados_combinados <- merge(nascidos, populacao, by.x = "Idade.da.mãe", by.y = "grupo_de_idade")
  
  # Cálculo da taxa específica de fecundidade
  dados_combinados$Taxa_Fecundidade <- dados_combinados$Total / dados_combinados$Mulheres_2018
  
  # Selecionando apenas as colunas relevantes
  resultado <- dados_combinados[, c("Idade.da.mãe", "Mulheres_2018", "Total", "Taxa_Fecundidade")]
  
  # Excluir a linha de total, 10 a 14 anos, 50 a 54 anos e 60 a 64 anos
  resultado <- resultado[-c(1, 9, 10, 11),]
  
  return(resultado)
}

# Calculando a taxa específica de fecundidade
taxa_fecundidade <- calcular_taxa_fecundidade(nascidos_2018, projecao_populacao)

Resposta

A Taxa Específica de Fecundidade por idade da mulher é dada pela fórmula:

\[ TEF = \frac{_{n}NV_{x}}{_{n}Pop_{x}^{fem}} \] Assim, as Taxas Específicas de Fecundidade por idade da mulher para o ano de 2018 são:

Idade.da.mãe Mulheres_2018 Total Taxa_Fecundidade
2 15 a 19 anos 162466 9729 0.05988330
3 20 a 24 anos 183829 14924 0.08118414
4 25 a 29 anos 198058 14258 0.07198901
5 30 a 34 anos 178158 12382 0.06950011
6 35 a 39 anos 154716 6777 0.04380284
7 40 a 44 anos 163705 1587 0.00969427
8 45 a 49 anos 144693 74 0.00051143

Questão 5

Calcule a Taxa de Fecundidade Total.

# Calcular a Taxa de Fecundidade Total
tft <- sum(taxa_fecundidade$Taxa_Fecundidade) * 5

tft <- round(tft, 4)

Resposta

A Taxa de Fecundidade Total é dada pela fórmula:

\[ TFT = n \times \sum_{i=1}^{7} TEF_{i} \]

Assim, a TFT para o ano de 2018 foi de 1.6828 nascimentos por mulher.

Questão 6

Faça um gráfico das Taxas Específicas de Fecundidade por idade da Mulher.

# Gráfico das Taxas Específicas de Fecundidade por idade da Mulher
ggplot(taxa_fecundidade, aes(x = Idade.da.mãe, y = Taxa_Fecundidade)) +
  geom_bar(stat = "identity", fill = "skyblue") +
  labs(title = "Taxas Específicas de Fecundidade por idade da Mulher",
       x = "Idade da mãe",
       y = "Taxa de Fecundidade") +
  theme_minimal()

Questão 7

Calcule a Taxa Bruta de Reprodução.

# Função para calcular a taxa bruta de reprodução
calcular_taxa_reproducao <- function(nascidos, populacao) {
  # Merge dos dados de nascidos e população por faixa etária
  dados_combinados <- merge(nascidos, populacao, by.x = "Idade.da.mãe", by.y = "grupo_de_idade")
  
  # Cálculo da taxa específica de fecundidade
  dados_combinados$Taxa_Fecundidade_Fem <- dados_combinados$Fem / dados_combinados$Mulheres_2018
  
  # Selecionando apenas as colunas relevantes
  resultado <- dados_combinados[, c("Idade.da.mãe", "Mulheres_2018", "Fem", "Taxa_Fecundidade_Fem")]
  
  # Excluir a linha de total, 10 a 14 anos, 50 a 54 anos e 60 a 64 anos
  resultado <- resultado[-c(1, 9, 10, 11),]
  
  return(resultado)
}

# Calculando a taxa específica de fecundidade
taxa_reproducao <- calcular_taxa_reproducao(nascidos_2018, projecao_populacao)

# Calcular a Taxa Bruta de Reprodução
tbr <- sum(taxa_reproducao$Taxa_Fecundidade_Fem) * 5

tbr <- round(tbr, 4)

Resposta

A Taxa Bruta de Reprodução é dada pela fórmula:

\[ TBR = n \times \sum_{i=1}^{7} TEF_{i,f} \] Assim, a TBR para o ano de 2018 foi de 0.8212 nascimentos por mulher.

Questão 8

Calcule a Taxa Líquida de Reprodução.

Idade lx nLx
0 1000 985
1 984 3930
5 982 4904
10 980 4897
15 979 4886
20 976 4871
25 972 4851
30 968 4824
35 962 4791
40 954 4743
45 943 4672 
# Extrair o primeiro dígito de 'Idade.da.mãe' de 'taxa_reproducao'
taxa_reproducao$Idade <- as.numeric(substr(taxa_reproducao$Idade.da.mãe, 1, 2))

# Combinar os dataframes 'tabela' e 'taxa_reproducao' pela coluna 'Idade'
taxa_bruta_reproducao <- merge(tabela, taxa_reproducao, by = "Idade", all.x = TRUE)

# Selecionar as colunas relevantes
taxa_bruta_reproducao <- taxa_bruta_reproducao[, c("Idade", "lx", "nLx", "Taxa_Fecundidade_Fem")]

# Criar a coluna 'nLx' para a Taxa Líquida de Reprodução
taxa_bruta_reproducao <- taxa_bruta_reproducao %>%
  mutate(nLx_TEF = nLx * Taxa_Fecundidade_Fem)

# Calcular a Taxa Líquida de Reprodução
tlr <- sum(taxa_bruta_reproducao$nLx_TEF, na.rm = TRUE) / taxa_bruta_reproducao$lx[1]

tlr <- round(tlr, 4)

# Exibir o dataframe com as taxas de reprodução
kable(taxa_bruta_reproducao, format = "html") %>%
  kable_styling("striped", full_width = F)
Idade lx nLx Taxa_Fecundidade_Fem nLx_TEF
0 1000 985 NA NA
1 984 3930 NA NA
5 982 4904 NA NA
10 980 4897 NA NA
15 979 4886 0.02921227 142.7311314
20 976 4871 0.03978698 193.8023598
25 972 4851 0.03511093 170.3231074
30 968 4824 0.03383514 163.2206917
35 962 4791 0.02124538 101.7866090
40 954 4743 0.00477078 22.6277939
45 943 4672 0.00026954 1.2592731

Resposta

A Taxa Líquida de Reprodução é dada pela fórmula:

\[ TLR = \frac{\sum_{i=1}^{n} nLx \times TEF_{i,f}}{l_{0,f}} \] Assim, a TLR para o ano de 2018 foi de 0.7958 nascimentos por mulher.

Questão 9

Faça uma análise do gráfico da questão 6 e da Taxa de Fecundidade Total.

Resposta

A análise do gráfico da questão 6 e da Taxa de Fecundidade Total revela um padrão de fecundidade concentrado nas idades mais jovens (20 a 34 anos), com um declínio acentuado após os 35 anos, refletindo a redução natural da fertilidade com o avanço da idade, além de possíveis fatores sociais, como a priorização da carreira ou a decisão de limitar o tamanho da família.

A TFT de 1,6828 indica que a população está abaixo do nível de reposição, o que pode ter implicações significativas para a estrutura etária e a dinâmica populacional no futuro. É característica de regiões em estágios avançados da transição demográfica, onde há maior acesso a métodos contraceptivos, maior participação das mulheres no mercado de trabalho e mudanças nas preferências familiares