devolutivas
FOCUS
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.1 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.2 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(readxl)
library(rbcb)
library(ggrepel)
library(RColorBrewer)
# series = list('DBGG' = 13762,
# 'DLSP' = 4513,
# 'NFSP Primário' = 5793,
# 'NFSP Nominal' = 5727)
#
# data_variaveis = get_series(series, start_date = '2019-01-01') %>%
# purrr::reduce(inner_join) %>%
# gather(variavel, valor, -date)
## Coleta de dados de expectativas
market_expec = get_annual_market_expectations(c('PIB Total', "PIB Agropecuária", "PIB Indústria", "PIB Serviços", 'IPCA', 'Dívida bruta do governo geral', 'Câmbio', 'Conta corrente', 'Selic'), start_date= '2022-01-01', end_date = '2024-01-01')
# data_variaveis %>% ggplot(aes(x=date,y=valor, color=variavel))+geom_line()+geom_point()
# Cores <- brewer.pal(6, "YlOrRd")
m<-nullfile()
j=0
for (i in c('PIB Total',"PIB Agropecuária", "PIB Indústria", "PIB Serviços", 'IPCA', 'Dívida bruta do governo geral', 'Câmbio', 'Conta corrente', 'Selic')){
j=j+1
m<-market_expec %>%
# Filtra as previsões para 2021 a partir do mesmo período já percorrido em 2020
filter(date > '2022-01-01',indic == i, reference_date >=2022) %>%
ggplot(aes(x = date, y = mean)) +
geom_line(aes(color = reference_date), size = 0.7) + geom_point(aes(color = reference_date), size = 0.7)+
facet_wrap(~ reference_date, nrow = 2, scales = 'free') +
labs(title = paste0('Expectativa de mercado para ', i),
x = 'Tempo',
y = 'Média',
caption = 'Fonte: Boletim FOCUS - Banco Central e @profeconomia')
# +
# scale_color_discrete(name = "Índices: ") +
# theme(legend.position="bottom", panel.background = element_rect(colour=Cores[j], fill= Cores[j]))
plot(m)
}## 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.
m1<-nullfile()
m2<-nullfile()
j=0
options(ggrepel.max.overlaps = Inf)
for (i in c('PIB Total',"PIB Agropecuária", "PIB Indústria", "PIB Serviços", 'IPCA', 'Dívida bruta do governo geral', 'Câmbio', 'Conta corrente', 'Selic'))
{
j=j+1
m1<-market_expec %>%
# Filtra as previsões para 2021 a partir do mesmo período já percorrido em 2020
filter(date == "2023-02-10" | date=="2022-01-05",indic == i, reference_date >=2022,base==0)
m2<-market_expec %>%
# Filtra as previsões para 2021 a partir do mesmo período já percorrido em 2020
filter(date > '2022-01-01',indic == i, reference_date >=2022) %>% ggplot(aes(x = date, y = mean, colour = reference_date)) +
geom_line(size = 0.7, show.legend = FALSE) + geom_point(size = 0.7,show.legend = FALSE)+
labs(title = paste0('Expectativa de mercado para ', i),
x = 'Data da Previsão',
y = 'Média',
caption = 'Fonte: Boletim FOCUS - Banco Central e @profeconomia') +
geom_label_repel(data=m1, aes(label = reference_date), nudge_x = 1, na.rm = TRUE) +
theme(panel.background = element_rect(fill='white'), legend.position = "none")
# scale_color_discrete(name = "Índices: ") +
# theme(legend.position="bottom", panel.background = element_rect(colour=Cores[j], fill= Cores[j]))
plot(m2)
} 
PIB e Setores
library(tidyverse)
library(readxl)
library(rbcb)
library(ggrepel)
library(RColorBrewer)
market_expec = get_annual_market_expectations(c('PIB Total', "PIB Agropecuária", "PIB Indústria", "PIB Serviços"), start_date= '2022-01-01', end_date = '2024-01-01')
glimpse(market_expec)## Rows: 19,016
## Columns: 11
## $ indic <chr> "PIB Agropecuária", "PIB Agropecuária", "PIB Agropecuár…
## $ indic_detail <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,…
## $ date <date> 2022-01-03, 2022-01-03, 2022-01-03, 2022-01-03, 2022-0…
## $ reference_date <chr> "2021", "2022", "2023", "2024", "2025", "2021", "2022",…
## $ mean <dbl> 0.4975, 2.9899, 2.1782, 2.8241, 2.7692, 0.5388, 2.9571,…
## $ median <dbl> 0.1381, 2.5000, 2.3000, 2.9000, 2.6997, 0.3414, 3.0000,…
## $ sd <dbl> 1.7518, 1.6430, 1.2950, 0.4755, 0.4794, 1.5903, 1.3751,…
## $ min <dbl> -2.4, 0.0, -2.0, 2.0, 2.0, -2.2, 0.9, 2.0, 2.7, 2.5, -2…
## $ max <dbl> 4.10, 6.90, 4.20, 3.50, 3.50, 3.10, 5.00, 2.90, 3.50, 3…
## $ respondents <int> 24, 21, 15, 13, 13, 8, 7, 3, 2, 2, 25, 22, 15, 13, 13, …
## $ base <int> 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1…#install.packages("reshape2")
library(reshape2)##
## Attaching package: 'reshape2'## The following object is masked from 'package:tidyr':
##
## smithsfor (i in c("2022", "2023", "2024", "2025", "2026")) {
dados <- market_expec %>% filter(reference_date==i) %>% select(indic, date, mean) %>% pivot_wider(names_from = indic,
values_from = mean, values_fn = mean)
#glimpse(dados)
colnames(dados)<-c("date", "agro", "ind", "serv", "total")
y_mdl_fit <- lm("total ~ agro + ind + serv", data = dados)
print(round(coef(summary(y_mdl_fit)), 5))
print(summary(y_mdl_fit))
L <- matrix(c(0, 1, 1, 1), nrow = 1, byrow = TRUE)
rr <- c(1)
car::linearHypothesis(y_mdl_fit, hypothesis.matrix = L, rhs = rr)
md<-lrmest::rls(formula = formula(y_mdl_fit), R = L, r = rr, data = dados, delt = rep(0, length(rr)))
print("#############")
print(paste("pib por setores ano ", i))
print(md[[1]])
print("#############")
}## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.27894 0.04886 -5.70861 0
## agro 0.07346 0.01359 5.40539 0
## ind 0.16473 0.02530 6.51163 0
## serv 0.80561 0.01748 46.09252 0
##
## Call:
## lm(formula = "total ~ agro + ind + serv", data = dados)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.26218 -0.05148 -0.01098 0.04029 0.45637
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.27894 0.04886 -5.709 2.83e-08 ***
## agro 0.07346 0.01359 5.405 1.36e-07 ***
## ind 0.16473 0.02530 6.512 3.30e-10 ***
## serv 0.80561 0.01748 46.093 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.08381 on 288 degrees of freedom
## Multiple R-squared: 0.9937, Adjusted R-squared: 0.9936
## F-statistic: 1.518e+04 on 3 and 288 DF, p-value: < 2.2e-16## Warning in model.matrix.default(md, cal, contrasts): non-list contrasts
## argument ignored## [1] "#############"
## [1] "pib por setores ano 2022"
## Estimate Standard_error t_statistic pvalue
## (Intercept) -0.2319 0.0338 30.4487 0
## agro 0.0561 0.0039 NA NA
## ind 0.1444 0.0202 NA NA
## serv 0.7996 0.0169 NA NA
## [1] "#############"
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.11034 0.02448 4.50662 0.00001
## agro 0.12941 0.00376 34.41381 0.00000
## ind 0.66395 0.03070 21.62971 0.00000
## serv 0.06396 0.04932 1.29693 0.19529
##
## Call:
## lm(formula = "total ~ agro + ind + serv", data = dados)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.44527 -0.07888 -0.00114 0.07183 0.52629
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.11034 0.02448 4.507 8.32e-06 ***
## agro 0.12941 0.00376 34.414 < 2e-16 ***
## ind 0.66395 0.03070 21.630 < 2e-16 ***
## serv 0.06396 0.04932 1.297 0.195
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1379 on 472 degrees of freedom
## Multiple R-squared: 0.9703, Adjusted R-squared: 0.9701
## F-statistic: 5144 on 3 and 472 DF, p-value: < 2.2e-16## Warning in model.matrix.default(md, cal, contrasts): non-list contrasts
## argument ignored## [1] "#############"
## [1] "pib por setores ano 2023"
## Estimate Standard_error t_statistic pvalue
## (Intercept) -0.0281 0.0140 48.2856 0
## agro 0.1085 0.0022 NA NA
## ind 0.5406 0.0249 NA NA
## serv 0.3509 0.0264 NA NA
## [1] "#############"
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.46044 0.05084 9.05697 0e+00
## agro 0.14972 0.01439 10.40168 0e+00
## ind 0.36629 0.02468 14.84087 0e+00
## serv 0.17070 0.04248 4.01870 7e-05
##
## Call:
## lm(formula = "total ~ agro + ind + serv", data = dados)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.25957 -0.08700 -0.01750 0.06431 0.52689
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.46044 0.05084 9.057 < 2e-16 ***
## agro 0.14972 0.01439 10.402 < 2e-16 ***
## ind 0.36629 0.02468 14.841 < 2e-16 ***
## serv 0.17070 0.04248 4.019 6.81e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1333 on 472 degrees of freedom
## Multiple R-squared: 0.7616, Adjusted R-squared: 0.7601
## F-statistic: 502.7 on 3 and 472 DF, p-value: < 2.2e-16## Warning in model.matrix.default(md, cal, contrasts): non-list contrasts
## argument ignored## [1] "#############"
## [1] "pib por setores ano 2024"
## Estimate Standard_error t_statistic pvalue
## (Intercept) -0.0939 0.0129 35.9893 0
## agro 0.1932 0.0139 NA NA
## ind 0.2431 0.0221 NA NA
## serv 0.5638 0.0243 NA NA
## [1] "#############"
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.67472 0.05156 32.48346 0
## agro -0.11288 0.01531 -7.37356 0
## ind 0.08740 0.01316 6.64337 0
## serv 0.20387 0.01926 10.58756 0
##
## Call:
## lm(formula = "total ~ agro + ind + serv", data = dados)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.177107 -0.040066 -0.003208 0.041175 0.208985
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.67472 0.05156 32.483 < 2e-16 ***
## agro -0.11288 0.01531 -7.374 7.51e-13 ***
## ind 0.08740 0.01316 6.643 8.47e-11 ***
## serv 0.20387 0.01926 10.588 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.06862 on 472 degrees of freedom
## Multiple R-squared: 0.4951, Adjusted R-squared: 0.4919
## F-statistic: 154.3 on 3 and 472 DF, p-value: < 2.2e-16## Warning in model.matrix.default(md, cal, contrasts): non-list contrasts
## argument ignored## [1] "#############"
## [1] "pib por setores ano 2025"
## Estimate Standard_error t_statistic pvalue
## (Intercept) -0.2291 0.0109 45.9803 0
## agro 0.3049 0.0106 NA NA
## ind 0.1041 0.0131 NA NA
## serv 0.5910 0.0163 NA NA
## [1] "#############"
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.63446 0.06837 23.90740 0
## agro -0.10353 0.01706 -6.06749 0
## ind 0.13488 0.01399 9.63938 0
## serv 0.17339 0.02413 7.18556 0
##
## Call:
## lm(formula = "total ~ agro + ind + serv", data = dados)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.191886 -0.036349 -0.002052 0.035978 0.177388
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.63446 0.06837 23.907 < 2e-16 ***
## agro -0.10353 0.01706 -6.067 2.85e-09 ***
## ind 0.13488 0.01399 9.639 < 2e-16 ***
## serv 0.17339 0.02413 7.186 2.98e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.06264 on 430 degrees of freedom
## Multiple R-squared: 0.3386, Adjusted R-squared: 0.334
## F-statistic: 73.38 on 3 and 430 DF, p-value: < 2.2e-16## Warning in model.matrix.default(md, cal, contrasts): non-list contrasts
## argument ignored## [1] "#############"
## [1] "pib por setores ano 2026"
## Estimate Standard_error t_statistic pvalue
## (Intercept) -0.1424 0.0131 33.2963 0
## agro 0.1320 0.0146 NA NA
## ind 0.2925 0.0127 NA NA
## serv 0.5755 0.0188 NA NA
## [1] "#############"Câmbio e Juros
#install.packages("fredr")
library(fredr)
library(tidyr)
#API 31f5f11fcf91db07cf1dbf8155fb139b
fredr_set_key("31f5f11fcf91db07cf1dbf8155fb139b")
dese<-fredr(
series_id = "UNRATE",
observation_start = as.Date("1980-01-01"),
observation_end = Sys.Date() )
jur_eua<-fredr(
series_id = "DFF",
observation_start = as.Date("1960-01-01"),
observation_end = Sys.Date() )
library(ggplot2)
library(tidyverse)
library(ggthemes)
library(ipeadatar)
#devtools::install_github("gomesleduardo/ipeadatar")
#series<-ipeadatar::search_series(terms = 'Selic', fields = c('name'))
#selic <- ipeadatar::ipeadata("GM366_TJOVER366") %>% filter(date>=as.Date("1995-01-01"))
my.id <- c('Taxa de juros - Selic' = 11)
#install.packages("GetBCBData")
library(GetBCBData)
selic <- gbcbd_get_series(my.id, cache.path = tempdir())##
## Fetching Taxa de juros - Selic [11] from BCB-SGS with cache
## Found 2507 observationsselic %>% rename(date = ref.date, selic=value) %>% mutate(selic=(1+selic/100)^252 -1)->selic
dados<-left_join(selic, jur_eua, by="date") %>% mutate(selic=selic,fed=value)
# series<-ipeadatar::search_series(terms = 'câmbio', fields = c('name'))
# dólar<- ipeadata("GM366_ERC366") %>%filter(date>=as.Date("1995-01-01"))
setwd("G:/Meu Drive/aplicações no r")
dolar <- gbcbd_get_series(c("Dólar"=1), cache.path=tempdir()) %>% rename(date=ref.date)##
## Fetching Dólar [1] from BCB-SGS with cache
## Found 2506 observationsdados<-left_join(dados, dolar, by="date") %>% mutate(dolar=value.y)
# install.packages("gghighlight")
library(gghighlight)
library(RColorBrewer)
dados %>%filter(date >=as.Date("1995-01-01")) %>%
ggplot(aes(x=date, y=selic*100))+
geom_line(size=.8, aes(colour='SELIC'))+
geom_line(aes(y=fed, colour='FED'),size=.8)+
geom_line(aes(y=dolar,colour='Dólar'),size=.8)+
xlab('')+ylab('')+scale_y_continuous(labels = function(x) paste0(x, "%"))+
labs(title='Juros e Câmbio',
subtitle='1995 a 2023',
caption='FED, BACEN e @profeconomia',
colour = "name1",
shape = "name2")+
geom_vline(xintercept =c( as.Date('2015-08-31')), linetype="dashed", color = "red") +geom_vline(xintercept =c( as.Date('2019-01-31')), linetype="dashed", color = "red") +
theme(panel.background = element_rect(fill='white'))+scale_color_manual(name = "",
values = c("SELIC" = "darkred", "FED" = "darkgreen",
"Dólar" = "darkblue"))## Warning: Removed 1 row containing missing values (`geom_line()`).
## Removed 1 row containing missing values (`geom_line()`).
Cores <- brewer.pal(8, "YlOrRd")
Cores2 <- brewer.pal(8, "YlGn")
# install.packages("highcharter")
library(highcharter)## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoodados %>% filter(date >=as.Date("2011-01-01"))%>%
hchart(hcaes(y=(selic*100), x=date), color = "darkred", name = "Selic", type="spline" ) %>%
hc_add_series(dados %>% filter(date >=as.Date("2011-01-01")),mapping=hcaes(y=fed, x=date), color = "darkblue", name = "FED", type="spline") %>%hc_add_series(dados %>% filter(date >=as.Date("2011-01-01")),mapping=hcaes(y=dolar, x=date), color = "darkgreen", name = "Dolar", type="spline") %>%
hc_title(text = "Câmbio e Juros", margin = 10,
style = list(fontSize= "14px")) %>%
hc_subtitle(text = "Dados Diários") %>%
hc_credits(enabled = TRUE,text = "@profeconomia") %>%
hc_xAxis(title=list(text=""),plotBands = list(
list(
label = list(text = ""),
color = Cores2[1],
from = datetime_to_timestamp(as.Date('2011-01-01', tz = 'UTC')),
to = datetime_to_timestamp(as.Date('2014-12-31', tz = 'UTC'))),
list(
label = list(text = ""),
color = Cores2[2],
from = datetime_to_timestamp(as.Date('2015-01-01', tz = 'UTC')),
to = datetime_to_timestamp(as.Date('2016-08-31', tz = 'UTC'))),
list(
label = list(text = ""),
color = Cores2[3],
from = datetime_to_timestamp(as.Date('2016-01-01', tz = 'UTC')),
to = datetime_to_timestamp(as.Date('2018-12-31', tz = 'UTC'))),
list(
label = list(text = ""),
color = Cores2[4],
from = datetime_to_timestamp(as.Date('2019-01-01', tz = 'UTC')),
to = datetime_to_timestamp(as.Date('2022-12-31', tz = 'UTC'))),
list(
label = list(text = ""),
color = Cores2[5],
from = datetime_to_timestamp(as.Date('2023-01-01', tz = 'UTC')),
to = datetime_to_timestamp(as.Date(Sys.Date(), tz = 'UTC')))
)) %>% hc_yAxis( title=list(text=""))Câmbio e Bolsa
#install.packages("fredr")
library(fredr)
library(tidyr)
library(quantmod)## Carregando pacotes exigidos: xts## Carregando pacotes exigidos: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric##
## ################################### WARNING ###################################
## # We noticed you have dplyr installed. 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 enter or source() into this session won't #
## # work correctly. #
## # #
## # All package code is unaffected because it is protected by the R namespace #
## # mechanism. #
## # #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning. #
## # #
## # You can 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. #
## ################################### WARNING #####################################
## Attaching package: 'xts'## The following objects are masked from 'package:dplyr':
##
## first, last## Carregando pacotes exigidos: TTRibov<-getSymbols("^BVSP", auto.assign = FALSE)## Warning: ^BVSP contains missing values. Some functions will not work if objects
## contain missing values in the middle of the series. Consider using na.omit(),
## na.approx(), na.fill(), etc to remove or replace them.#API 31f5f11fcf91db07cf1dbf8155fb139b
fredr_set_key("31f5f11fcf91db07cf1dbf8155fb139b")
dese<-fredr(
series_id = "UNRATE",
observation_start = as.Date("1980-01-01"),
observation_end = Sys.Date() )
jur_eua<-fredr(
series_id = "DFF",
observation_start = as.Date("1960-01-01"),
observation_end = Sys.Date() )
library(ggplot2)
library(tidyverse)
library(ggthemes)
library(ipeadatar)
#devtools::install_github("gomesleduardo/ipeadatar")
#series<-ipeadatar::search_series(terms = 'Selic', fields = c('name'))
#selic <- ipeadatar::ipeadata("GM366_TJOVER366") %>% filter(date>=as.Date("1995-01-01"))
my.id <- c('Taxa de juros - Selic' = 11)
#install.packages("GetBCBData")
library(GetBCBData)
selic <- gbcbd_get_series(my.id, cache.path = tempdir())##
## Fetching Taxa de juros - Selic [11] from BCB-SGS## with cache
## Found 2507 observationsselic %>% rename(date = ref.date, selic=value) %>% mutate(selic=(1+selic/100)^252 -1)->selic
dados<-left_join(selic, jur_eua, by="date") %>% mutate(selic=selic,fed=value)
# series<-ipeadatar::search_series(terms = 'câmbio', fields = c('name'))
# dólar<- ipeadata("GM366_ERC366") %>%filter(date>=as.Date("1995-01-01"))
setwd("G:/Meu Drive/aplicações no r")
dolar <- gbcbd_get_series(c("Dólar"=1), cache.path=tempdir()) %>% rename(date=ref.date)##
## Fetching Dólar [1] from BCB-SGS with cache
## Found 2506 observationsdados<-left_join(dados, dolar, by="date") %>% mutate(dolar=value.y)
ibov<-as.data.frame(ibov)
ibov$date<-as.Date(rownames(ibov))
ibov_02<-ibov %>% select(date, ibov=BVSP.Close)
dados<-left_join(dados, ibov_02, by="date")
# install.packages("gghighlight")
library(gghighlight)
library(RColorBrewer)
coef<-10000
dados %>%filter(date >=as.Date("1995-01-01")) %>%
ggplot(aes(x=date, y=selic*100))+
geom_line(size=.8, aes(colour='SELIC'))+
geom_line(aes(y=fed, colour='FED'),size=.8)+
geom_line(aes(y=dolar,colour='Dólar'),size=.8)+
geom_line(aes(y=ibov/coef,colour='Bovespa'),size=.8)+
xlab('')+ylab('')+scale_y_continuous(labels = function(x) paste0(x, "%"), sec.axis = dup_axis(breaks = dados$ibov[length(dados$ibov)]/coef,labels="IBOV", name=NULL))+
labs(title='Juros e Câmbio',
subtitle='1995 a 2023',
caption='FED, BACEN e @profeconomia',
colour = "name1",
shape = "name2")+
geom_vline(xintercept =c( as.Date('2015-08-31')), linetype="dashed", color = "red") +geom_vline(xintercept =c( as.Date('2019-01-31')), linetype="dashed", color = "red") +
theme(panel.background = element_rect(fill='white'))+scale_color_manual(name = "",
values = c("SELIC" = "darkred", "FED" = "darkgreen",
"Dólar" = "darkblue",
"Bovespa"="darkgray"))## Warning in min(x): nenhum argumento não faltante para min; retornando Inf## Warning in max(x): nenhum argumento não faltante para max; retornando -Inf## Warning: Removed 1 row containing missing values (`geom_line()`).
## Removed 1 row containing missing values (`geom_line()`).
## Removed 1 row containing missing values (`geom_line()`).
Cores <- brewer.pal(8, "YlOrRd")
Cores2 <- brewer.pal(8, "YlGn")
# install.packages("highcharter")
library(highcharter)
dados %>% filter(date >=as.Date("2011-01-01"))%>%
hchart(hcaes(y=(selic*100), x=date), color = "darkred", name = "Selic", type="spline" ) %>%
hc_add_series(dados %>% filter(date >=as.Date("2011-01-01")),mapping=hcaes(y=fed, x=date), color = "darkblue", name = "FED", type="spline") %>%hc_add_series(dados %>% filter(date >=as.Date("2011-01-01")),mapping=hcaes(y=dolar, x=date), color = "darkgreen", name = "Dolar", type="spline") %>%
hc_title(text = "Câmbio e Juros", margin = 10,
style = list(fontSize= "14px")) %>%
hc_subtitle(text = "Dados Diários") %>%
hc_credits(enabled = TRUE,text = "@profeconomia") %>%
hc_xAxis(title=list(text=""),plotBands = list(
list(
label = list(text = ""),
color = Cores2[1],
from = datetime_to_timestamp(as.Date('2011-01-01', tz = 'UTC')),
to = datetime_to_timestamp(as.Date('2014-12-31', tz = 'UTC'))),
list(
label = list(text = ""),
color = Cores2[2],
from = datetime_to_timestamp(as.Date('2015-01-01', tz = 'UTC')),
to = datetime_to_timestamp(as.Date('2016-08-31', tz = 'UTC'))),
list(
label = list(text = ""),
color = Cores2[3],
from = datetime_to_timestamp(as.Date('2016-01-01', tz = 'UTC')),
to = datetime_to_timestamp(as.Date('2018-12-31', tz = 'UTC'))),
list(
label = list(text = ""),
color = Cores2[4],
from = datetime_to_timestamp(as.Date('2019-01-01', tz = 'UTC')),
to = datetime_to_timestamp(as.Date('2022-12-31', tz = 'UTC'))),
list(
label = list(text = ""),
color = Cores2[5],
from = datetime_to_timestamp(as.Date('2023-01-01', tz = 'UTC')),
to = datetime_to_timestamp(as.Date(Sys.Date(), tz = 'UTC')))
)) %>% hc_yAxis( title=list(text=""))Tesouro direto
library(tidyverse)
library(tidyquant)## Carregando pacotes exigidos: PerformanceAnalytics##
## Attaching package: 'PerformanceAnalytics'## The following object is masked from 'package:graphics':
##
## legendlibrary(timetk)
library(scales)##
## Attaching package: 'scales'## The following object is masked from 'package:purrr':
##
## discard## The following object is masked from 'package:readr':
##
## col_factorlibrary(quantmod)
library(GetTDData)
library(ipeadatar)
library(RColorBrewer)
library(ggrepel)
#install.packages("ecoseries")
setwd("G:/Meu Drive/aplicações no r")
download.TD.data('NTN-B',dl.folder='G:/Meu Drive/aplicações no r/TD Files')##
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2005.xls (1-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2006.xls (2-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2007.xls (3-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2008.xls (4-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2009.xls (5-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2010.xls (6-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2011.xls (7-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2012.xls (8-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2013.xls (9-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2014.xls (10-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2015.xls (11-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2016.xls (12-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2017.xls (13-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2018.xls (14-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2019.xls (15-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2020.xls (16-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2021.xls (17-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2022.xls (18-19) Found file in folder, skipping it.
## Downloading file G:/Meu Drive/aplicações no r/TD Files/NTN-B_2023.xls (19-19) Downloading...## [1] TRUEntnb <- read.TD.files(dl.folder = 'G:/Meu Drive/aplicações no r/TD Files')##
## Reading xls data and saving to data.frame
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2005.xls
## Reading Sheet NTN-B 150806
## Reading Sheet NTN-B 150507
## Reading Sheet NTN-B 150808
## Reading Sheet NTN-B 150509
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150545
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2006.xls
## Reading Sheet NTN-B 150806
## Reading Sheet NTN-B 150507
## Reading Sheet NTN-B 150808
## Reading Sheet NTN-B 150509
## Reading Sheet NTN-B 150810
## Reading Sheet NTN-B 150511
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2007.xls
## Reading Sheet NTN-B 150507
## Reading Sheet NTN-B 150808
## Reading Sheet NTN-B 150509
## Reading Sheet NTN-B 150810
## Reading Sheet NTN-B 150511
## Reading Sheet NTN-B 150812
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2008.xls
## Reading Sheet NTN-B 150808
## Reading Sheet NTN-B 150509
## Reading Sheet NTN-B 150810
## Reading Sheet NTN-B 150511
## Reading Sheet NTN-B 150812
## Reading Sheet NTN-B 150513
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2009.xls
## Reading Sheet NTN-B 150509
## Reading Sheet NTN-B 150810
## Reading Sheet NTN-B 150511
## Reading Sheet NTN-B 150812
## Reading Sheet NTN-B 150513
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2010.xls
## Reading Sheet NTN-B 150810
## Reading Sheet NTN-B 150511
## Reading Sheet NTN-B 150812
## Reading Sheet NTN-B 150513
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2011.xls
## Reading Sheet NTN-B 150511
## Reading Sheet NTN-B 150812
## Reading Sheet NTN-B 150513
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2012.xls
## Reading Sheet NTN-B 150812
## Reading Sheet NTN-B 150513
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2013.xls
## Reading Sheet NTN-B 150513
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2014.xls
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2015.xls
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2016.xls
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150826
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2017.xls
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150826
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2018.xls
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150826
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2019.xls
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150826
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2020.xls
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150826
## Reading Sheet NTN-B 150830
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150840
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading Sheet NTN-B 150555
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2021.xls
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150826
## Reading Sheet NTN-B 150830
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150840
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading Sheet NTN-B 150555
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2022.xls
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150826
## Reading Sheet NTN-B 150830
## Reading Sheet NTN-B 150832
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150840
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading Sheet NTN-B 150555
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2023.xls
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150826
## Reading Sheet NTN-B 150830
## Reading Sheet NTN-B 150832
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150840
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading Sheet NTN-B 150555ntnb_02<-ntnb %>% filter(ref.date==as.Date("2021-01-11"))
options(ggrepel.max.overlaps = Inf)
g<-filter(ntnb, ref.date > '2021-01-30') %>%
ggplot(aes(x=ref.date, y=yield.bid*100, colour=asset.code))+
geom_line()+geom_hline(yintercept=0, colour='black', linetype='dashed')+
theme(panel.background = element_rect(fill='white'), legend.position = "none")+
scale_x_date(breaks = date_breaks("1 month"),
labels = date_format("%b/%Y"))+
theme(axis.text.x=element_text(angle=45, hjust=1))+
labs(x='', y='% a.a.',
title='Títulos com inflação (NTN-B)', subtitle = "Valor do Cupom Semestral",
caption='Fonte: Tesouro Direto') +geom_label_repel(aes(label = asset.code), data = ntnb_02, nudge_x = 1, na.rm = TRUE) + theme(legend.position = "none")
embi =ipeadatar::search_series(terms="EMBI")## Warning: `filter_()` was deprecated in dplyr 0.7.0.
## ℹ Please use `filter()` instead.
## ℹ See vignette('programming') for more help
## ℹ The deprecated feature was likely used in the ipeadatar package.
## Please report the issue at
## <https://github.com/gomesleduardo/ipeadatar/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.embi = ipeadatar::ipeadata(embi$code)
embi %>% filter(date > as.Date('2019-01-01')) -> embi_1
g + geom_line(aes(x=date, y=value/100, colour="red"),linetype = "dotted", size=1, data = embi_1 %>% filter(date> as.Date("2022-01-01"))) +scale_y_continuous(sec.axis = dup_axis(breaks = embi$value[length(embi$value)]/100,labels="Embi", name=NULL))
#
#
# +
# annotate("rect", fill = "gray", alpha = 0.5,
# xmin = as.Date('2020-02-15'),
# xmax = as.Date('2021-12-01'),
# ymin = -Inf, ymax = Inf)
embi =ipeadatar::search_series(terms="EMBI")
embi = ipeadatar::ipeadata(embi$code)
embi %>% filter(date > as.Date('2019-01-01')) %>%
ggplot(aes(x=date, y=value))+
annotate("rect", fill = "gray", alpha = 0.5,
xmin = as.Date('2020-02-15'),
xmax = as.Date('2021-12-01'),
ymin = -Inf, ymax = Inf)+
geom_text(aes(x=as.Date('2020-06-15'),y=300,label="pandemia"),colour= "blue")+
geom_line(colour= "blue")+geom_point(colour= "blue")+ylab('')+xlab("")+
scale_x_date(breaks = date_breaks("1 year"),
labels = date_format("%b/%Y"))+
theme(axis.text.x=element_text(angle=45, hjust=1))+
labs(x='', y='',
title='Risco Emergentes na Pandemia',
caption='Fonte: IPEADATA e @profeconomia')+ggthemes::theme_base()
Inflação
rm(list=ls())
#install.packages("dynlm")
library(sidrar)
library(ggplot2)
library(scales)
library(dynlm)
library(ipeadatar)
#library(devtools)
#install_github("gomesleduardo/ipeadatar",force = TRUE)
library(ipeadatar)
library(dplyr)
library(tidyverse)
series<-search_series(terms=c("IPCA"))
library(zoo)
library(roll)
dol<-ipeadata(code="PRECOS12_IPCAG12")
dol<-dol %>% dplyr::select(date, value)
#inserir a previsão
# dol_1<-data.frame(date= as.Date('2023-09-01'),value = 0.30)
# dol<-bind_rows(dol, dol_1)
dol<- dol %>% mutate(ipca = roll_prod(value/100+1,12)-1)
times = seq(as.Date('1995-12-01'),as.Date(tail(dol$date)[6]),
by='month')
dol = data.frame(time=times, ipca=tail(c(dol$ipca), length(times)))
# dol <- rbind(dol, data.frame(time=as.Date("2022-12-01"),ipca= 0.69))
dol$presidente <-c(rep(c("FHC"),length(seq(as.Date('1995-10-01'),as.Date('2002-12-01'), by='month'))),rep(c("Lula"),length(seq(as.Date('2003-02-01'),as.Date('2009-12-01'), by='month'))),rep(c("Dilma"),length(seq(as.Date('2010-02-01'),as.Date('2016-07-01'), by='month'))),rep(c("Temer"),length(seq(as.Date('2016-08-31'),as.Date('2019-01-01'), by='month'))),rep(c("Bolsonaro"),length(seq(as.Date('2019-01-01'),as.Date('2022-12-01'), by='month'))),rep(c("Lula"),length(seq(as.Date('2023-01-01'),as.Date('2023-10-01'), by='month'))))
library(ggthemes)
ggplot(dol %>% filter(time>as.Date("2018-01-01")), aes(x=time, y=ipca*100))+
#geom_text(aes(label=presidente),size=2,vjust=4,shape=22, colour="gray5")+
geom_line(size=.8, colour='darkblue')+theme_economist()+
scale_x_date(breaks = date_breaks("1 year"),
labels = date_format("%b/%Y"))+
geom_point(size=9, shape=21, colour="red", fill="white")+
geom_text(aes(label=round(ipca*100,1)), size=3,
hjust=0.5, vjust=0.5, shape=21, colour="#1a476f")+
xlab('')+ylab('')+scale_y_continuous(labels = function(x) paste0(x, "%"))+
labs(title='IPCA',
subtitle='2018 a 2023',
caption='IBGE e @profeconomia')+geom_vline(xintercept =c( as.Date('2016-08-31'),as.Date('2019-01-01'), as.Date("2010-01-01"), as.Date("2003-01-01")), linetype="dashed", color = "red")+
geom_text(aes(label="Julho", x=as.Date("2022-06-01"),y=11),size=3,
hjust=0.5, vjust=0.5, shape=21, colour="#1a476f")+
geom_text(aes(label="Agosto", x=as.Date("2022-07-01"),y=9),size=3,
hjust=0.5, vjust=0.5, shape=21, colour="#1a476f")+
geom_text(aes(label="Setembro", x=as.Date("2022-10-01"),y=7),size=3,
hjust=0.5, vjust=0.5, shape=21, colour="#1a476f")+
geom_text(aes(label="Agosto", x=as.Date("2023-08-01"),y=5),size=3,
hjust=0.5, vjust=0.5, shape=21, colour="#1a476f")## Warning in geom_text(aes(label = round(ipca * 100, 1)), size = 3, hjust = 0.5,
## : Ignoring unknown parameters: `shape`## Warning in geom_text(aes(label = "Julho", x = as.Date("2022-06-01"), y = 11), :
## Ignoring unknown parameters: `shape`## Warning in geom_text(aes(label = "Agosto", x = as.Date("2022-07-01"), y = 9), :
## Ignoring unknown parameters: `shape`## Warning in geom_text(aes(label = "Setembro", x = as.Date("2022-10-01"), :
## Ignoring unknown parameters: `shape`## Warning in geom_text(aes(label = "Agosto", x = as.Date("2023-08-01"), y = 5), :
## Ignoring unknown parameters: `shape`
Grupos de Inflação
#install.packages("devtools")
library(devtools)## Carregando pacotes exigidos: usethis#install_github("andrewuhl/RollingWindow")
#library(RollingWindow)
library(ggplot2)
library(sidrar)
library(tidyverse)
library(roll)
library("ggrepel")
tabela = get_sidra(api='/t/7060/n1/all/v/all/p/all/c315/7169,7170,7445,7486,7558,7625,7660,7712,7766,7786/d/v63%202,v66%204,v69%202,v2265%202')## All others arguments are desconsidered when 'api' is informedtabela$`Geral, grupo, subgrupo, item e subitem`[1:10]## [1] "Índice geral" "1.Alimentação e bebidas"
## [3] "2.Habitação" "3.Artigos de residência"
## [5] "4.Vestuário" "5.Transportes"
## [7] "6.Saúde e cuidados pessoais" "7.Despesas pessoais"
## [9] "8.Educação" "9.Comunicação"inflacao_01<-NULL
for (i in tabela$`Geral, grupo, subgrupo, item e subitem`[1:10] )
{
inflacao<- tabela %>% filter(`Geral, grupo, subgrupo, item e subitem`==i, Variável=="IPCA - Variação mensal") %>% dplyr::select(`Mês (Código)`, Valor, Variável) %>% mutate(grupo = i)
print(i)
inflacao_01<-bind_rows(inflacao_01, inflacao)
}## [1] "Índice geral"
## [1] "1.Alimentação e bebidas"
## [1] "2.Habitação"
## [1] "3.Artigos de residência"
## [1] "4.Vestuário"
## [1] "5.Transportes"
## [1] "6.Saúde e cuidados pessoais"
## [1] "7.Despesas pessoais"
## [1] "8.Educação"
## [1] "9.Comunicação"#inflacao_01$Valor[is.na(inflacao_01$Valor)]<-1
library(lubridate)
inflacao_01<-inflacao_01 %>% filter(grupo != "Índice geral") %>% mutate(date=ym(`Mês (Código)`))%>% group_by(grupo) %>% mutate(IPCA_A = roll_prod(Valor/100+1,12)-1) %>%
mutate(IPCA_A2 = zoo::rollmean(IPCA_A,12, align = "right",fill = NA))%>%
filter(date>=as.Date("2021-12-01"))
inflacao_02<-inflacao_01 %>% filter(date==min(inflacao_01$date))
inflacao_01 %>%
ggplot(aes(x=date, y=IPCA_A2, colour=grupo))+geom_line()+geom_point()+xlab("")+
ylab("Inflação dos Grupos")+geom_label_repel(aes(label = grupo), data = inflacao_02, nudge_x = 1,
na.rm = TRUE) +
theme(legend.position = "none")
inflacao_01 %>% group_by(grupo) %>%summarise(tail(IPCA_A2,1))## # A tibble: 9 × 2
## grupo `tail(IPCA_A2, 1)`
## <chr> <dbl>
## 1 1.Alimentação e bebidas 0.0598
## 2 2.Habitação 0.0262
## 3 3.Artigos de residência 0.0320
## 4 4.Vestuário 0.119
## 5 5.Transportes 0.000757
## 6 6.Saúde e cuidados pessoais 0.106
## 7 7.Despesas pessoais 0.0685
## 8 8.Educação 0.0809
## 9 9.Comunicação 0.00923Desemprego Formal
library(tidyverse)
library(readxl)
library(ggthemes)
setwd("G:/Meu Drive/aplicações no r")
datas<-paste("2023/202309",sep="")
#http://pdet.mte.gov.br/images/Novo_CAGED/2023/202302/3-tabelas.xlsx
for( i in datas){
url = paste("http://pdet.mte.gov.br/images/Novo_CAGED/",i, "/3-tabelas.xlsx", sep="")
download.file(url, destfile='dados/caged.xlsx', mode='wb')
data = read_excel('dados/caged.xlsx', sheet = 'Tabela 5.1',
range="B5:G50")%>%
mutate(`Mês` = parse_date(`Mês`, format='%B/%Y', locale=locale('pt')))
assign(paste("des_",i, seq=""),data)
}
x<-46
estoque<-as.matrix(t(data[-c(x,x+1),c(3,4,5)]))
colnames(estoque)<-paste(data$Mês)[-c(x,x+1)]
rownames(estoque)<-colnames(data[-c(x,x+1),c(3,4,5)])
barplot(estoque, col=heat.colors(length(rownames(estoque))), width=2, axes=FALSE,ylim=c(10000, 5000000), las=2)
# Add X-axis
# axis(1,
# col = "blue", # Axis line color
# col.ticks = "green", # Ticks color
# col.axis = "red") # Labels color
# Add Y-axis
axis(2,
col = "blue",
col.ticks = "green",
col.axis = "red",
at = seq(100000,5000000, by=1000000 ),
labels = paste0(seq(1000,5000, by=1000)," mil"),
ylim=c(1000000, 5000000),
las = 1, gap.axis = 1/4)
legend("topleft", inset=c(0,0),fill=heat.colors(length(rownames(estoque))),
legend=rownames(estoque))
title(main="Saldos = Admissões - Desligamentos")
#text(seq(1,50,2), 4050000, round(data$Saldos/1000, 1))
saldo<-estoque[3,]
saldo <- as.data.frame(saldo)
saldo<-cbind(saldo,ifelse(saldo>=0,"#FFFF00", "#FF0000"))
colnames(saldo)[2]<-"cor"
saldo$data<-colnames(estoque)
saldo_v1<-as.matrix(t(saldo$saldo))
colnames(saldo_v1)<-saldo$data
saldo<-saldo[-c(x,x+1),]
p<-ggplot(saldo, aes(x=data, y=saldo, fill=cor)) +
geom_bar(stat="identity")+theme_clean()+labs(title="Comparativo de criação de empregos mensais", caption="CAGED e @profeconomia")+ theme(panel.background = element_rect(fill='white'), legend.position = "none", axis.text.x = element_text(angle=90, hjust=1))+ scale_y_continuous(breaks = seq(-8e5,4e5, by=1e5 ),labels = paste0(seq(-8e5/1e3,4e5/1e3, by=1e2 )," mil"), limits = c(-1e6, 5e5))
p
# #par(mar=c(10,5,5,10))
# colors<-c(ifelse(saldo_v1>=0,"#FFFF00", "#FF0000"))
# barplot(saldo$saldo, col=colors, las=2, axes=FALSE, ylim=c(-1e6, 5e5),xlim=c(0,30),names.arg=saldo$data)
# # Add X-axis
# # axis(1,
# # col = "blue", # Axis line color
# # col.ticks = "green", # Ticks color
# # col.axis = "red",
# # at = 1:27,
# # labels = saldo$data,
# # las=2,
# # xlim=c(0,25),
# # lwd=4)
#
# # Add Y-axis
# axis(2,
# col = "blue",
# col.ticks = "green",
# col.axis = "blue",
# at = seq(-8e5,4e5, by=1e5 ),
# labels = paste0(seq(-8e5/1e3,4e5/1e3, by=1e2 )," mil"),
# ylim=c(-1e6, 5e5),
# las = 1, gap.axis = 1/4)
#
# legend("bottomright", inset=c(0,0),fill=c("#FFFF00", "#FF0000"),
# legend= c("Positivo","Negativo"))
# title(main="Saldos = Admissões - Desligamentos")
# #text(seq(1,50,2), 4050000, round(data$Saldos/1000, 1))
seq_date1<-seq.Date(as.Date("2021-01-01"), as.Date("2022-09-01"), by="month")
seq_date2<-seq.Date(as.Date("2022-01-01"), as.Date("2023-09-01"), by="month")
desemp<-NULL
for( i in 1:length(seq_date2)){
a<-saldo %>% filter(data > as.Date("2021-01-01"),data < seq_date1[i] ) %>% summarise(total=sum(saldo))
b<-saldo %>% filter(data > as.Date("2022-01-01"),data < seq_date2[i] ) %>% summarise(total=sum(saldo))
print(cbind(b/a, as.Date(seq_date2[i])))
desemp<-rbind(desemp, cbind(b/a, as.Date(seq_date2[i])))
}## total as.Date(seq_date2[i])
## 1 NaN 2022-01-01
## total as.Date(seq_date2[i])
## 1 NaN 2022-02-01
## total as.Date(seq_date2[i])
## 1 0.8893409 2022-03-01
## total as.Date(seq_date2[i])
## 1 0.8210755 2022-04-01
## total as.Date(seq_date2[i])
## 1 1.026521 2022-05-01
## total as.Date(seq_date2[i])
## 1 1.031255 2022-06-01
## total as.Date(seq_date2[i])
## 1 0.9962932 2022-07-01
## total as.Date(seq_date2[i])
## 1 0.943713 2022-08-01
## total as.Date(seq_date2[i])
## 1 0.9031895 2022-09-01
## total as.Date(seq_date2[i])
## 1 0.8942687 2022-10-01
## total as.Date(seq_date2[i])
## 1 0.8680463 2022-11-01
## total as.Date(seq_date2[i])
## 1 0.8166899 2022-12-01
## total as.Date(seq_date2[i])
## 1 0.7310447 2023-01-01
## total as.Date(seq_date2[i])
## 1 0.7178314 2023-02-01
## total as.Date(seq_date2[i])
## 1 0.7167014 2023-03-01
## total as.Date(seq_date2[i])
## 1 0.755948 2023-04-01
## total as.Date(seq_date2[i])
## 1 0.7637846 2023-05-01
## total as.Date(seq_date2[i])
## 1 0.748082 2023-06-01
## total as.Date(seq_date2[i])
## 1 0.7337587 2023-07-01
## total as.Date(seq_date2[i])
## 1 0.7284439 2023-08-01
## total as.Date(seq_date2[i])
## 1 0.7305734 2023-09-01colnames(desemp)<-c("desemprego", "data")
desemp %>% ggplot(aes(x=data, y=desemprego))+geom_line(col="blue",linetype = "dashed")+geom_point()+ggthemes::theme_clean()+labs(title="Comparativo de criação de empregos mensais", caption="CAGED e @profeconomia")## Warning: Removed 2 rows containing missing values (`geom_line()`).## Warning: Removed 2 rows containing missing values (`geom_point()`).
Desemprego PNAD
Sobre o desemprego do brasileiro
library(sidrar)
library(ggplot2)
library(scales)
library(dynlm)
library(tidyverse)
#install.packages("huxtable")
library(huxtable)
tabela = get_sidra(api='/t/6381/n1/all/v/4099/p/all/d/v4099%201')
times = seq(as.Date('2012-03-01'),as.Date('2023-09-01'),
by='month')
# rm(desemprego)
#tabela <- tabela %>% filter(`Nível Territorial`=="Brasil")
desemprego = data.frame(time=times, desemprego=tail(tabela$Valor, length(times)))
desemprego$presidente <-c(rep(c("Dilma"),length(seq(as.Date('2012-03-01'),as.Date('2016-07-01'), by='month'))),rep(c("Temer"),length(seq(as.Date('2016-08-31'),as.Date('2019-01-01'), by='month'))),rep(c("Bolsonaro"),length(seq(as.Date('2019-01-01'),as.Date('2022-12-01'), by='month'))),rep(c("Lula_iii"),length(seq(as.Date('2023-01-01'),as.Date('2023-09-01'), by='month'))))
library(ggthemes)
ggplot(desemprego %>% filter(time>=as.Date("2012-01-01")), aes(x=time, y=desemprego))+
# geom_text(aes(label=presidente),size=3,vjust=3,shape=22, colour="gray5")+
geom_line(size=.8, colour='darkblue')+theme_economist()+
scale_x_date(breaks = date_breaks("1 year"),
labels = date_format("%b/%Y"))+
geom_point(size=9, shape=21, colour="red", fill="white")+
geom_text(aes(label=round(desemprego,1)), size=3,
hjust=0.5, vjust=0.5, shape=21, colour="#1a476f")+
xlab('')+scale_y_continuous(labels = function(x) paste0(x, "%"))+
labs(title='Desocupados',
subtitle='2015 a 2023',
caption='PNAD Contínua @profeconomia')+geom_vline(xintercept =c( as.Date('2016-08-31'),as.Date('2019-01-01')), linetype="dashed", color = "red")## Warning in geom_text(aes(label = round(desemprego, 1)), size = 3, hjust = 0.5,
## : Ignoring unknown parameters: `shape`
library(huxtable)
tabela<-desemprego %>% filter(time>=as.Date("2014-01-01")) %>% group_by(presidente) %>% summarise(media=mean(desemprego), risco=var(desemprego)^(1/2), data=tail(time,1))
ht <- hux(
presidente = c('Dilma', 'Temer', 'Bolsonaro','Lula_iii'),
percentual = c(tabela$media[c(2,4,1,3)]),
risco = c(tabela$risco[c(2,4,1,3)]),
add_colnames = TRUE
)
bold(ht)[1,] <- TRUE
bottom_border(ht)[1,] <- 0.4
align(ht)[,2:3] <- 'right'
right_padding(ht) <- 10
left_padding(ht) <- 10
width(ht) <- 0.35
number_format(ht) <- 2
ht| presidente | percentual | risco |
|---|---|---|
| Dilma | 8.40 | 1.66 |
| Temer | 12.52 | 0.61 |
| Bolsonaro | 12.14 | 1.97 |
| Lula_iii | 8.22 | 0.39 |
Treasures
library(GetTDData)
US_YIELD_10Y <- Quandl::Quandl("USTREASURY/YIELD.9",
type = "xts",
start_date = "2015-01-01")
treasure<-fortify(US_YIELD_10Y)
ntnb <- read.TD.files(dl.folder = 'G:/Meu Drive/aplicações no r/TD Files')##
## Reading xls data and saving to data.frame
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2005.xls
## Reading Sheet NTN-B 150806
## Reading Sheet NTN-B 150507
## Reading Sheet NTN-B 150808
## Reading Sheet NTN-B 150509
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150545
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2006.xls
## Reading Sheet NTN-B 150806
## Reading Sheet NTN-B 150507
## Reading Sheet NTN-B 150808
## Reading Sheet NTN-B 150509
## Reading Sheet NTN-B 150810
## Reading Sheet NTN-B 150511
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2007.xls
## Reading Sheet NTN-B 150507
## Reading Sheet NTN-B 150808
## Reading Sheet NTN-B 150509
## Reading Sheet NTN-B 150810
## Reading Sheet NTN-B 150511
## Reading Sheet NTN-B 150812
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2008.xls
## Reading Sheet NTN-B 150808
## Reading Sheet NTN-B 150509
## Reading Sheet NTN-B 150810
## Reading Sheet NTN-B 150511
## Reading Sheet NTN-B 150812
## Reading Sheet NTN-B 150513
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2009.xls
## Reading Sheet NTN-B 150509
## Reading Sheet NTN-B 150810
## Reading Sheet NTN-B 150511
## Reading Sheet NTN-B 150812
## Reading Sheet NTN-B 150513
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2010.xls
## Reading Sheet NTN-B 150810
## Reading Sheet NTN-B 150511
## Reading Sheet NTN-B 150812
## Reading Sheet NTN-B 150513
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2011.xls
## Reading Sheet NTN-B 150511
## Reading Sheet NTN-B 150812
## Reading Sheet NTN-B 150513
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2012.xls
## Reading Sheet NTN-B 150812
## Reading Sheet NTN-B 150513
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2013.xls
## Reading Sheet NTN-B 150513
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2014.xls
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2015.xls
## Reading Sheet NTN-B 150515
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2016.xls
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150826
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2017.xls
## Reading Sheet NTN-B 150517
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150826
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2018.xls
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150826
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2019.xls
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150826
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2020.xls
## Reading Sheet NTN-B 150820
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150826
## Reading Sheet NTN-B 150830
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150840
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading Sheet NTN-B 150555
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2021.xls
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150826
## Reading Sheet NTN-B 150830
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150840
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading Sheet NTN-B 150555
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2022.xls
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150826
## Reading Sheet NTN-B 150830
## Reading Sheet NTN-B 150832
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150840
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading Sheet NTN-B 150555
## Reading File = G:/Meu Drive/aplicações no r/TD Files/NTN-B_2023.xls
## Reading Sheet NTN-B 150824
## Reading Sheet NTN-B 150826
## Reading Sheet NTN-B 150830
## Reading Sheet NTN-B 150832
## Reading Sheet NTN-B 150535
## Reading Sheet NTN-B 150840
## Reading Sheet NTN-B 150545
## Reading Sheet NTN-B 150850
## Reading Sheet NTN-B 150555ntnb_01<-ntnb %>% filter(matur.date==c("2032-08-15"))
ggplot(ntnb_01, aes(x = as.Date(ref.date), y = price.bid/1000, col="BR")) +
geom_line() + labs(x = "Datas", y = "Preços", colour = NULL, title="Títulos de 10 anos, cuponados BR vs SPOT USA")+
geom_line(aes(x = Index, y= US_YIELD_10Y, col="USA") , data = treasure %>% filter(Index>=as.Date("2022-01-01")))
Curva de Juros
library(tidyverse)
library(tidyquant)
library(timetk)
library(scales)
library(quantmod)
library(GetTDData)
library(ipeadatar)
library(RColorBrewer)
library(ggrepel)
df.juros <- get.yield.curve()
p <- ggplot(df.juros, aes(x = ref.date, y = value)) +
geom_point() +
geom_line() +
labs(y = 'Juros',
x = 'Data',
title = 'Curva de Juros Corrente no Brasil',
subtitle = format(Sys.Date(), '%d de %B de %Y'),
caption = 'Dados da Anbima') +
facet_wrap(~ type, scales = 'free')
p