A Coreia do Sul, um dos países mais dinâmicos e tecnologicamente avançados do mundo, experimentou profundas transformações demográficas ao longo das últimas décadas. Este relatório demográfico busca oferecer uma visão abrangente sobre os principais indicadores populacionais da Coreia do Sul, focando em três aspectos fundamentais: mortalidade, fecundidade e migração. Além disso, serão apresentadas projeções futuras baseadas em tendências atuais e dados estatísticos disponíveis.
Razão de Sexo
A razão de sexo é um indicador demográfico que expressa a relação entre o número de homens e o número de mulheres em uma população. Esse indicador é geralmente apresentado na forma de uma proporção ou uma razão, mostrando o número de homens para cada 100 mulheres.
Como calcular
Fórmula: \(RS = (\frac{Numero de Homens}{Numero de mulheres}) \times{100}\)
Resultado: 61,91427. Menos de 105 = dados muito exatos.
Taxa Bruta de Mortalidade
A taxa bruta de mortalidade é um indicador demográfico que quantifica o número de mortes em uma população por cada 1.000 habitantes em um determinado período, geralmente um ano.
tbm <-function(caminho_arquivo) { mortes <-read_excel(caminho_arquivo) vetor <-numeric(11)for (i in3:13) { j <- i +12 vetor[i -2] <-1000*(mortes[1, i] / pop_sexo[1, j]) }return(vetor)}caminho_arquivo <-"C://Users//Aman_//Downloads//total_mortes.xlsx"resultado2 <-tbm(caminho_arquivo)resultado2 <-as.numeric(resultado2)anos <-2012:2022dataframe <-cbind(TBM = resultado2, anos = anos)dataframe <-as.data.frame(dataframe)ggplot(data = dataframe, aes(x = anos, y = TBM)) +geom_line() +labs(title ="TBM ao Longo dos Anos",x ="Ano",y ="Taxa Bruta de Mortalidade") +theme_minimal()
Interpretação:
Em 2018 houve 298.820 mortes, refletindo um aumento de 13.286 mortes (4,7%) em relação a 2017. Este foi o número mais alto desde que estatísticas comparáveis foram publicadas pela primeira vez em 1983. Porém, esses números nem se comparam com o aumento de 17,4% de 2022 para 2021 devido a pandemia do COVID-19.
Curiosidade: Mortalidade feminina
Code
tbm <-function(caminho_arquivo) { mortes <-read_excel(caminho_arquivo) vetor <-numeric(11)for (i in3:13) { j <- i +12 vetor[i -2] <-1000*(mortes[24, i] / pop_sexo[3, j]) }return(vetor)}caminho_arquivo <-"C://Users//Aman_//Downloads//total_mortes.xlsx"resultado2 <-tbm(caminho_arquivo)resultado2 <-as.numeric(resultado2)anos <-2012:2022dataframe <-cbind(TBM = resultado2, anos = anos)dataframe <-as.data.frame(dataframe)ggplot(data = dataframe, aes(x = anos, y = TBM)) +geom_line() +labs(title ="TBM de mulheres ao Longo dos Anos",x ="Ano",y ="Taxa Bruta de Mortalidade") +theme_minimal()
Interpretação:
É possível ver que é praticamente o mesmo gráfico, logo, praticamente a mesma interpretação.
Taxas Específicas de Mortalidade em 2020
As Taxas Específicas de Mortalidade são indicadores demográficos que medem a mortalidade em grupos específicos dentro de uma população, normalmente categorizados por idade, sexo, causas de morte ou outras características relevantes. Esses indicadores são essenciais para uma análise detalhada da mortalidade, permitindo a identificação de padrões e fatores de risco específicos.
# A tibble: 57 × 3
genero `por idade` `2020`
<chr> <chr> <dbl>
1 total total 304948
2 <NA> 0 anos 674
3 <NA> 1-4 anos 185
4 <NA> 5-9 anos 142
5 <NA> 10-14 anos 203
6 <NA> 15-19 anos 563
7 <NA> 20-24 anos 1118
8 <NA> 25-29 anos 1588
9 <NA> 30-34 anos 1752
10 <NA> 35-39 anos 3007
# ℹ 47 more rows
library(tidyr)dataframe_long <-pivot_longer(dataframe, cols =c("homens", "mulheres"), names_to ="genero", values_to ="taxa")# Criar gráfico com ggplot2ggplot(data = dataframe_long, aes(x = anos, y =as.numeric(taxa), group = genero, color = genero)) +geom_line(size =1) +geom_point(size =3) +labs(title ="Taxas Específicas de Mortalidade por Idade e Gênero",x ="Idade",y ="Taxa de Mortalidade",color ="Gênero") +scale_color_manual(values =c("mulheres"="purple", "homens"="blue")) +theme_minimal() +theme(axis.text.x =element_text(angle =45, hjust =1))
Interpretação:
Comparado com as outras idades jovens, 0~4 anos é a que tem a maior taxa, além de que desse período até os 30~34 os números de mortes para homens e mulheres permanece praticamente o mesmo. Depois os homens tendem a morrer mais que as mulheres.
Diagrama de Lexis
Iremos explorar a dinâmica da população através do Diagrama de Lexis, uma ferramenta fundamental na demografia que ilustra as mudanças na população ao longo do tempo, combinando idade e ano. O Diagrama de Lexis nos oferece uma perspectiva única sobre as transições entre as faixas etárias.
Obs: Por questões estéticas o diagrama teve que ser dívido em dois e apresentar os dados com relação a população em porcentagem.
Outra vez repetindo os procedimentos adotados no caso da mortalidade, para o cálculo das Taxas Específicas de Fecundidade (TEFs) por idade, relaciona-se o número de nascimentos ocorridos entre mulheres de uma determinada idade ou grupo etário com o tempo total de exposição das mesmas ao risco de terem filhos naquele mesmo período ou o número total de anos-pessoa vividos em exposição ao risco no período.
Fórmula utilizada na fonte Korean Statistical Information Service (KOSIS): \((\frac{número de bebês nascidos por idade da mãe}{população feminina nessa idade}) × 1.000\)
ggplot(dados1, aes(x = Ano, y = Taxa, color = FaixaEtaria)) +geom_line(size =1) +labs(title ="Taxa de Fecundidade Específica por Faixa Etária (1982-2010)",x ="Ano",y ="Taxa de Fecundidade",color ="Faixa Etária") +theme_minimal()
Interpretação:
Como podemos perceber pelas taxas de fecundidade específicas houve uma queda e uma inversão na época que as mulheres passaram a engravidar, nos anos 80 a faixa etária era de 25 a 29 anos e nos anos de 2010 as mulheres passaram a engravidar entre os 30 e 34 anos, que indica a entrada das mulheres no mercado de trabalho.
Taxa de Fecundidade Total
Fórmula utilizada na fonte Korean Statistical Information Service (KOSIS): \((\frac{Soma das taxas de natalidade por idade (classe de 5 gerações)}{1.000}) × 5\)
ggplot(dados1, aes(x = Ano, y = Taxa, color = FaixaEtaria)) +geom_line(size =1) +labs(title ="Taxa de Fecundidade Total (1982-2010)",x ="Ano",y ="Taxa de Fecundidade",color ="Faixa Etária") +theme_minimal()
Code
library(ggplot2)# Definir os vetores com os dados fornecidosano <-2013:2022taxa_fecundidade_total <-c(1.187, 1.205, 1.239, 1.172, 1.052, 0.977, 0.918, 0.837, 0.808, 0.778)# Criar o data frametabela_fecundidade <-data.frame( ano, taxa_fecundidade_total)# Criar o gráficoggplot(data = tabela_fecundidade, aes(x = ano, y = taxa_fecundidade_total)) +geom_line(color ="blue") +geom_point(color ="red") +scale_x_continuous(breaks =seq(min(ano), max(ano), by =1), labels =as.character(seq(min(ano), max(ano), by =1))) +labs(title ="Taxa de Fecundidade Total (2013-2022)",x ="Ano",y ="Taxa de Fecundidade Total (filhos por mulher)") +theme_minimal()
Taxa de fecundidade materna por idade e Taxa de fecundidade total (TFT)
Ano
X15.19.anos
X20.24.anos
X25.29.anos
X30.34.anos
X35.39.anos
X40.44.anos
X45.49.anos
TFT
1982
15.0
159.1
213.9
72.5
20.0
5.3
1.3
2.39
1983
13.0
146.6
187.1
55.6
14.6
4.0
0.8
2.06
1984
11.7
129.7
159.5
42.0
10.4
2.8
0.6
1.74
1985
10.1
118.7
159.1
41.1
8.8
2.2
0.5
1.66
1986
8.7
104.2
160.0
39.6
8.3
1.9
0.5
1.58
1987
7.0
97.3
159.3
39.2
7.7
1.7
0.3
1.53
1988
5.7
92.1
163.5
41.9
7.9
1.5
0.3
1.55
1989
4.5
89.7
165.6
44.7
8.5
1.5
0.2
1.56
1990
4.2
83.2
169.4
50.5
9.6
1.5
0.2
1.57
1991
4.3
84.8
186.2
58.8
10.8
1.5
0.2
1.71
1992
4.7
82.8
188.9
65.1
12.6
1.8
0.2
1.76
1993
4.4
72.7
178.8
64.2
13.8
2.0
0.2
1.65
1994
4.0
66.0
179.6
68.0
14.7
2.2
0.2
1.66
1995
3.6
62.9
177.1
69.6
15.2
2.3
0.2
1.63
1996
3.3
58.8
167.6
71.1
15.5
2.4
0.2
1.57
1997
3.0
54.2
159.7
71.5
15.4
2.3
0.2
1.52
1998
2.8
48.3
152.1
71.2
15.2
2.3
0.2
1.45
1999
2.6
43.3
147.2
72.3
15.3
2.4
0.2
1.41
2000
2.5
38.8
149.6
83.5
17.2
2.5
0.2
1.47
2001
2.2
31.4
129.2
77.5
17.0
2.4
0.2
1.30
2002
2.6
26.5
110.9
74.5
16.6
2.4
0.2
1.17
2003
2.5
23.6
111.7
79.1
17.1
2.4
0.2
1.18
2004
2.3
20.6
104.5
83.2
18.2
2.4
0.2
1.15
2005
2.1
17.8
91.7
81.5
18.7
2.4
0.2
1.08
2006
2.2
17.6
89.4
89.4
21.2
2.6
0.2
1.12
2007
2.2
19.5
95.5
101.3
25.6
3.1
0.2
1.25
2008
1.7
18.2
85.6
101.5
26.5
3.2
0.2
1.19
2009
1.7
16.5
80.4
100.8
27.3
3.4
0.2
1.15
2010
1.5
16.2
79.8
112.7
32.6
4.1
0.2
1.22
Interpretação:
Como podemos perceber pelo gráfico a TFG é baixa, o que indica um baixo nível de nascimentos em relação ao número de mulheres em idade fértil.Indicando uma baixa taxa de natalidade. Percebemos que houve uma queda dos anos de 1980 até 2010, a taxa de fecundidade era superior a 2 filhos por mulher e em 2010 ficou abaixo de 1,5 filhos por mulher. E isso se dá pela cultura da Coreia sendo resultado de uma combinação de fatores sociais, econômicos e culturais do país. Uma das principais razões são: custos elevados de criação dos filhos, mercado de trabalho competitivo e desigualdade de gênero,mudanças nos valores e atitudes sociais, políticas de apoio insuficientes, pressões sociais e culturais.
Taxa Bruta de Natalidade
Como as taxas anteriormente definidas, a Taxa Bruta de Natalidade (TBN) é calculada relacionando-se o número total de nascimentos ocorridos no período com o tempo total de exposição daqueles que estiveram expostos ao risco de ter um filho naquele mesmo período ou o número total de anos pessoa vividos em exposição ao risco no período. Para fins de apresentação, multiplica-se o resultado por mil.
Code
library(ggplot2)# Definir os vetores com os dados fornecidosano <-2013:2022nascimentos <-c(436455, 435435, 438420, 406243, 357771, 326822, 302676, 272337, 260562, 249186)populacao_total <-c(25012374, 25765673, 26513030, 27261747, 27984155, 28704674, 29435571, 30130983, 30838302, 31544266)# Calcular a taxa bruta de natalidadetaxa_bruta_natalidade <- (nascimentos / populacao_total) *1000# Criar o data frametabela_natalidade <-data.frame( ano, taxa_bruta_natalidade)# Criar o gráficoggplot(data = tabela_natalidade, aes(x = ano, y = taxa_bruta_natalidade)) +geom_line(color ="blue") +geom_point(color ="red") +scale_x_continuous(breaks =seq(min(ano), max(ano), by =1), labels =as.character(seq(min(ano), max(ano), by =1))) +labs(title ="Taxa Bruta de Natalidade (2013-2022)",x ="Ano",y ="Taxa Bruta de Natalidade (nascimentos por 1.000 habitantes)") +theme_minimal()
Interpretação
Percebemos pelo gráfico que a taxa bruta de natalidade vem caindo desde 2013, mas a sua queda acentuou em 2015. Indicando um baixo número de nascimentos em relação a quantidade de mulheres expostas ao risco de engravidar.
Taxa de Fecundidade Geral
Para um primeiro refinamento do conceito de TBN, é conveniente a exclusão do denominador dos homens e das mulheres fora das idades reprodutivas, que são as categorias principais de pessoas com risco zero. O resultado dessa redefinição é conhecido como a Taxa de Fecundidade Geral.
Code
#calculando os dados#install.packages("ggplot2")library(ggplot2)# Definir os vetores com os dados fornecidosano <-2013:2022nascimentos <-c(436455, 435435, 438420, 406243, 357771, 326822, 302676, 272337, 260562, 249186)populacao_feminina <-c(12461683, 12829090, 13192047, 13553627, 13902205, 14251843, 14605710, 14925590, 15262204, 15603301)# Calcular a taxa de fecundidadetaxa_fecundidade <-1000*(nascimentos / populacao_feminina)# Criar o data frametabela_fecundidade <-data.frame( ano, taxa_fecundidade)# Criar o gráficoggplot(data = tabela_fecundidade, aes(x = ano, y = taxa_fecundidade)) +geom_line(color ="blue") +geom_point(color ="red") +scale_x_continuous(breaks =seq(min(ano), max(ano), by =1), labels =as.character(seq(min(ano), max(ano), by =1))) +labs(title ="Taxa de Fecundidade Geral (2013-2022)",x ="Ano",y ="Taxa de Fecundidade (nascimentos por mulher)") +theme_minimal()
Migração
Migração é o movimento de pessoas de uma localidade para outra, geralmente com o intuito de melhorar as condições de vida, encontrar emprego, obter educação ou escapar de conflitos e desastres naturais. Esse movimento pode ser interno, dentro das fronteiras de um país, ou internacional, atravessando fronteiras nacionais. As razões para a migração podem ser voluntárias, como a busca por melhores oportunidades econômicas, ou forçadas, como no caso de refugiados e deslocados internos devido a conflitos ou catástrofes.
Na Coreia do Sul: historicamente, o país passou por significativas ondas de emigração, especialmente após a Guerra da Coreia (1953~), quando muitos sul-coreanos emigraram para os Estados Unidos, Japão e outras nações em busca de melhores oportunidades econômicas. Nos últimos anos, a Coreia do Sul tem experimentado um aumento na imigração, com trabalhadores estrangeiros e estudantes internacionais contribuindo para a força de trabalho e diversidade cultural do país. Além disso, o governo sul-coreano tem implementado políticas para atrair talentos estrangeiros e mitigar os desafios demográficos, como o envelhecimento da população e a baixa taxa de natalidade.
Total de imigrantes e emigrantes da Coreia do Sul.
Saldo Migratório
\[
SM = Imigrantes - Emigrantes
\]
Code
SM_2000 <-371000-363000; SM_2000
[1] 8000
Code
SM_2005 <-530000-625000; SM_2005
[1] -95000
Code
SM_2010 <-632000-550000; SM_2010
[1] 82000
Code
SM_2015 <-684000-622000; SM_2015
[1] 62000
Code
SM_2020 <-673000-560000; SM_2020
[1] 113000
Code
SM_2022 <-606000-518000; SM_2022
[1] 88000
Interpretação:
Foram feitas as principais datas, mas, como é perceptível, os valores correspondem ao “net migrantes) no gráfico, então temos de todos os anos de 2000 até 2022. De 2001 até 2005 houveram mais emigrantes que imigrantes e em 2006 houve tanto uma diminuição no número de emigrantes quanto um aumento no número de imigrantes, um dos motivos que fez com que, em 2007, o Governo criasse leis para ajudar imigrantes. Também houve o caso do auge da pandemia, 2021, onde o SM também foi negativo.
Migração Bruta
\[
MB = Imigrantes + Emigrantes
\]
Code
MB_2000 <-371000+363000; MB_2000
[1] 734000
Code
MB_2005 <-530000+625000; MB_2005
[1] 1155000
Code
MB_2010 <-632000+550000; MB_2010
[1] 1182000
Code
MB_2015 <-684000+622000; MB_2015
[1] 1306000
Code
MB_2020 <-673000+560000; MB_2020
[1] 1233000
Code
MB_2022 <-606000+518000; MB_2022
[1] 1124000
Interpretação:
Entre os anos analisados o que teve maior MB foi 2015.
Taxa Líquida de Migração
\[
TLM = \frac{Imigrantes - Emigrantes}{P}
\] Obs: P é a população observada no final do período.
Todos os anos representam área de circulação/rotatividade migratória.
Índice de Reposição Populacional
\[
IRP = \frac{Imigrantes}{Emigrantes}
\]
Code
IRP_2000 <-371000/363000; IRP_2000
[1] 1.022039
Code
IRP_2005 <-530000/625000; IRP_2000
[1] 1.022039
Code
IRP_2010 <-632000/550000; IRP_2010
[1] 1.149091
Code
IRP_2015 <-684000/622000; IRP_2015
[1] 1.099678
Code
IRP_2020 <-673000/560000; IRP_2020
[1] 1.201786
Code
IRP_2022 <-606000/518000; IRP_2022
[1] 1.169884
Gráfico Chord
Um gráfico de cordas (chord diagram) da demografia é uma visualização que ilustra as interações entre diferentes grupos de uma população, como regiões geográficas. Cada grupo é representado como um segmento em um círculo, e as conexões entre esses segmentos são mostradas como arcos ou cordas que atravessam o círculo. A espessura dessas cordas pode indicar a magnitude da interação ou a proporção da população que se move entre os grupos.
Gráfico chord representando a migração entre cidades coreanas
A partir da fonte National Geographic Information Institute que forneceu esses dados de 1970 até 2014, foi feito um gráfico chord.
Migração entre cidades/distritos coreanos de 1970 até 2014.
Code
library(tidyverse)library(viridis)library(patchwork)library(hrbrthemes)library(circlize)library(chorddiag)library(readxl)dados <-read_excel("C://Users//Aman_//Downloads//matriz.xlsx"); dados
Coreia do Sul Brasil
Coreia do Sul 0.00000 0.1377615
Brasil 74.56609 0.0000000
Curiosidades sobre imigrantes da Coreia do Sul no Ceará
Além das informações do vídeo, uma matéria de julho de 2012 disse que era esperado que 5000 coreanos passassem pelo Ceará até 2015 e de acordo com os dados da OBMigra, foram 2.641; E entre 2012 e 2016 Cumbuco teve em média 40 restaurantes coreanos.
Curiosidade: idades dos migrantes da Coreia do Sul
Migração Líquida Internacional de Estrangeiros por idade (2021~2022)
Migração Líquida Internacional de Coreanos por idade (2021~2022)
Projeções
Pirâmida Etária
Começamos aqui a analisar a estrutura por faixa etária e sexo da população Coreana, foi construída quatro pirâmides etárias, uma a cada quiquênio desde os anos 2000 até 2020. Observaremos a dinâmica da população ao longo destas duas decadas.
faixa_etaria_ordem <-c("0 a 4", "5 a 9", "10 a 14", "15 a 19", "20 a 24", "25 a 29", "30 a 34", "35 a 39", "40 a 44","45 a 49","50 a 54","55 a 59","60 a 64","65 a 69","70 a 74","75 a 79","80 ou mais")df_long$FAIXA_ETARIA<-factor(df_long$FAIXA_ETARIA, levels = faixa_etaria_ordem)## Piramide referente ao ano 2000 ggplot(df_long, aes(x = FAIXA_ETARIA, y = ANO_2000, fill = SEXO)) +geom_bar(stat ="identity") +coord_flip() +scale_y_continuous(labels =function(x) format(abs(x), big.mark =".", scientific =FALSE)) +scale_fill_manual(values =c("MASCULINO"="cornflowerblue", "FEMININO"="indianred")) +labs(title ="Pirâmide Etária - 2000", x ="Faixa etária", y ="População", fill ="Sexo") +theme_minimal() +theme(axis.text.x =element_text(angle =45, hjust =1))
Ano 2005
Code
## Piramide referente ao ano de 2005df_long <- df_Juncao %>%mutate(ANO_2005=if_else(SEXO =="FEMININO", -ANO_2005, ANO_2005))faixa_etaria_ordem <-c("0 a 4", "5 a 9", "10 a 14", "15 a 19", "20 a 24", "25 a 29", "30 a 34", "35 a 39", "40 a 44","45 a 49","50 a 54","55 a 59","60 a 64","65 a 69","70 a 74","75 a 79","80 ou mais")df_long$FAIXA_ETARIA<-factor(df_long$FAIXA_ETARIA, levels = faixa_etaria_ordem)ggplot(df_long, aes(x = FAIXA_ETARIA, y = ANO_2005, fill = SEXO)) +geom_bar(stat ="identity") +coord_flip() +scale_y_continuous(labels =function(x) format(abs(x), big.mark =".", scientific =FALSE)) +scale_fill_manual(values =c("MASCULINO"="cornflowerblue", "FEMININO"="indianred")) +labs(title ="Pirâmide Etária - 2005", x ="Faixa etária", y ="População", fill ="Sexo") +theme_minimal() +theme(axis.text.x =element_text(angle =45, hjust =1))
Ano 2010
Code
## Piramide referente ao ano de 2010df_long <- df_Juncao %>%mutate(ANO_2010=if_else(SEXO =="FEMININO", -ANO_2010, ANO_2010))faixa_etaria_ordem <-c("0 a 4", "5 a 9", "10 a 14", "15 a 19", "20 a 24", "25 a 29", "30 a 34", "35 a 39", "40 a 44","45 a 49","50 a 54","55 a 59","60 a 64","65 a 69","70 a 74","75 a 79","80 ou mais")df_long$FAIXA_ETARIA<-factor(df_long$FAIXA_ETARIA, levels = faixa_etaria_ordem)ggplot(df_long, aes(x = FAIXA_ETARIA, y = ANO_2010, fill = SEXO)) +geom_bar(stat ="identity") +coord_flip() +scale_y_continuous(labels =function(x) format(abs(x), big.mark =".", scientific =FALSE)) +scale_fill_manual(values =c("MASCULINO"="cornflowerblue", "FEMININO"="indianred")) +labs(title ="Pirâmide Etária - 2010", x ="Faixa etária", y ="População", fill ="Sexo") +theme_minimal() +theme(axis.text.x =element_text(angle =45, hjust =1))
#Ano 2015
Code
## Piramide referente ao ano de 2015df_long <- df_Juncao %>%mutate(ANO_2015=if_else(SEXO =="FEMININO", -ANO_2015, ANO_2015))faixa_etaria_ordem <-c("0 a 4", "5 a 9", "10 a 14", "15 a 19", "20 a 24", "25 a 29", "30 a 34", "35 a 39", "40 a 44","45 a 49","50 a 54","55 a 59","60 a 64","65 a 69","70 a 74","75 a 79","80 ou mais")df_long$FAIXA_ETARIA<-factor(df_long$FAIXA_ETARIA, levels = faixa_etaria_ordem)ggplot(df_long, aes(x = FAIXA_ETARIA, y = ANO_2015, fill = SEXO)) +geom_bar(stat ="identity") +coord_flip() +scale_y_continuous(labels =function(x) format(abs(x), big.mark =".", scientific =FALSE)) +scale_fill_manual(values =c("MASCULINO"="cornflowerblue", "FEMININO"="indianred")) +labs(title ="Pirâmide Etária - 2015", x ="Faixa etária", y ="População", fill ="Sexo") +theme_minimal() +theme(axis.text.x =element_text(angle =45, hjust =1))
Ano 2020
Code
## Piramide referente ao ano de 2020df_long <- df_Juncao %>%mutate(ANO_2020=if_else(SEXO =="FEMININO", -ANO_2020, ANO_2020))faixa_etaria_ordem <-c("0 a 4", "5 a 9", "10 a 14", "15 a 19", "20 a 24", "25 a 29", "30 a 34", "35 a 39", "40 a 44","45 a 49","50 a 54","55 a 59","60 a 64","65 a 69","70 a 74","75 a 79","80 ou mais")df_long$FAIXA_ETARIA<-factor(df_long$FAIXA_ETARIA, levels = faixa_etaria_ordem)ggplot(df_long, aes(x = FAIXA_ETARIA, y = ANO_2020, fill = SEXO)) +geom_bar(stat ="identity") +coord_flip() +scale_y_continuous(labels =function(x) format(abs(x), big.mark =".", scientific =FALSE)) +scale_fill_manual(values =c("MASCULINO"="cornflowerblue", "FEMININO"="indianred")) +labs(title ="Pirâmide Etária - 2020", x ="Faixa etária", y ="População", fill ="Sexo") +theme_minimal() +theme(axis.text.x =element_text(angle =45, hjust =1))
Extrapolação
Apresentaremos agora uma projeção simples, feita a partir da extrapolação matemática considerando um padrão de crescimento da população coreana.
A fórmula para calcular a projeção simples da população é dada por:
\[
P_t = P_l + \frac{(\Delta t - l) \cdot (P_b - P_l)}{(\Delta l - b)}
\]
Code
Projecao_Coreia<-read_xlsx("C://Users//Aman_//Downloads//População1.xlsx", sheet ="projec")names(Projecao_Coreia)<-c("Ano","Populacao_Total")Projecao_Coreia$Ano<-as.numeric(Projecao_Coreia$Ano)#motando função para projecao da populacaoprojetar_populacao_ate_2050 <-function(Projecao_Coreia) {# Definir o ano base e o ano inicial ano_inicial <-2000 ano_base <-2010 ano_fim <-2050# Obter as populações para os anos base e inicial populacao_base <- Projecao_Coreia$Populacao_Total[Projecao_Coreia$Ano == ano_base] populacao_inicial <- Projecao_Coreia$Populacao_Total[Projecao_Coreia$Ano == ano_inicial]# Intervalos delta_l <- ano_base - ano_inicial anos <-seq(from = ano_inicial, to = ano_fim, by =1)# Inicializar vetor para as populações projetadas populacoes_projetadas <-numeric(length(anos))for (ano in anos) {if (ano <= ano_base) { populacoes_projetadas[anos == ano] <- Projecao_Coreia$Populacao_Total[Projecao_Coreia$Ano == ano] } else { delta_t <- ano - ano_inicial populacoes_projetadas[anos == ano] <- populacao_inicial + (delta_t -0) * (populacao_base - populacao_inicial) / delta_l } }# Criar data frame com os anos e populações projetadas resultado <-data.frame(Ano = anos,Populacao_Projetada = populacoes_projetadas )return(resultado)}resultado_projecao <-projetar_populacao_ate_2050(Projecao_Coreia)print(resultado_projecao)
Grafico<-ggplot() +geom_line(data = Projecao_Coreia, aes(x = Ano, y = Populacao_Total, color ="Dados Reais"), size =1) +geom_line(data = resultado_projecao, aes(x = Ano, y = Populacao_Projetada, color ="Projeção"), linetype ="dashed", size =1) +labs(title ="Evolução Populacional e Projeção até 2050",x ="Ano",y ="População Total",color ="Legenda") +theme_minimal() +scale_color_manual(values =c("Dados Reais"="blue", "Projeção"="red"))Grafico <- Grafico +scale_y_continuous(labels = scales::label_number(scale =1e-6, suffix ="M"),breaks =pretty(c(min(Projecao_Coreia$Populacao_Total), max(resultado_projecao$Populacao_Projetada)), n =3))Grafico
Interpretação:
Nossa projeção teve como base ano de 2010 e a população inicial no ano de 2000 , podemos observar que a nossa projeção em boa parte até acompanha a reta com dados reais, mesmo desconsiderando taxas migratórias, taxa de natalidade e mortalidade.
Pirâmide Etária realidade - futuro (2050)
Code
library(ggplot2)library(readxl)library(dplyr)Pop2050<-read_xlsx("C://Users//Aman_//Downloads//pop2050.xlsx")Pop2050 <- Pop2050 %>%mutate(FaixaEtaria =case_when( idade %in%0:4~"0-4", idade %in%5:9~"5-9", idade %in%10:14~"10-14", idade %in%15:19~"15-19", idade %in%20:24~"20-24", idade %in%25:29~"25-29", idade %in%30:34~"30-34", idade %in%35:39~"35-39", idade %in%40:44~"40-44", idade %in%45:49~"45-49", idade %in%50:54~"50-54", idade %in%55:59~"55-59", idade %in%60:64~"60-64", idade %in%65:69~"65-69", idade %in%70:74~"70-74", idade %in%75:79~"75-79", idade =="80 +"~"80+" ))Pop_resumido <- Pop2050 %>%group_by(SEXO, FaixaEtaria) %>%summarise(Ano_2050 =sum(Ano_2050))Pop_resumido$FaixaEtaria <-factor(Pop_resumido$FaixaEtaria, levels =c("0-4", "5-9", "10-14", "15-19", "20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70-74", "75-79", "80+"))# Separando os dados por sexo e ajustando os valores dos homens para negativosdf_masc <- Pop_resumido %>%filter(SEXO =="Feminino") %>%mutate(Ano_2050 =-Ano_2050)df_fem <- Pop_resumido %>%filter(SEXO =="Masculino")df_comb <-bind_rows(df_masc, df_fem)# Criando a pirâmide etáriaggplot(df_comb, aes(x = FaixaEtaria, y = Ano_2050, fill = SEXO)) +geom_bar(stat ="identity", position ="identity") +coord_flip() +scale_y_continuous(labels =function(x) format(abs(x), big.mark =".", scientific =FALSE))+labs(title ="Pirâmide Etária em 2050",x ="Faixa Etária",y ="População",fill ="Sexo") +theme_minimal()
Conclusão
A demografia da Coreia do Sul está passando por transformações significativas, moldadas pelas taxas de natalidade e fecundidade na Coreia do Sul que estão entre as mais baixas do mundo. Isso se deve a vários fatores, incluindo a crescente participação das mulheres no mercado de trabalho e mudanças nas atitudes sociais em relação ao casamento e à família. Esta tendência resulta em um declínio na população jovem, o que pode levar a uma força de trabalho encolhida e a desafios na sustentação do crescimento econômico a longo prazo.
Por outro lado, a Coreia do Sul está experimentando um aumento significativo na qualidade de vida, refletido na expectativa de vida mais longa e, consequentemente, baixas taxas de mortalidade (com exceção da pandemia). Avanços na medicina, melhoria nas condições de vida e maior conscientização sobre saúde contribuíram para este aumento. A população idosa está crescendo rapidamente, o que coloca pressão sobre os sistemas de previdência social e de saúde, exigindo reformas para garantir sustentabilidade financeira.
A combinação de uma população envelhecida e uma força de trabalho em declínio apresenta desafios únicos. Haverá uma maior necessidade de políticas que incentivem a imigração e a inclusão de mais mulheres e idosos no mercado de trabalho. Além disso, investimentos em tecnologia e automação serão cruciais para manter a produtividade econômica.
Source Code
---title: "Relatório - Estudo Demográfico da Coreia do Sul"author: "Marea"format: html: code-fold: true code-tools: truetheme: light: [pulse,custom.scss] dark: [vapor,custom.scss]title-block-banner: trueexecute: warning: false message: falseeditor: visual---## IntroduçãoA Coreia do Sul, um dos países mais dinâmicos e tecnologicamente avançados do mundo, experimentou profundas transformações demográficas ao longo das últimas décadas. Este relatório demográfico busca oferecer uma visão abrangente sobre os principais indicadores populacionais da Coreia do Sul, focando em três aspectos fundamentais: mortalidade, fecundidade e migração. Além disso, serão apresentadas projeções futuras baseadas em tendências atuais e dados estatísticos disponíveis.## Razão de SexoA razão de sexo é um indicador demográfico que expressa a relação entre o número de homens e o número de mulheres em uma população. Esse indicador é geralmente apresentado na forma de uma proporção ou uma razão, mostrando o número de homens para cada 100 mulheres.### Como calcularFórmula: $RS = (\frac{Numero de Homens}{Numero de mulheres}) \times{100}$```{r}library(readxl)pop_sexo <-read_excel("C://Users//Aman_//Downloads//pop_sexo.xlsx"); pop_sexorazao_sexo <-function(caminho_arquivo) { pop_sexo <-read_excel(caminho_arquivo) vetor <-numeric(length =ncol(pop_sexo) -1)for (i in2:50) { vetor[i -1] <-100*(pop_sexo[2, i] / pop_sexo[3, i]) }return(vetor)}caminho_arquivo <-"C://Users//Aman_//Downloads//pop_sexo.xlsx"resultado <-razao_sexo(caminho_arquivo)resultado <-as.numeric(resultado)anos <-1999:2047dataframe <-cbind(razao_sexo = resultado, anos = anos)dataframe <-as.data.frame(dataframe)library(ggplot2)ggplot(data = dataframe, aes(x = anos, y = razao_sexo)) +geom_line() +labs(title ="Razão entre Sexos ao Longo dos Anos",x ="Ano",y ="Razão Sexo") +theme_minimal()```#### Interpretação:De 1999 até 2020 teve excesso de homens, em 2024 teve praticamente um equilíbrio com RS = 100.00961, e desde então excesso de mulheres.## Indice de Whipple 2020:### Mulheres:```{r}numerador <-read_excel("C://Users//Aman_//Downloads//whipple_numerador.xlsx");total_25m <-as.numeric(numerador[3,3]); total_25mtotal_30m <-as.numeric(numerador[4,3]); total_30mtotal_35m <-as.numeric(numerador[5,3]); total_35mtotal_40m <-as.numeric(numerador[6,3]); total_40mtotal_45m <-as.numeric(numerador[7,3]); total_45mtotal_50m <-as.numeric(numerador[8,3]); total_50mtotal_55m <-as.numeric(numerador[9,3]); total_55mtotal_60m <-as.numeric(numerador[10,3]); total_60mdenominador <-read_excel("C://Users//Aman_//Downloads//whipple_denominador.xlsx")total_m <-as.numeric(denominador[2,3])whipple_m <-500*(total_25m + total_30m + total_35m + total_40m + total_45m + total_50m + total_55m + total_60m) / total_mwhipple_m```#### Interpretação:Resultado: 59,38759. Menos de 105 = dados muito exatos.### Homens:```{r}total_25h <-as.numeric(numerador[3,4]); total_25htotal_30h <-as.numeric(numerador[4,4]); total_30htotal_35h <-as.numeric(numerador[5,4]); total_35htotal_40h <-as.numeric(numerador[6,4]); total_40htotal_45h <-as.numeric(numerador[7,4]); total_45htotal_50h <-as.numeric(numerador[8,4]); total_50htotal_55h <-as.numeric(numerador[9,4]); total_55htotal_60h <-as.numeric(numerador[10,4]); total_60htotal_h <-as.numeric(denominador[2,4])whipple_h <-500*(total_25h + total_30h + total_35h + total_40h + total_45h + total_50h + total_55h + total_60h) / total_hwhipple_h```#### Interpretação:Resultado: 61,91427. Menos de 105 = dados muito exatos.## Taxa Bruta de MortalidadeA taxa bruta de mortalidade é um indicador demográfico que quantifica o número de mortes em uma população por cada 1.000 habitantes em um determinado período, geralmente um ano.```{r}mortes <-read_excel("C://Users//Aman_//Downloads//total_mortes.xlsx"); mortestbm <-function(caminho_arquivo) { mortes <-read_excel(caminho_arquivo) vetor <-numeric(11)for (i in3:13) { j <- i +12 vetor[i -2] <-1000*(mortes[1, i] / pop_sexo[1, j]) }return(vetor)}caminho_arquivo <-"C://Users//Aman_//Downloads//total_mortes.xlsx"resultado2 <-tbm(caminho_arquivo)resultado2 <-as.numeric(resultado2)anos <-2012:2022dataframe <-cbind(TBM = resultado2, anos = anos)dataframe <-as.data.frame(dataframe)ggplot(data = dataframe, aes(x = anos, y = TBM)) +geom_line() +labs(title ="TBM ao Longo dos Anos",x ="Ano",y ="Taxa Bruta de Mortalidade") +theme_minimal()```#### Interpretação:Em 2018 houve 298.820 mortes, refletindo um aumento de 13.286 mortes (4,7%) em relação a 2017. Este foi o número mais alto desde que estatísticas comparáveis foram publicadas pela primeira vez em 1983. Porém, esses números nem se comparam com o aumento de 17,4% de 2022 para 2021 devido a pandemia do COVID-19.### Curiosidade: Mortalidade feminina```{r}tbm <-function(caminho_arquivo) { mortes <-read_excel(caminho_arquivo) vetor <-numeric(11)for (i in3:13) { j <- i +12 vetor[i -2] <-1000*(mortes[24, i] / pop_sexo[3, j]) }return(vetor)}caminho_arquivo <-"C://Users//Aman_//Downloads//total_mortes.xlsx"resultado2 <-tbm(caminho_arquivo)resultado2 <-as.numeric(resultado2)anos <-2012:2022dataframe <-cbind(TBM = resultado2, anos = anos)dataframe <-as.data.frame(dataframe)ggplot(data = dataframe, aes(x = anos, y = TBM)) +geom_line() +labs(title ="TBM de mulheres ao Longo dos Anos",x ="Ano",y ="Taxa Bruta de Mortalidade") +theme_minimal()```#### Interpretação:É possível ver que é praticamente o mesmo gráfico, logo, praticamente a mesma interpretação.## Taxas Específicas de Mortalidade em 2020As Taxas Específicas de Mortalidade são indicadores demográficos que medem a mortalidade em grupos específicos dentro de uma população, normalmente categorizados por idade, sexo, causas de morte ou outras características relevantes. Esses indicadores são essenciais para uma análise detalhada da mortalidade, permitindo a identificação de padrões e fatores de risco específicos.```{r}mortes2 <-read_excel("C://Users//Aman_//Downloads//mort_idade.xlsx"); mortes2total_pop <-read_excel("C://Users//Aman_//Downloads//total_pop.xlsx");##Mulherestem_04 <-1000*((as.numeric(mortes2[21,3]) +as.numeric(mortes2[22,3])) /as.numeric(total_pop[3,3])); tem_04tem_m <-function(caminho_arquivo) { mortes2 <-read_excel(caminho_arquivo) vetor <-numeric(14)for (i in23:37) { j <- i -19 vetor[i -22] <-1000*(as.numeric(mortes2[i, 3]) /as.numeric(total_pop[j, 3])) }return(vetor)}caminho_arquivo <-"C://Users//Aman_//Downloads//mort_idade.xlsx"resultado3 <-tem_m(caminho_arquivo)resultado3 <-as.numeric(resultado3)##Homenstem_04h <-1000*((as.numeric(mortes2[40,3]) +as.numeric(mortes2[41,3])) /as.numeric(total_pop[3,4])); tem_04htem_h <-function(caminho_arquivo) { mortes2 <-read_excel(caminho_arquivo) vetor <-numeric(14)for (i in42:56) { j <- i -38 vetor[i -41] <-1000*(as.numeric(mortes2[i, 3]) /as.numeric(total_pop[j, 4])) }return(vetor)}caminho_arquivo <-"C://Users//Aman_//Downloads//mort_idade.xlsx"resultado4 <-tem_h(caminho_arquivo)resultado4 <-as.numeric(resultado4)vetor_unificado_m <-c(tem_04, resultado3)vetor_unificado_h <-c(tem_04h, resultado4)anos <-c("0~04","05~09","10~14","15~19","20~24","25~29","30~34","35~39","40~44","45~49","50~54","55~59","60~64","65~69","70~74","75~79")dataframe <-cbind(mulheres = vetor_unificado_m, homens = vetor_unificado_h, anos = anos)dataframe <-as.data.frame(dataframe); dataframe```### Gráfico/Curva jota:```{r}library(tidyr)dataframe_long <-pivot_longer(dataframe, cols =c("homens", "mulheres"), names_to ="genero", values_to ="taxa")# Criar gráfico com ggplot2ggplot(data = dataframe_long, aes(x = anos, y =as.numeric(taxa), group = genero, color = genero)) +geom_line(size =1) +geom_point(size =3) +labs(title ="Taxas Específicas de Mortalidade por Idade e Gênero",x ="Idade",y ="Taxa de Mortalidade",color ="Gênero") +scale_color_manual(values =c("mulheres"="purple", "homens"="blue")) +theme_minimal() +theme(axis.text.x =element_text(angle =45, hjust =1))```#### Interpretação:Comparado com as outras idades jovens, 0\~4 anos é a que tem a maior taxa, além de que desse período até os 30\~34 os números de mortes para homens e mulheres permanece praticamente o mesmo. Depois os homens tendem a morrer mais que as mulheres.### Diagrama de LexisIremos explorar a dinâmica da população através do Diagrama de Lexis, uma ferramenta fundamental na demografia que ilustra as mudanças na população ao longo do tempo, combinando idade e ano. O Diagrama de Lexis nos oferece uma perspectiva única sobre as transições entre as faixas etárias.Obs: Por questões estéticas o diagrama teve que ser dívido em dois e apresentar os dados com relação a população em porcentagem.```{r}library(LexisPlotR)library(dplyr)Pop1_ambos<-read_xlsx("C://Users//Aman_//Downloads//População.xlsx", sheet="Ambos")Pop1_ambos<-Pop1_ambos[,-24]Pop1_ambos<-Pop1_ambos[,-24]Pop1_ambos_long<- Pop1_ambos %>%gather(ano, populacao, `2000`:`2020`, na.rm =TRUE) %>%mutate(ano =as.numeric(ano))head(Pop1_ambos_long)Pop1_ambos_long1 <- Pop1_ambos_long %>%mutate(periodo =case_when( ano >=2000& ano <=2005~"2000-2005", ano >=2006& ano <=2010~"2006-2010", ano >=2011& ano <=2015~"2011-2015", ano >=2016& ano <=2020~"2016-2020" )) %>%group_by(periodo, FAIXA_ETARIA) %>%summarise(sum_pop =sum(populacao))Pop1_ambos_long2<- Pop1_ambos_long1 %>%separate(periodo, into =c("Ano_Inicial", "Ano_Final"), sep ="-", convert =TRUE)Pop1_ambos_long2$Ano_Medio <- (Pop1_ambos_long2$Ano_Inicial + Pop1_ambos_long2$Ano_Final)/2Pop1_ambos_long2$Idade_Inicial <-as.numeric(sub("-.*", "", Pop1_ambos_long2$FAIXA_ETARIA))Pop1_ambos_long2$Idade_Final <-as.numeric(sub(".*-", "", Pop1_ambos_long2$FAIXA_ETARIA)) +1Pop1_ambos_long2$Idade_Central <- (Pop1_ambos_long2$Idade_Final + Pop1_ambos_long2$Idade_Inicial)/2Pop1_ambos_long2<- Pop1_ambos_long2 %>%mutate(Idade_Central=ifelse(is.na(Idade_Central), 80, Idade_Central))Pop1_ambos_long2<- Pop1_ambos_long2 %>%mutate(Ano_Medio =as.Date(paste0(floor((Ano_Inicial + Ano_Final) /2), "-01-01")))dados_proporcao <- Pop1_ambos_long2 %>%group_by(Ano_Final) %>%mutate(proporcao = sum_pop /sum(sum_pop))dados_proporcao$proporcao<-round(dados_proporcao$proporcao,3)idade_central_ord<-c("2.5", "7.5", "12.5", "17.5", "22.5", "27.5", "32.5","37.5","42.5","47.5","52.5","57.5","62.5","67.5","72.5","77.5","80+")dados_proporcao <- dados_proporcao %>%mutate(idade_central_or =factor(idade_central_ord, levels = idade_central_ord))## Lexis das idades entre 0 e 40 anoslexis_grid(year_start =2000,year_end =2020,age_start =0,age_end =40,delta =5) +geom_text(data = dados_proporcao, aes(x = Ano_Medio, y = Idade_Central, label = proporcao), size =3) +labs(title ="Diagrama de Lexis - 40",x ="Ano",y ="Idade" ) +theme_minimal() +theme(plot.title =element_text(hjust =0.5, size =16),axis.title =element_text(size =12),axis.text =element_text(size =10) )```#### Lexis das idades entre 40 e 80 anos```{r}lexis_grid(year_start =2000,year_end =2020,age_start =40,age_end =80,delta =5) +geom_text(data = dados_proporcao, aes(x = Ano_Medio, y = Idade_Central, label = proporcao), size =3) +labs(title ="Diagrama de Lexis - 80",x ="Ano",y ="Idade" ) +theme_minimal() +theme(plot.title =element_text(hjust =0.5, size =16),axis.title =element_text(size =12),axis.text =element_text(size =10))```## Fecundidade### Taxas de Fecundidade EspecíficasOutra vez repetindo os procedimentos adotados no caso da mortalidade, para o cálculo das Taxas Específicas de Fecundidade (TEFs) por idade, relaciona-se o número de nascimentos ocorridos entre mulheres de uma determinada idade ou grupo etário com o tempo total de exposição das mesmas ao risco de terem filhos naquele mesmo período ou o número total de anos-pessoa vividos em exposição ao risco no período.Fórmula utilizada na fonte Korean Statistical Information Service (KOSIS): $(\frac{número de bebês nascidos por idade da mãe}{população feminina nessa idade}) × 1.000$```{r}library(ggplot2)library(tidyr)# Criar um conjunto de dadosdados <-data.frame(Ano =1982:2010,`15-19`=c(15.0, 13.0, 11.7, 10.1, 8.7, 7.0, 5.7, 4.5, 4.2, 4.3, 4.7, 4.4, 4.0, 3.6, 3.3, 3.0, 2.8, 2.6, 2.5, 2.2, 2.6, 2.5, 2.3, 2.1, 2.2, 2.2, 1.7, 1.7, 1.5),`20-24`=c(159.1, 146.6, 129.7, 118.7, 104.2, 97.3, 92.1, 89.7, 83.2, 84.8, 82.8, 72.7, 66.0, 62.9, 58.8, 54.2, 48.3, 43.3, 38.8, 31.4, 26.5, 23.6, 20.6, 17.8, 17.6, 19.5, 18.2, 16.5, 16.2),`25-29`=c(213.9, 187.1, 159.5, 159.1, 160.0, 159.3, 163.5, 165.6, 169.4, 186.2, 188.9, 178.8, 179.6, 177.1, 167.6, 159.7, 152.1, 147.2, 149.6, 129.2, 110.9, 111.7, 104.5, 91.7, 89.4, 95.5, 85.6, 80.4, 79.8),`30-34`=c(72.5, 55.6, 42.0, 41.1, 39.6, 39.2, 41.9, 44.7, 50.5, 58.8, 65.1, 64.2, 68.0, 69.6, 71.1, 71.5, 71.2, 72.3, 83.5, 77.5, 74.5, 79.1, 83.2, 81.5, 89.4, 101.3, 101.5, 100.8, 112.7),`35-39`=c(20.0, 14.6, 10.4, 8.8, 8.3, 7.7, 7.9, 8.5, 9.6, 10.8, 12.6, 13.8, 14.7, 15.2, 15.5, 15.4, 15.2, 15.3, 17.2, 17.0, 16.6, 17.1, 18.2, 18.7, 21.2, 25.6, 26.5, 27.3, 32.6),`40-44`=c(5.3, 4.0, 2.8, 2.2, 1.9, 1.7, 1.5, 1.5, 1.5, 1.5, 1.8, 2.0, 2.2, 2.3, 2.4, 2.3, 2.3, 2.4, 2.5, 2.4, 2.4, 2.4, 2.4, 2.4, 2.6, 3.1, 3.2, 3.4, 4.1),`45-49`=c(1.3, 0.8, 0.6, 0.5, 0.5, 0.3, 0.3, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2),TFT =c(2.39, 2.06, 1.74, 1.66, 1.58, 1.53, 1.55, 1.56, 1.57, 1.71, 1.76, 1.65, 1.66, 1.63, 1.57, 1.52, 1.45, 1.41, 1.47, 1.30, 1.17, 1.18, 1.15, 1.08, 1.12, 1.25, 1.19, 1.15, 1.22))dadosdados1 <-pivot_longer(dados, cols =-Ano, names_to ="FaixaEtaria", values_to ="Taxa")dados1ggplot(dados1, aes(x = Ano, y = Taxa, color = FaixaEtaria)) +geom_line(size =1) +labs(title ="Taxa de Fecundidade Específica por Faixa Etária (1982-2010)",x ="Ano",y ="Taxa de Fecundidade",color ="Faixa Etária") +theme_minimal()```#### Interpretação:Como podemos perceber pelas taxas de fecundidade específicas houve uma queda e uma inversão na época que as mulheres passaram a engravidar, nos anos 80 a faixa etária era de 25 a 29 anos e nos anos de 2010 as mulheres passaram a engravidar entre os 30 e 34 anos, que indica a entrada das mulheres no mercado de trabalho.### Taxa de Fecundidade TotalFórmula utilizada na fonte Korean Statistical Information Service (KOSIS): $(\frac{Soma das taxas de natalidade por idade (classe de 5 gerações)}{1.000}) × 5$```{r}library(tidyr)dados <-data.frame(Ano =1982:2010,TFT =c(2.39, 2.06, 1.74, 1.66, 1.58, 1.53, 1.55, 1.56, 1.57, 1.71, 1.76, 1.65, 1.66, 1.63, 1.57, 1.52, 1.45, 1.41, 1.47, 1.30, 1.17, 1.18, 1.15, 1.08, 1.12, 1.25, 1.19, 1.15, 1.22))dadosdados1 <-pivot_longer(dados, cols =-Ano, names_to ="FaixaEtaria", values_to ="Taxa")dados1ggplot(dados1, aes(x = Ano, y = Taxa, color = FaixaEtaria)) +geom_line(size =1) +labs(title ="Taxa de Fecundidade Total (1982-2010)",x ="Ano",y ="Taxa de Fecundidade",color ="Faixa Etária") +theme_minimal()library(ggplot2)# Definir os vetores com os dados fornecidosano <-2013:2022taxa_fecundidade_total <-c(1.187, 1.205, 1.239, 1.172, 1.052, 0.977, 0.918, 0.837, 0.808, 0.778)# Criar o data frametabela_fecundidade <-data.frame( ano, taxa_fecundidade_total)# Criar o gráficoggplot(data = tabela_fecundidade, aes(x = ano, y = taxa_fecundidade_total)) +geom_line(color ="blue") +geom_point(color ="red") +scale_x_continuous(breaks =seq(min(ano), max(ano), by =1), labels =as.character(seq(min(ano), max(ano), by =1))) +labs(title ="Taxa de Fecundidade Total (2013-2022)",x ="Ano",y ="Taxa de Fecundidade Total (filhos por mulher)") +theme_minimal()```#### Tabela```{r}library(dplyr)library(tidyr)library(knitr)library(kableExtra)dados <-data.frame(Ano =1982:2010,`15-19 anos`=c(15.0, 13.0, 11.7, 10.1, 8.7, 7.0, 5.7, 4.5, 4.2, 4.3, 4.7, 4.4, 4.0, 3.6, 3.3, 3.0, 2.8, 2.6, 2.5, 2.2, 2.6, 2.5, 2.3, 2.1, 2.2, 2.2, 1.7, 1.7, 1.5),`20-24 anos`=c(159.1, 146.6, 129.7, 118.7, 104.2, 97.3, 92.1, 89.7, 83.2, 84.8, 82.8, 72.7, 66.0, 62.9, 58.8, 54.2, 48.3, 43.3, 38.8, 31.4, 26.5, 23.6, 20.6, 17.8, 17.6, 19.5, 18.2, 16.5, 16.2),`25-29 anos`=c(213.9, 187.1, 159.5, 159.1, 160.0, 159.3, 163.5, 165.6, 169.4, 186.2, 188.9, 178.8, 179.6, 177.1, 167.6, 159.7, 152.1, 147.2, 149.6, 129.2, 110.9, 111.7, 104.5, 91.7, 89.4, 95.5, 85.6, 80.4, 79.8),`30-34 anos`=c(72.5, 55.6, 42.0, 41.1, 39.6, 39.2, 41.9, 44.7, 50.5, 58.8, 65.1, 64.2, 68.0, 69.6, 71.1, 71.5, 71.2, 72.3, 83.5, 77.5, 74.5, 79.1, 83.2, 81.5, 89.4, 101.3, 101.5, 100.8, 112.7),`35-39 anos`=c(20.0, 14.6, 10.4, 8.8, 8.3, 7.7, 7.9, 8.5, 9.6, 10.8, 12.6, 13.8, 14.7, 15.2, 15.5, 15.4, 15.2, 15.3, 17.2, 17.0, 16.6, 17.1, 18.2, 18.7, 21.2, 25.6, 26.5, 27.3, 32.6),`40-44 anos`=c(5.3, 4.0, 2.8, 2.2, 1.9, 1.7, 1.5, 1.5, 1.5, 1.5, 1.8, 2.0, 2.2, 2.3, 2.4, 2.3, 2.3, 2.4, 2.5, 2.4, 2.4, 2.4, 2.4, 2.4, 2.6, 3.1, 3.2, 3.4, 4.1),`45-49 anos`=c(1.3, 0.8, 0.6, 0.5, 0.5, 0.3, 0.3, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2),TFT =c(2.39, 2.06, 1.74, 1.66, 1.58, 1.53, 1.55, 1.56, 1.57, 1.71, 1.76, 1.65, 1.66, 1.63, 1.57, 1.52, 1.45, 1.41, 1.47, 1.30, 1.17, 1.18, 1.15, 1.08, 1.12, 1.25, 1.19, 1.15, 1.22))# Gerar a tabelakable(dados, caption ="Taxa de fecundidade materna por idade e Taxa de fecundidade total (TFT)", align ="c") %>%kable_styling(bootstrap_options =c("striped", "hover", "condensed", "responsive"))```#### Interpretação:Como podemos perceber pelo gráfico a TFG é baixa, o que indica um baixo nível de nascimentos em relação ao número de mulheres em idade fértil.Indicando uma baixa taxa de natalidade. Percebemos que houve uma queda dos anos de 1980 até 2010, a taxa de fecundidade era superior a 2 filhos por mulher e em 2010 ficou abaixo de 1,5 filhos por mulher. E isso se dá pela cultura da Coreia sendo resultado de uma combinação de fatores sociais, econômicos e culturais do país. Uma das principais razões são: custos elevados de criação dos filhos, mercado de trabalho competitivo e desigualdade de gênero,mudanças nos valores e atitudes sociais, políticas de apoio insuficientes, pressões sociais e culturais.### Taxa Bruta de NatalidadeComo as taxas anteriormente definidas, a Taxa Bruta de Natalidade (TBN) é calculada relacionando-se o número total de nascimentos ocorridos no período com o tempo total de exposição daqueles que estiveram expostos ao risco de ter um filho naquele mesmo período ou o número total de anos pessoa vividos em exposição ao risco no período. Para fins de apresentação, multiplica-se o resultado por mil.```{r}library(ggplot2)# Definir os vetores com os dados fornecidosano <-2013:2022nascimentos <-c(436455, 435435, 438420, 406243, 357771, 326822, 302676, 272337, 260562, 249186)populacao_total <-c(25012374, 25765673, 26513030, 27261747, 27984155, 28704674, 29435571, 30130983, 30838302, 31544266)# Calcular a taxa bruta de natalidadetaxa_bruta_natalidade <- (nascimentos / populacao_total) *1000# Criar o data frametabela_natalidade <-data.frame( ano, taxa_bruta_natalidade)# Criar o gráficoggplot(data = tabela_natalidade, aes(x = ano, y = taxa_bruta_natalidade)) +geom_line(color ="blue") +geom_point(color ="red") +scale_x_continuous(breaks =seq(min(ano), max(ano), by =1), labels =as.character(seq(min(ano), max(ano), by =1))) +labs(title ="Taxa Bruta de Natalidade (2013-2022)",x ="Ano",y ="Taxa Bruta de Natalidade (nascimentos por 1.000 habitantes)") +theme_minimal()```#### InterpretaçãoPercebemos pelo gráfico que a taxa bruta de natalidade vem caindo desde 2013, mas a sua queda acentuou em 2015. Indicando um baixo número de nascimentos em relação a quantidade de mulheres expostas ao risco de engravidar.### Taxa de Fecundidade GeralPara um primeiro refinamento do conceito de TBN, é conveniente a exclusão do denominador dos homens e das mulheres fora das idades reprodutivas, que são as categorias principais de pessoas com risco zero. O resultado dessa redefinição é conhecido como a Taxa de Fecundidade Geral.```{r}#calculando os dados#install.packages("ggplot2")library(ggplot2)# Definir os vetores com os dados fornecidosano <-2013:2022nascimentos <-c(436455, 435435, 438420, 406243, 357771, 326822, 302676, 272337, 260562, 249186)populacao_feminina <-c(12461683, 12829090, 13192047, 13553627, 13902205, 14251843, 14605710, 14925590, 15262204, 15603301)# Calcular a taxa de fecundidadetaxa_fecundidade <-1000*(nascimentos / populacao_feminina)# Criar o data frametabela_fecundidade <-data.frame( ano, taxa_fecundidade)# Criar o gráficoggplot(data = tabela_fecundidade, aes(x = ano, y = taxa_fecundidade)) +geom_line(color ="blue") +geom_point(color ="red") +scale_x_continuous(breaks =seq(min(ano), max(ano), by =1), labels =as.character(seq(min(ano), max(ano), by =1))) +labs(title ="Taxa de Fecundidade Geral (2013-2022)",x ="Ano",y ="Taxa de Fecundidade (nascimentos por mulher)") +theme_minimal()```## MigraçãoMigração é o movimento de pessoas de uma localidade para outra, geralmente com o intuito de melhorar as condições de vida, encontrar emprego, obter educação ou escapar de conflitos e desastres naturais. Esse movimento pode ser interno, dentro das fronteiras de um país, ou internacional, atravessando fronteiras nacionais. As razões para a migração podem ser voluntárias, como a busca por melhores oportunidades econômicas, ou forçadas, como no caso de refugiados e deslocados internos devido a conflitos ou catástrofes.Na Coreia do Sul: historicamente, o país passou por significativas ondas de emigração, especialmente após a Guerra da Coreia (1953\~), quando muitos sul-coreanos emigraram para os Estados Unidos, Japão e outras nações em busca de melhores oportunidades econômicas. Nos últimos anos, a Coreia do Sul tem experimentado um aumento na imigração, com trabalhadores estrangeiros e estudantes internacionais contribuindo para a força de trabalho e diversidade cultural do país. Além disso, o governo sul-coreano tem implementado políticas para atrair talentos estrangeiros e mitigar os desafios demográficos, como o envelhecimento da população e a baixa taxa de natalidade.## Saldo Migratório$$SM = Imigrantes - Emigrantes$$```{r}SM_2000 <-371000-363000; SM_2000SM_2005 <-530000-625000; SM_2005SM_2010 <-632000-550000; SM_2010SM_2015 <-684000-622000; SM_2015SM_2020 <-673000-560000; SM_2020SM_2022 <-606000-518000; SM_2022```#### Interpretação:Foram feitas as principais datas, mas, como é perceptível, os valores correspondem ao "net migrantes) no gráfico, então temos de todos os anos de 2000 até 2022. De 2001 até 2005 houveram mais emigrantes que imigrantes e em 2006 houve tanto uma diminuição no número de emigrantes quanto um aumento no número de imigrantes, um dos motivos que fez com que, em 2007, o Governo criasse leis para ajudar imigrantes. Também houve o caso do auge da pandemia, 2021, onde o SM também foi negativo.## Migração Bruta$$MB = Imigrantes + Emigrantes$$```{r}MB_2000 <-371000+363000; MB_2000MB_2005 <-530000+625000; MB_2005MB_2010 <-632000+550000; MB_2010MB_2015 <-684000+622000; MB_2015MB_2020 <-673000+560000; MB_2020MB_2022 <-606000+518000; MB_2022```#### Interpretação:Entre os anos analisados o que teve maior MB foi 2015.## Taxa Líquida de Migração$$TLM = \frac{Imigrantes - Emigrantes}{P}$$ Obs: P é a população observada no final do período.```{r}TLM_2000 <- (SM_2000/pop_sexo[1,3])*1000; TLM_2000TLM_2005 <- (SM_2005/pop_sexo[1,8])*1000; TLM_2005TLM_2010 <- (SM_2010/pop_sexo[1,13])*1000; TLM_2010TLM_2015 <- (SM_2015/pop_sexo[1,18])*1000; TLM_2015TLM_2020 <- (SM_2020/pop_sexo[1,23])*1000; TLM_2020TLM_2022 <- (SM_2022/pop_sexo[1,25])*1000; TLM_2022```## índice de Permanência$$IP = \frac{Imigrantes - Emigrantes}{Imigrantes}$$```{r}IP_2000 <- SM_2000/371000; IP_2000IP_2005 <- SM_2005/530000; IP_2005IP_2010 <- SM_2010/632000; IP_2010IP_2015 <- SM_2015/684000; IP_2015IP_2020 <- SM_2020/673000; IP_2020IP_2022 <- SM_2022/606000; IP_2022```## Índice de Eficácia Migratória$$IEM = \frac{Imigrantes - Emigrantes}{Imigrantes + Emigrantes}$$```{r}IEM_2000 <- SM_2000/MB_2000; IEM_2000IEM_2005 <- SM_2005/MB_2005; IEM_2005IEM_2010 <- SM_2010/MB_2010; IEM_2010IEM_2015 <- SM_2015/MB_2015; IEM_2015IEM_2020 <- SM_2020/MB_2020; IEM_2020IEM_2022 <- SM_2022/MB_2022; IEM_2022```#### Interpretação:Todos os anos representam área de circulação/rotatividade migratória.#### Índice de Reposição Populacional$$IRP = \frac{Imigrantes}{Emigrantes}$$```{r}IRP_2000 <-371000/363000; IRP_2000IRP_2005 <-530000/625000; IRP_2000IRP_2010 <-632000/550000; IRP_2010IRP_2015 <-684000/622000; IRP_2015IRP_2020 <-673000/560000; IRP_2020IRP_2022 <-606000/518000; IRP_2022```## Gráfico ChordUm gráfico de cordas (chord diagram) da demografia é uma visualização que ilustra as interações entre diferentes grupos de uma população, como regiões geográficas. Cada grupo é representado como um segmento em um círculo, e as conexões entre esses segmentos são mostradas como arcos ou cordas que atravessam o círculo. A espessura dessas cordas pode indicar a magnitude da interação ou a proporção da população que se move entre os grupos.### Gráfico chord representando a migração entre cidades coreanasA partir da fonte National Geographic Information Institute que forneceu esses dados de 1970 até 2014, foi feito um gráfico chord.```{r}library(tidyverse)library(viridis)library(patchwork)library(hrbrthemes)library(circlize)library(chorddiag)library(readxl)dados <-read_excel("C://Users//Aman_//Downloads//matriz.xlsx"); dadoscolnames(dados) <-c("Seul", "Incheon e Gyeonggi-do", "Jeju", "Gangwon-do", "Chungcheong", "Honam", "Yeongnam")rownames(dados) <-colnames(dados)data <- dados/10000; datadata_long <- data %>% rownames_to_column %>%gather(key ='key', value ='value', -rowname)circos.clear()circos.par(start.degree =90, gap.degree =4, track.margin =c(-0.1, 0.1), points.overflow.warning =FALSE)par(mar =rep(0, 4))set.seed(1992)mycolor <-viridis(7, alpha =1, begin =0, end =1, option ="D")mycolor <- mycolor[sample(1:7)]names(mycolor) <-colnames(dados)chordDiagram(x = data_long, grid.col = mycolor[data_long$rowname],transparency =0.25,directional =1,direction.type =c("arrows", "diffHeight"), diffHeight =-0.04,annotationTrack ="grid", annotationTrackHeight =c(0.05, 0.1),link.arr.type ="big.arrow", link.sort =TRUE, link.largest.ontop =TRUE)options(scipen =999)circos.trackPlotRegion(track.index =1, bg.border =NA, panel.fun =function(x, y, xlim, ylim) { sector.index <-get.cell.meta.data("sector.index") xlim <-sapply(sector.index, function(x) get.cell.meta.data("xlim", sector.index = x)) ylim <-get.cell.meta.data("ylim")for (i inseq_along(sector.index)) {circos.text(x =mean(xlim[i, ]), y = ylim[2] +3,labels = sector.index[i], facing ="inside", cex =0.8,niceFacing =TRUE,adj =c(0, 0) ) }circos.axis(h ="top", major.at =NULL, minor.ticks =1, labels.niceFacing =TRUE,major.tick.length =1.3 ) })```#### Mapa dessas cidades/distritos```{r}library(leaflet)df <-data.frame(name =c("Incheon", "Seoul", "Gangwon", "Chuncheong", "Honam", "Jeju", "Yeongnam"),lat =c(37.4552,37.5604,37.7500,36.2110,36.3816,33.4429,35.5499),lng =c(126.7026,126.9800,128.2500,127.2490,127.4145,126.5210,129.3166),col=c("blue","blue","steelblue","steelblue","steelblue","steelblue", "steelblue"))df <- df %>%leaflet() %>%addTiles() %>%addMarkers(popup=df$name) %>%addCircleMarkers(color = df$col) %>%addLegend(labels =c("principais","interior"), colors =c("blue", "steelblue"), title ="Mapa da Coreia do Sul")df```### Índice de Intensidade Migratória 2022```{r}library(tidyr)matriz_migracao <-matrix(c(0, 675, 5501, 0), nrow =2, byrow =TRUE)rownames(matriz_migracao) <-c("Coreia do Sul", "Brasil")colnames(matriz_migracao) <-c("Coreia do Sul", "Brasil")matriz_migracaototal_emigrantes <-rowSums(matriz_migracao)total_imigrantes <-colSums(matriz_migracao)total_fluxos <-sum(matriz_migracao)print(paste("Total dos Fluxos Migratórios (T):", total_fluxos))calcular_IIM <-function(matriz, total_fluxos, total_imigrantes, total_emigrantes) { n <-nrow(matriz) m <-ncol(matriz) IIM <-matrix(0, n, m)for (i in1:n) {for (j in1:m) {if (total_imigrantes[i] !=0&& total_emigrantes[j] !=0) { IIM[i, j] <- (matriz[i, j] * total_fluxos) / (total_imigrantes[i] * total_emigrantes[j]) } } }return(IIM)}IIM <-calcular_IIM(matriz_migracao, total_fluxos, total_imigrantes, total_emigrantes)rownames(IIM) <-rownames(matriz_migracao)colnames(IIM) <-colnames(matriz_migracao)IIM```## Curiosidades sobre imigrantes da Coreia do Sul no CearáAlém das informações do vídeo, uma matéria de julho de 2012 disse que era esperado que 5000 coreanos passassem pelo Ceará até 2015 e de acordo com os dados da OBMigra, foram 2.641; E entre 2012 e 2016 Cumbuco teve em média 40 restaurantes coreanos.[](https://www.youtube.com/watch?v=RG2L7G6UTlg)## Curiosidade: idades dos migrantes da Coreia do Sul.jpeg)## Projeções### Pirâmida EtáriaComeçamos aqui a analisar a estrutura por faixa etária e sexo da população Coreana, foi construída quatro pirâmides etárias, uma a cada quiquênio desde os anos 2000 até 2020. Observaremos a dinâmica da população ao longo destas duas decadas.#### Ano 2000```{r}library(readxl)library(tidyverse)library(dplyr)library(ggplot2)Pop1_Mas=read_xlsx("C://Users//Aman_//Downloads//População.xlsx", sheet="Masculino")Pop1_Fem=read_xlsx("C://Users//Aman_//Downloads//População.xlsx", sheet="Feminino")names(Pop1_Fem)=c("SEXO","FAIXA_ETARIA","ANO_2000","ANO_2001","ANO_2002","ANO_2003","ANO_2004","ANO_2005","ANO_2006","ANO_2007","ANO_2008","ANO_2009","ANO_2010","ANO_2011","ANO_2012","ANO_2013","ANO_2014","ANO_2015","ANO_2016","ANO_2017","ANO_2018","ANO_2019","ANO_2020","ANO_2021","ANO_2022")names(Pop1_Mas)=c("SEXO","FAIXA_ETARIA","ANO_2000","ANO_2001","ANO_2002","ANO_2003","ANO_2004","ANO_2005","ANO_2006","ANO_2007","ANO_2008","ANO_2009","ANO_2010","ANO_2011","ANO_2012","ANO_2013","ANO_2014","ANO_2015","ANO_2016","ANO_2017","ANO_2018","ANO_2019","ANO_2020","ANO_2021","ANO_2022")df_Juncao<-bind_rows(Pop1_Mas,Pop1_Fem)is.numeric(df_Juncao$ANO_2000)df_long <- df_Juncao %>%mutate(ANO_2000=if_else(SEXO =="FEMININO", -ANO_2000, ANO_2000))print(df_long)faixa_etaria_ordem <-c("0 a 4", "5 a 9", "10 a 14", "15 a 19", "20 a 24", "25 a 29", "30 a 34", "35 a 39", "40 a 44","45 a 49","50 a 54","55 a 59","60 a 64","65 a 69","70 a 74","75 a 79","80 ou mais")df_long$FAIXA_ETARIA<-factor(df_long$FAIXA_ETARIA, levels = faixa_etaria_ordem)## Piramide referente ao ano 2000 ggplot(df_long, aes(x = FAIXA_ETARIA, y = ANO_2000, fill = SEXO)) +geom_bar(stat ="identity") +coord_flip() +scale_y_continuous(labels =function(x) format(abs(x), big.mark =".", scientific =FALSE)) +scale_fill_manual(values =c("MASCULINO"="cornflowerblue", "FEMININO"="indianred")) +labs(title ="Pirâmide Etária - 2000", x ="Faixa etária", y ="População", fill ="Sexo") +theme_minimal() +theme(axis.text.x =element_text(angle =45, hjust =1))```#### Ano 2005```{r}## Piramide referente ao ano de 2005df_long <- df_Juncao %>%mutate(ANO_2005=if_else(SEXO =="FEMININO", -ANO_2005, ANO_2005))faixa_etaria_ordem <-c("0 a 4", "5 a 9", "10 a 14", "15 a 19", "20 a 24", "25 a 29", "30 a 34", "35 a 39", "40 a 44","45 a 49","50 a 54","55 a 59","60 a 64","65 a 69","70 a 74","75 a 79","80 ou mais")df_long$FAIXA_ETARIA<-factor(df_long$FAIXA_ETARIA, levels = faixa_etaria_ordem)ggplot(df_long, aes(x = FAIXA_ETARIA, y = ANO_2005, fill = SEXO)) +geom_bar(stat ="identity") +coord_flip() +scale_y_continuous(labels =function(x) format(abs(x), big.mark =".", scientific =FALSE)) +scale_fill_manual(values =c("MASCULINO"="cornflowerblue", "FEMININO"="indianred")) +labs(title ="Pirâmide Etária - 2005", x ="Faixa etária", y ="População", fill ="Sexo") +theme_minimal() +theme(axis.text.x =element_text(angle =45, hjust =1))```#### Ano 2010```{r}## Piramide referente ao ano de 2010df_long <- df_Juncao %>%mutate(ANO_2010=if_else(SEXO =="FEMININO", -ANO_2010, ANO_2010))faixa_etaria_ordem <-c("0 a 4", "5 a 9", "10 a 14", "15 a 19", "20 a 24", "25 a 29", "30 a 34", "35 a 39", "40 a 44","45 a 49","50 a 54","55 a 59","60 a 64","65 a 69","70 a 74","75 a 79","80 ou mais")df_long$FAIXA_ETARIA<-factor(df_long$FAIXA_ETARIA, levels = faixa_etaria_ordem)ggplot(df_long, aes(x = FAIXA_ETARIA, y = ANO_2010, fill = SEXO)) +geom_bar(stat ="identity") +coord_flip() +scale_y_continuous(labels =function(x) format(abs(x), big.mark =".", scientific =FALSE)) +scale_fill_manual(values =c("MASCULINO"="cornflowerblue", "FEMININO"="indianred")) +labs(title ="Pirâmide Etária - 2010", x ="Faixa etária", y ="População", fill ="Sexo") +theme_minimal() +theme(axis.text.x =element_text(angle =45, hjust =1))```#Ano 2015```{r}## Piramide referente ao ano de 2015df_long <- df_Juncao %>%mutate(ANO_2015=if_else(SEXO =="FEMININO", -ANO_2015, ANO_2015))faixa_etaria_ordem <-c("0 a 4", "5 a 9", "10 a 14", "15 a 19", "20 a 24", "25 a 29", "30 a 34", "35 a 39", "40 a 44","45 a 49","50 a 54","55 a 59","60 a 64","65 a 69","70 a 74","75 a 79","80 ou mais")df_long$FAIXA_ETARIA<-factor(df_long$FAIXA_ETARIA, levels = faixa_etaria_ordem)ggplot(df_long, aes(x = FAIXA_ETARIA, y = ANO_2015, fill = SEXO)) +geom_bar(stat ="identity") +coord_flip() +scale_y_continuous(labels =function(x) format(abs(x), big.mark =".", scientific =FALSE)) +scale_fill_manual(values =c("MASCULINO"="cornflowerblue", "FEMININO"="indianred")) +labs(title ="Pirâmide Etária - 2015", x ="Faixa etária", y ="População", fill ="Sexo") +theme_minimal() +theme(axis.text.x =element_text(angle =45, hjust =1))```#### Ano 2020```{r}## Piramide referente ao ano de 2020df_long <- df_Juncao %>%mutate(ANO_2020=if_else(SEXO =="FEMININO", -ANO_2020, ANO_2020))faixa_etaria_ordem <-c("0 a 4", "5 a 9", "10 a 14", "15 a 19", "20 a 24", "25 a 29", "30 a 34", "35 a 39", "40 a 44","45 a 49","50 a 54","55 a 59","60 a 64","65 a 69","70 a 74","75 a 79","80 ou mais")df_long$FAIXA_ETARIA<-factor(df_long$FAIXA_ETARIA, levels = faixa_etaria_ordem)ggplot(df_long, aes(x = FAIXA_ETARIA, y = ANO_2020, fill = SEXO)) +geom_bar(stat ="identity") +coord_flip() +scale_y_continuous(labels =function(x) format(abs(x), big.mark =".", scientific =FALSE)) +scale_fill_manual(values =c("MASCULINO"="cornflowerblue", "FEMININO"="indianred")) +labs(title ="Pirâmide Etária - 2020", x ="Faixa etária", y ="População", fill ="Sexo") +theme_minimal() +theme(axis.text.x =element_text(angle =45, hjust =1))```### ExtrapolaçãoApresentaremos agora uma projeção simples, feita a partir da extrapolação matemática considerando um padrão de crescimento da população coreana.A fórmula para calcular a projeção simples da população é dada por:$$P_t = P_l + \frac{(\Delta t - l) \cdot (P_b - P_l)}{(\Delta l - b)}$$```{r}Projecao_Coreia<-read_xlsx("C://Users//Aman_//Downloads//População1.xlsx", sheet ="projec")names(Projecao_Coreia)<-c("Ano","Populacao_Total")Projecao_Coreia$Ano<-as.numeric(Projecao_Coreia$Ano)#motando função para projecao da populacaoprojetar_populacao_ate_2050 <-function(Projecao_Coreia) {# Definir o ano base e o ano inicial ano_inicial <-2000 ano_base <-2010 ano_fim <-2050# Obter as populações para os anos base e inicial populacao_base <- Projecao_Coreia$Populacao_Total[Projecao_Coreia$Ano == ano_base] populacao_inicial <- Projecao_Coreia$Populacao_Total[Projecao_Coreia$Ano == ano_inicial]# Intervalos delta_l <- ano_base - ano_inicial anos <-seq(from = ano_inicial, to = ano_fim, by =1)# Inicializar vetor para as populações projetadas populacoes_projetadas <-numeric(length(anos))for (ano in anos) {if (ano <= ano_base) { populacoes_projetadas[anos == ano] <- Projecao_Coreia$Populacao_Total[Projecao_Coreia$Ano == ano] } else { delta_t <- ano - ano_inicial populacoes_projetadas[anos == ano] <- populacao_inicial + (delta_t -0) * (populacao_base - populacao_inicial) / delta_l } }# Criar data frame com os anos e populações projetadas resultado <-data.frame(Ano = anos,Populacao_Projetada = populacoes_projetadas )return(resultado)}resultado_projecao <-projetar_populacao_ate_2050(Projecao_Coreia)print(resultado_projecao)Grafico<-ggplot() +geom_line(data = Projecao_Coreia, aes(x = Ano, y = Populacao_Total, color ="Dados Reais"), size =1) +geom_line(data = resultado_projecao, aes(x = Ano, y = Populacao_Projetada, color ="Projeção"), linetype ="dashed", size =1) +labs(title ="Evolução Populacional e Projeção até 2050",x ="Ano",y ="População Total",color ="Legenda") +theme_minimal() +scale_color_manual(values =c("Dados Reais"="blue", "Projeção"="red"))Grafico <- Grafico +scale_y_continuous(labels = scales::label_number(scale =1e-6, suffix ="M"),breaks =pretty(c(min(Projecao_Coreia$Populacao_Total), max(resultado_projecao$Populacao_Projetada)), n =3))Grafico```#### Interpretação:Nossa projeção teve como base ano de 2010 e a população inicial no ano de 2000 , podemos observar que a nossa projeção em boa parte até acompanha a reta com dados reais, mesmo desconsiderando taxas migratórias, taxa de natalidade e mortalidade.### Pirâmide Etária realidade - futuro (2050)```{r}library(ggplot2)library(readxl)library(dplyr)Pop2050<-read_xlsx("C://Users//Aman_//Downloads//pop2050.xlsx")Pop2050 <- Pop2050 %>%mutate(FaixaEtaria =case_when( idade %in%0:4~"0-4", idade %in%5:9~"5-9", idade %in%10:14~"10-14", idade %in%15:19~"15-19", idade %in%20:24~"20-24", idade %in%25:29~"25-29", idade %in%30:34~"30-34", idade %in%35:39~"35-39", idade %in%40:44~"40-44", idade %in%45:49~"45-49", idade %in%50:54~"50-54", idade %in%55:59~"55-59", idade %in%60:64~"60-64", idade %in%65:69~"65-69", idade %in%70:74~"70-74", idade %in%75:79~"75-79", idade =="80 +"~"80+" ))Pop_resumido <- Pop2050 %>%group_by(SEXO, FaixaEtaria) %>%summarise(Ano_2050 =sum(Ano_2050))Pop_resumido$FaixaEtaria <-factor(Pop_resumido$FaixaEtaria, levels =c("0-4", "5-9", "10-14", "15-19", "20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70-74", "75-79", "80+"))# Separando os dados por sexo e ajustando os valores dos homens para negativosdf_masc <- Pop_resumido %>%filter(SEXO =="Feminino") %>%mutate(Ano_2050 =-Ano_2050)df_fem <- Pop_resumido %>%filter(SEXO =="Masculino")df_comb <-bind_rows(df_masc, df_fem)# Criando a pirâmide etáriaggplot(df_comb, aes(x = FaixaEtaria, y = Ano_2050, fill = SEXO)) +geom_bar(stat ="identity", position ="identity") +coord_flip() +scale_y_continuous(labels =function(x) format(abs(x), big.mark =".", scientific =FALSE))+labs(title ="Pirâmide Etária em 2050",x ="Faixa Etária",y ="População",fill ="Sexo") +theme_minimal()```## ConclusãoA demografia da Coreia do Sul está passando por transformações significativas, moldadas pelas taxas de natalidade e fecundidade na Coreia do Sul que estão entre as mais baixas do mundo. Isso se deve a vários fatores, incluindo a crescente participação das mulheres no mercado de trabalho e mudanças nas atitudes sociais em relação ao casamento e à família. Esta tendência resulta em um declínio na população jovem, o que pode levar a uma força de trabalho encolhida e a desafios na sustentação do crescimento econômico a longo prazo.Por outro lado, a Coreia do Sul está experimentando um aumento significativo na qualidade de vida, refletido na expectativa de vida mais longa e, consequentemente, baixas taxas de mortalidade (com exceção da pandemia). Avanços na medicina, melhoria nas condições de vida e maior conscientização sobre saúde contribuíram para este aumento. A população idosa está crescendo rapidamente, o que coloca pressão sobre os sistemas de previdência social e de saúde, exigindo reformas para garantir sustentabilidade financeira.A combinação de uma população envelhecida e uma força de trabalho em declínio apresenta desafios únicos. Haverá uma maior necessidade de políticas que incentivem a imigração e a inclusão de mais mulheres e idosos no mercado de trabalho. Além disso, investimentos em tecnologia e automação serão cruciais para manter a produtividade econômica.
