# Este chunk carrega todas as bibliotecas e define as funções.
# include=FALSE garante que este código não apareça no relatório final.
# message=FALSE e warning=FALSE evitam mensagens de carregamento de pacotes.
library(fredr)
library(ggplot2)
library(tibble)
library(dplyr)
##
## Anexando pacote: 'dplyr'
## Os seguintes objetos são mascarados por 'package:stats':
##
## filter, lag
## Os seguintes objetos são mascarados por 'package:base':
##
## intersect, setdiff, setequal, union
library(xts)
## Carregando pacotes exigidos: zoo
##
## Anexando pacote: 'zoo'
## Os seguintes objetos são mascarados por 'package:base':
##
## as.Date, as.Date.numeric
##
## ######################### Warning from 'xts' package ##########################
## # #
## # The dplyr lag() function breaks how base R's lag() function is supposed to #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or #
## # source() into this session won't work correctly. #
## # #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop #
## # dplyr from breaking base R's lag() function. #
## # #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning. #
## # #
## ###############################################################################
##
## Anexando pacote: 'xts'
## Os seguintes objetos são mascarados por 'package:dplyr':
##
## first, last
library(quantmod)
## Carregando pacotes exigidos: TTR
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(tidyr)
library(lubridate)
##
## Anexando pacote: 'lubridate'
## Os seguintes objetos são mascarados por 'package:base':
##
## date, intersect, setdiff, union
library(purrr)
library(zoo)
library(glue)
# Configure sua chave FRED aqui
fredr_set_key("672d5598c8a41df9397cc5eb92c02d5e")
# Tema visual
theme_pandora <- function(base_size = 15, show_grid = FALSE) {
base <- theme_minimal(base_size = base_size) %+replace%
theme(
plot.title = element_text(face = "bold", hjust = 0),
plot.subtitle = element_text(hjust = 0),
plot.caption = element_text(size = 10, color = "gray50", hjust = 0),
legend.title = element_blank(),
legend.position = "bottom",
legend.direction = "horizontal"
)
if (!show_grid) {
base <- base + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank()
)
}
return(base)
}
# Função para obter PIB
get_pib <- function(start = "1960-01-01", end = "2025-12-31") {
fredr(series_id = "GDP",
observation_start = as.Date(start),
observation_end = as.Date(end)) %>%
select(date, PIB = value)
}
# Função segura para download
safe_fredr <- function(series_id, conta_nome) {
tryCatch({
df <- fredr(series_id = series_id, observation_start = as.Date("1960-01-01"))
if(nrow(df) > 0) {
df %>%
select(date, value) %>%
mutate(Conta = conta_nome)
} else {
tibble(date = as.Date(character()), value = numeric(), Conta = character())
}
}, error = function(e) {
warning(glue("Erro ao baixar série '{series_id}': {e$message}"))
tibble(date = as.Date(character()), value = numeric(), Conta = character())
})
}
# Função para Gráfico 2
get_current_account_components_qtr_sum <- function(start_date = "2000-01-01", end_date = Sys.Date()) {
tickers <- list(
"Primary Income" = "IEABCPI",
"Secondary Income" = "IEABCSI",
"Services" = "BOPSTB",
"Goods" = "BOPGTB"
)
get_data <- function(series_id, nome_componente) {
fredr(
series_id = series_id,
observation_start = as.Date(start_date),
observation_end = as.Date(end_date)
) %>%
select(date, value) %>%
mutate(component = nome_componente)
}
df_list <- imap(tickers, get_data)
quarterly_series <- bind_rows(df_list[c("Primary Income", "Secondary Income")])
monthly_series <- bind_rows(df_list[c("Services", "Goods")])
monthly_series_qtr <- monthly_series %>%
mutate(trimestre = floor_date(date, "quarter")) %>%
group_by(trimestre, component) %>%
summarise(value = sum(value, na.rm = TRUE), .groups = "drop") %>%
rename(date = trimestre)
quarterly_series_qtr <- quarterly_series
all_data_qtr <- bind_rows(quarterly_series_qtr, monthly_series_qtr) %>%
pivot_wider(names_from = component, values_from = value) %>%
mutate(CA = rowSums(across(c("Primary Income", "Secondary Income", "Services", "Goods")), na.rm = TRUE)) %>%
arrange(date)
return(all_data_qtr)
}
label_regiao <- "USA"
net_fac <- c("Net financial assets excluding financial derivatives" = "IEAA")
series <- c("Direct Investment" = "IEAADI",
"Portfolio Investment" = "IEAAPI",
"Reserve assets" = "IEAAR",
"Other Investment Assets" = "IEAAOI")
net_total_cf <- imap_dfr(net_fac, safe_fredr)
conta_financeira_net <- imap_dfr(series, safe_fredr)
if(nrow(net_total_cf) > 0 && nrow(conta_financeira_net) > 0) {
total_net_wide <- net_total_cf %>% pivot_wider(names_from = Conta, values_from = value)
cf_wide <- conta_financeira_net %>% pivot_wider(names_from = Conta, values_from = value)
conta_financeira_paleta <- c(
"Portfolio Investment" = "#166083",
"Direct Investment" = "#37A6D9",
"Reserve assets" = "#82C1DB",
"Other Investment Assets" = "#AFABAB"
)
cf_long <- cf_wide %>% pivot_longer(-date, names_to = "Conta", values_to = "value")
df_pib <- get_pib()
cf_long_pib <- cf_long %>%
left_join(df_pib, by = "date") %>%
arrange(Conta, date) %>%
group_by(Conta) %>%
mutate(
value_rolling = rollsum(value, k = 4, fill = NA, align = "right"),
PIB_rolling = rollsum(PIB, k = 4, fill = NA, align = "right"),
valor_per_pib = (value_rolling / PIB_rolling) / 10
) %>%
ungroup()
total_net_wide_pib <- total_net_wide %>%
left_join(df_pib, by = "date") %>%
arrange(date) %>%
mutate(
nfa_rolling = rollsum(`Net financial assets excluding financial derivatives`, k = 4, fill = NA, align = "right"),
PIB_rolling = rollsum(PIB, k = 4, fill = NA, align = "right"),
nfa_per_pib = (nfa_rolling / PIB_rolling) / 10
)
p1 <- ggplot(cf_long_pib, aes(x = date, y = valor_per_pib, fill = Conta)) +
geom_col(position = "stack", width = 60) +
geom_line(
data = total_net_wide_pib,
aes(x = date, y = nfa_per_pib),
size = 1, color = "black", inherit.aes = FALSE
) +
scale_fill_manual(values = conta_financeira_paleta) +
scale_x_date(
date_labels = "%Y",
breaks = "4 years",
expand = expansion(mult = c(0, 0.1))
) +
labs(
title = paste("Net Financial Account -", label_regiao),
subtitle = paste("% do PIB, 4Q - Última observação:", format(max(cf_long_pib$date, na.rm = TRUE), "%b %Y")),
y = NULL,
x = NULL,
caption = "Fonte: FRED/Impactus UFRJ"
) +
theme_minimal(base_family = "Montserrat") +
theme_pandora()
print(p1)
}
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: Removed 12 rows containing missing values or values outside the scale range
## (`geom_col()`).
## Warning: Removed 3 rows containing missing values or values outside the scale range
## (`geom_line()`).
label_regiao <- 'USA'
df <- get_current_account_components_qtr_sum("2000-01-01", "2025-12-31")
df_pib <- get_pib()
if(nrow(df) > 0) {
df_componentes <- df %>% select(date, 'Primary Income', 'Secondary Income', Services, Goods)
df_ca <- df %>% select(date, CA)
df_componentes_pib <- df_componentes %>%
left_join(df_pib, by = "date") %>%
mutate(across(c("Primary Income", "Secondary Income", "Services", "Goods"), ~ (.x / (PIB * 1000)) * 100))
df_ca_pib <- df_ca %>%
left_join(df_pib, by = "date") %>%
mutate(CA_pct = (CA / (PIB * 1000)) * 100)
df_componentes_rolling <- df_componentes_pib %>%
arrange(date) %>%
mutate(across(c("Primary Income", "Secondary Income", "Services", "Goods"), ~ rollsum(.x, k = 4, fill = NA, align = "right"), .names = "{.col}_rolling"))
df_ca_rolling <- df_ca_pib %>%
arrange(date) %>%
mutate(CA_pct_rolling = rollsum(CA_pct, k = 4, fill = NA, align = "right"))
df_longo <- df_componentes_rolling %>%
pivot_longer(cols = ends_with("_rolling"), names_to = "Componente", values_to = "Valor") %>%
mutate(Componente = gsub("_rolling", "", Componente)) %>%
filter(!is.na(Valor))
cores_ca <- c("Primary Income" = "#82C1DB", "Secondary Income" = "#0082C1", "Services" = "#166083", "Goods" = "#AFABAB")
p2 <- ggplot(df_longo, aes(x = date, y = Valor, fill = Componente)) +
geom_col(width = 60, position = "stack") +
scale_fill_manual(values = cores_ca) +
geom_line(
data = df_ca_rolling,
aes(x = date, y = CA_pct_rolling),
color = "#082631",
size = 1.2,
inherit.aes = FALSE
) +
scale_x_date(
date_labels = "%Y",
breaks = "4 years",
expand = expansion(mult = c(0, 0.1))
) +
labs(
title = paste("Balance on current account -", label_regiao),
subtitle = paste("% do PIB, 4Q - Última observação:", format(max(df_longo$date), "%b %Y")),
y = NULL,
x = NULL,
caption = "Fonte: FRED/Impactus UFRJ"
) +
theme_minimal(base_family = "Montserrat") +
theme_pandora()
print(p2)
}
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_line()`).
series_liquidas <- c("Net IIP" = "IIPUSNETIQ")
ativos <- c("Portfolio Investment" = "IIPPORTAQ", "Direct Investment" = "IIPDIREAMVQ", "Other Investment" = "IIPOTHEAQ", "Reserve Assets" = "IIPRESEQ", "Derivatives" = "IIPFINAAGQ")
passivos <- c("Portfolio Investment" = "IIPPORTLQ", "Direct Investment" = "IIPDIRELMVQ", "Other Investment" = "IIPOTHELQ", "Derivatives" = "IIPFINALGQ")
ativos_df <- imap_dfr(ativos, safe_fredr)
passivos_df <- imap_dfr(passivos, safe_fredr)
liquidas_df <- imap_dfr(series_liquidas, safe_fredr)
if(nrow(ativos_df) > 0 && nrow(passivos_df) > 0) {
df_completo <- full_join(
ativos_df %>% rename(value_ativo = value),
passivos_df %>% rename(value_passivo = value),
by = c("date", "Conta")
) %>%
mutate(
value_ativo = replace_na(value_ativo, 0),
value_passivo = replace_na(value_passivo, 0),
value_liquido = value_ativo - value_passivo
) %>%
select(date, Conta, value_liquido)
df_pib <- get_pib()
df_liquido_pct <- df_completo %>%
left_join(df_pib, by = "date") %>%
group_by(Conta) %>%
arrange(date) %>%
mutate(valor_per_pib = (value_liquido / (PIB * 1000)) * 100) %>%
ungroup()
df_iip_net <- liquidas_df %>%
filter(Conta == "Net IIP") %>%
left_join(df_pib, by = "date") %>%
arrange(date) %>%
mutate(net_iip_per_pib = (value / (PIB * 1000)) * 100)
iip_paleta <- c("Portfolio Investment" = "#166083", "Direct Investment" = "#37A6D9", "Other Investment" = "#AFABAB", "Reserve Assets" = "#82C1DB", "Derivatives" = "#082631")
p3 <- ggplot(df_liquido_pct, aes(x = date, y = valor_per_pib, fill = Conta)) +
geom_col(position = "stack", width = 60) +
geom_line(
data = df_iip_net,
aes(x = date, y = net_iip_per_pib),
size = 1.2, color = "black", inherit.aes = FALSE
) +
scale_fill_manual(values = iip_paleta) +
scale_x_date(
date_labels = "%Y",
breaks = "4 years",
expand = expansion(mult = c(0, 0.1))
) +
labs(
title = "Net International Investment Position - USA",
subtitle = paste("% do PIB, 4Q - Última observação:", format(max(df_liquido_pct$date, na.rm = TRUE), "%b %Y")),
y = NULL,
x = NULL,
caption = "Fonte: FRED/Impactus UFRJ"
) +
theme_minimal(base_family = "Montserrat") +
theme_pandora()
print(p3)
}
componentes <- c("Foods, feeds, and beverages" = "GF", "Industrial supplies and materials" = "GI", "Capital goods except automotive" = "GC", "Automotive vehicles, parts, and engines" = "GAV", "Consumer goods except food and automotive" = "GCG", "Other general merchandise" = "GO")
series_export <- paste0("IEAX", componentes)
series_import <- paste0("IEAM", componentes)
names(series_export) <- names(componentes)
names(series_import) <- names(componentes)
export_df <- imap_dfr(series_export, safe_fredr)
import_df <- imap_dfr(series_import, safe_fredr)
if(nrow(export_df) > 0 && nrow(import_df) > 0) {
df_liquido <- full_join(
export_df %>% rename(value_exp = value),
import_df %>% rename(value_imp = value),
by = c("date", "Conta")
) %>%
mutate(
value_exp = replace_na(value_exp, 0),
value_imp = replace_na(value_imp, 0),
value_liquido = value_exp - value_imp
) %>%
select(date, Conta, value_liquido)
df_pib <- get_pib()
df_liquido_pct <- df_liquido %>%
left_join(df_pib, by = "date") %>%
group_by(Conta) %>%
arrange(date) %>%
mutate(
value_rolling = rollsum(value_liquido, k = 4, fill = NA, align = "right"),
PIB_rolling = rollsum(PIB, k = 4, fill = NA, align = "right"),
valor_per_pib = (value_rolling / PIB_rolling) / 10
) %>%
ungroup()
df_total <- df_liquido %>%
group_by(date) %>%
summarise(value = sum(value_liquido, na.rm = TRUE)) %>%
left_join(df_pib, by = "date") %>%
arrange(date) %>%
mutate(
value_rolling = rollsum(value, k = 4, fill = NA, align = "right"),
PIB_rolling = rollsum(PIB, k = 4, fill = NA, align = "right"),
total_per_pib = (value_rolling / PIB_rolling) / 10
)
comercio_paleta <- c("Foods, feeds, and beverages" = "#082631", "Industrial supplies and materials" = "#166083", "Capital goods except automotive" = "#37A6D9", "Automotive vehicles, parts, and engines" = "#AFABAB", "Consumer goods except food and automotive" = "#82C1DB", "Other general merchandise" = "#5D8AA8")
p4 <- ggplot(df_liquido_pct, aes(x = date, y = valor_per_pib, fill = Conta)) +
geom_col(position = "stack", width = 60) +
geom_line(
data = df_total,
aes(x = date, y = total_per_pib),
size = 1.2, color = "black", inherit.aes = FALSE
) +
scale_fill_manual(values = comercio_paleta) +
scale_x_date(
date_labels = "%Y",
breaks = "4 years",
expand = expansion(mult = c(0, 0.1))
) +
labs(
title = "Net Exports of Goods - USA",
subtitle = paste("% do PIB, 4Q - Última observação:", format(max(df_liquido_pct$date, na.rm = TRUE), "%b %Y")),
y = NULL,
x = NULL,
caption = "Fonte: FRED/Impactus UFRJ"
) +
theme_minimal(base_family = "Montserrat") +
theme_pandora()
print(p4)
}
## Warning: Removed 18 rows containing missing values or values outside the scale range
## (`geom_col()`).
## Warning: Removed 3 rows containing missing values or values outside the scale range
## (`geom_line()`).
