Atividade 2.3 - Diagrama de Lexis
Demografia 1.2022 - Professora Ana Maria Nogales
Rafael de Acypreste
07/08/2022
Introdução
Neste documento, estão os explicados os procedimentos para as respostas ao Exercício sobre o diagrama de Lexis: Atividade 2.3 - Diagrama de Lexis, cujo prazo de entrega é dia 11/07.2022. Os pacotes utilizados foram:
library(LexisPlotR)
library(tidyverse)
library(ggthemes)
library(kableExtra)
options(scipen = 99) #Para que os números decimais não fiquem em notação científicaO pacote básico é o LexisPlotR.
A versão com os códigos detalhados pode ser acessada em minhas publicações na plataforma RPubs.
1 Questão 1
A questão 1 é a seguinte:
Figure 1.1: Fonte: Atividade 2.3
Desse modo, o Diagrama de Lexis solicitado incluirá os dados de acordo com os respectivos anos com o nível de detalhamento possível de acordo com a tabela.
Em primeiro lugar, deve-se elaborar a estrutura básica do gráfico (grid).
O gráfico pode ser elaborado por:
# 1) Polígonos (4 lados) para as idades de 1 a 4 anos
# Deve ser organizados
polygons <- data.frame(
group = as.character(c(rep(2008, 4), # To transform fill in discrete
rep(2009, 4),
rep(2010, 4),
rep(2011, 4),
rep(2012, 4))),
x = c( # Coordenada x do polígono
"2008-01-01",
rep("2009-01-01", 2),
"2008-01-01",
"2009-01-01",
rep("2010-01-01", 2),
"2009-01-01",
"2010-01-01",
rep("2011-01-01", 2),
"2010-01-01",
"2011-01-01",
rep("2012-01-01", 2),
"2011-01-01",
"2012-01-01",
rep("2013-01-01", 2),
"2012-01-01"
),
y = rep(c(1, 1, 5, 5), 5) # Coordenada x do polígono
)
# 2) Polígonos para as idades menores do que 1 ano
polygons_1_year <- data.frame(
group = as.character(c(rep(2008, 4), # To transform fill in discrete
rep(2009, 4),
rep(2010, 4),
rep(2011, 4),
rep(2012, 4))),
x = c(
"2008-01-01",
rep("2009-01-01", 2),
"2008-01-01",
"2009-01-01",
rep("2010-01-01", 2),
"2009-01-01",
"2010-01-01",
rep("2011-01-01", 2),
"2010-01-01",
"2011-01-01",
rep("2012-01-01", 2),
"2011-01-01",
"2012-01-01",
rep("2013-01-01", 2),
"2012-01-01"
),
y = rep(c(0, 0, 1, 1), 5)
)
# 3) Datas para as anotações ficarem centralizadas num ano dado
years <- as.Date(c("2008-07-01",
"2009-07-01",
"2010-07-01",
"2011-07-01",
"2012-07-01"))
# 4) Gráfico
lexis_grid( # Linhas base do gráfico
year_start = 2007,
year_end = 2013,
age_start = 0,
age_end = 5
) +
geom_polygon(aes( # Polígonos para 1 a 4 anos
x = as.Date(polygons$x),
y = polygons$y,
group = polygons$group,
fill = polygons$group
),
alpha = .3) + # Densidade da cor do polígono
annotate( # Anotações nos gráficos
"text",
x = years,
y = 3,
label = c("73", "69", "71", "71", "65"), # Respostas da questão
size = 10
) +
geom_polygon(aes( # Polígonos para menores de 1 ano
x = as.Date(polygons_1_year$x),
y = polygons_1_year$y,
group = polygons_1_year$group,
fill = polygons_1_year$group
),
alpha = .7) +
annotate(
"text",
x = years,
y = .5,
label = c("525", "522", "559", "499", "506"), # Respostas da questão
size = 7,
color = "red"
) +
theme(legend.position = 'none') + # Retira legenda
scale_fill_colorblind() # Escala de cores discreta 
Figure 1.2: Resposta da questão 01.
2 Questão 2
Figure 2.1: Fonte: Atividade 2.3
2.1 a)
Para calcular a probabilidade de sobrevivência, basta calcular sua probabilidade complementar, que é a probabilidade de morrer nos coortes demandados.
Assim, a probailidade de um recém-nascido sobreviver é:
\[\begin{equation} \label{eq:sobrevivencia} p(\text{sobrevivência}) = 1 - \frac{\sum_{Ano = i}^{i + 4} \text{óbitos}}{\text{Nascidos no ano } i} \end{equation}\] cujo numerador é dado pelos óbitos em cada ano após o nascimento do coorte de interesse e o numerador pelo total de nascimentos.
Para os coortes de 1999 a 2002, temos:
Nascimentos <-
tribble(~ `Nascidos vivos`, ~ Nascimento,
26948, 1999,
26205, 2000,
27050, 2001,
26274, 2002,
26053, 2003,
25673, 2004,
26368, 2005,
26028, 2006
)
Dados_obito <-
tribble(~ Ano, ~ `Óbitos`, ~ Nascimento,
"0", 601, 1999,
"1", 57, 1999,
"2", 29, 1999,
"3", 21, 1999,
"4", 11, 1999,
"0", 587, 2000,
"1", 41, 2000,
"2", 24, 2000,
"3", 19, 2000,
"4", 10, 2000,
"0", 559, 2001,
"1", 53, 2001,
"2", 19, 2001,
"3", 18, 2001,
"4", 14, 2001,
"0", 536, 2002,
"1", 38, 2002,
"2", 16, 2002,
"3", 15, 2002,
"4", 18, 2002
)
Dados_obito %>%
group_by(Nascimento) %>%
summarise("Óbitos totais" = sum(`Óbitos`)) %>%
left_join(Nascimentos) %>%
mutate("Probabilidade de \n Sobrevivência" = 1 - `Óbitos totais` / `Nascidos vivos`) %>%
kbl(
format = "latex",
longtable = TRUE,
digits = 3,
booktabs = TRUE,
align = "c",
format.args = format(list(big.mark = ','))
) %>%
footnote(
general = "Probabilidade de sobreviver à data exata de 5 anos.",
footnote_as_chunk = TRUE,
threeparttable = TRUE
)2.2 b)
Para o caso do primeiro aniversário, a fórmula é ligeiramente distinta:
\[\begin{equation} \label{eq:sobrevivencia2} p(\text{sobrevivência}) = 1 - \frac{\sum_{Ano = i}^{i + 1} \text{óbitos}}{\text{Nascidos no ano } i} \end{equation}\]
cujos resultados são
Dados_obito_ano0 <-
tribble(~ Ano, ~ `Óbitos menos de 1 ano`, ~ Nascimento,
"0", 601, 1999,
"0", 587, 2000,
"0", 559, 2001,
"0", 536, 2002,
"0", 494, 2003,
"0", 478, 2004,
"0", 487, 2005,
"0", 450, 2006
)
Dados_obito_ano0 %>%
left_join(Nascimentos) %>%
mutate("Probabilidade de \n Sobrevivência" = 1 - `Óbitos menos de 1 ano` / `Nascidos vivos`) %>%
select( Nascimento,
`Óbitos menos de 1 ano`,
`Nascidos vivos`,
`Probabilidade de \n Sobrevivência`) %>%
kbl(
format = "latex",
longtable = TRUE,
digits = 3,
booktabs = TRUE,
align = "c",
format.args = format(list(big.mark = ','))
) %>%
footnote(
general = "Probabilidade de sobreviver ao primeiro aniversário.",
footnote_as_chunk = TRUE,
threeparttable = TRUE
)2.3 c)
Com isso, percebe-se que as taxas de sobrevivência ao primeiro aniversário são muito próximas às taxas de probabilidade de completar 5 anos, o que indica que a fase mais crítica para óbitos entre crianças com até cinco anos de idade é exatamente antes de completar o primeiro ano de vida.
3 Questão 3
Figure 3.1: Fonte: Atividade 2.3
3.1 a)
O gráfico pode ser elaborado por:
# 1) Tabela dos dados do problema
data3 <-
tribble(~ Nascimento, ~ Ano_completo, ~ Obitos,
"1995-09-01", 0.25, 12500,
"1995-05-01", 0.75, 4058,
"1995-09-01", 1.25, 1023,
"1995-05-01", 1.75, 854,
"1995-09-01", 2.25, 410,
"1995-05-01", 2.75, 300,
"1995-09-01", 3.25, 274,
"1995-05-01", 3.75, 221,
"1995-09-01", 4.25, 186
) %>%
mutate(across(Nascimento, as.Date))
# 2) Gráfico
lexis_grid( # Linhas base do gráfico
year_start = 1991,
year_end = 1997,
age_start = 0,
age_end = 5
) +
annotate( # Anotações nos gráficos
"text",
x = data3$Nascimento,
y = data3$Ano_completo,
label = data3$Obitos, # Respostas da questão
size = 4.5
) +
labs(x = "Ano de nascimento",
y = "Idade",
title = "Distribuição de óbitos segundo o ano de nascimento e a idade
em 1995 para um determinado país da América Latina")
Figure 3.2: Resposta da questão 03.
3.2 b)
A resposta se dá pela soma dos nascimentos em 1995 bem como a quantidade de crianças com as respectivas idades no início de 1995 descontados os óbitos e os que já tinha 4 anos completos no início do ano. O resultado é, portanto: 399674 crianças entre 0 e 4 anos completos.
4 Questão 4
Figure 4.1: Fonte: Atividade 2.3
# 1) Datas para as anotações ficarem centralizadas num ano dado
data4 <-
tribble(~ Nascimento, ~ Ano_completo, ~ Filhos,
"1975-01-01", 12.5, 3,
"1980-01-01", 17.5, 317,
"1985-01-01", 22.5, 537,
"1990-01-01", 27.5, 393,
"1995-01-01", 32.5, 223,
"2000-01-01", 37.5, 131,
"2005-01-01", 42.5, 63,
"2010-01-01", 47.5, 17,
"2015-01-01", 52.5, 2
) %>%
mutate(across(Nascimento, as.Date))
# 2) Ajuste do cohort
polygons_5_year <- # Retira o coorte futuro
data.frame(
group = as.character(rep(2014, 3)),
x = c(
rep("2015-01-01", 2),
"2020-01-01"
),
y = c(50, 55, 55)
)
# 3) Gráfico
lexis_grid( # Linhas base do gráfico
year_start = 1960,
year_end = 2020,
age_start = 0,
age_end = 55,
delta = 5
) %>%
lexis_cohort( cohort = 1960) %>%
lexis_cohort( cohort = 1961) %>%
lexis_cohort( cohort = 1962) %>%
lexis_cohort( cohort = 1963) %>%
lexis_cohort( cohort = 1964) +
geom_polygon(aes( # Polígonos para 1 a 4 anos
x = as.Date(polygons_5_year$x),
y = polygons_5_year$y,
group = polygons_5_year$group,
fill = polygons_5_year$group
),
fill = "white") +
annotate( # Anotações nos gráficos
"text",
x = data4$Nascimento,
y = data4$Ano_completo,
label = data4$Filhos, # Respostas da questão
size = 4
) +
labs(x = "Ano de nascimento",
y = "Faixa de idade",
title = "Dados sobre o momento de nascimento de seus filhos") 
Figure 4.2: Resposta da questão 04.
4.1 b)
O momento calendário de nascimentos dos filhos quando as mulheres tinham entre 20 e 24 anos completos se dá entre os anos de 1980 e 1985, como representado na Figura 4.2.
4.2 c)
Para o exemplo dessas 500 mulheres, o número médio de filhos foi 337 por 100 mulheres.