Category

Dicas de R

Visualizando a frequência de palavras na obra de Shakespeare

By | Dicas de R

No Dicas de R dessa semana, iremos visualizar o vocabulário de Shakespeare através das palavras mais frequentes entre todas as suas obras. A base de dados utilizada é a bardr, pacote que contém um dataframe com todas as obras, separadas por versos. Inicialmente, vamos limpar os dados e transformá-los em um dataframe que contém cada palavra como uma linha. Esse processo faz repetidas cópias de um dataframe, e, para agilizar o código, utilizaremos a função rbindlist, do pacote data.table, que é consideravelmente mais rápida do que a rbind() do R base ou a bind_rows() do dplyr. Após gerar o dataframe, basta agrupar por palavras, eliminar alguns dados desnecessários, e realizar a contagem.

library(bardr)
library(tidyverse)
library(data.table)
dados <- all_works_df

dados_limpos <- dados %>%
mutate(content = gsub("\032", "'", content))

df_final <- tibble(name = character(), word = character(), genre = character())
teste <- tibble(name = character(), word = character(), genre = character())

substringDF <- function(df){
words <- strsplit(df$content, " ")

aux <- tibble(name = rep(df$name, length(strsplit(df$content, " ")[[1]])),
word = strsplit(df$content, " ")[[1]],
genre = rep(df$genre, length(strsplit(df$content, " ")[[1]])))


df_final <<- rbindlist(list(df_final, aux))
}

for (i in 1:nrow(dados_limpos)) {
substringDF(dados_limpos[i,])
}

palavras <- df_final %>% filter(word!="" & (!str_detect(word, "^[[:upper:][:space:]]+$") |
word=="I")) %>%
mutate(word = tolower(gsub("[[:punct:]]", "", word)))

contagem <- palavras %>% group_by(word) %>% count() %>%
filter(!str_detect(word, "^(0|[1-9][0-9]*)$")) %>% arrange(desc(n))

Temos agora todas as palavras e seu número de aparições. Apesar disso, muitas delas não são relevantes, como "the" e "and", logo precisamos filtrar conectivos e afins. Para isso, iremos utilizar um categorizador de machine learning, treinado para a língua inglesa, com o objetivo de separar as palavras pela sua classe gramatical. O modelo utilizado é fornecido pelo pacote udpipe, e, após baixá-lo e carregá-lo, basta aplicar a função sobre os dados e realizar algumas formatações.


library(udpipe)
udmodel <- udpipe_download_model(language = "english")
udmodel_eng <- udpipe_load_model(
file = "english-ewt-ud-2.5-191206.udpipe")

classificador <- as.data.frame(udpipe_annotate(udmodel_eng, contagem$word)) %>% select(token, upos) %>%
data.table()

contagem <- contagem %>% data.table()

setkey(contagem, word)
setkey(classificador, token)

contagem_classificada <- contagem[classificador] %>% as_tibble() %>%
arrange(desc(n))

Feito isso, resta pegar os dados de interesse - aqui sendo definidos como adjetivos e substantivos - e visualizá-los com o gráfico gerado pelo pacote wordcloud2. Um gráfico desse tipo apresenta as palavras mais usadas, com tamanho proporcional à frequência delas.


library(wordcloud2)</pre>
adjetivos <- contagem_classificada %>% filter(upos == "ADJ")
substantivos <- contagem_classificada %>% filter(upos == "NOUN") %>%
slice(1:1000)

wordcloud2(adjetivos)

wordcloud2(substantivos)

Gerando aplicativos interativos com Shiny

By | Dicas de R

No Dicas de R dessa semana, vamos mostrar as funcionalidades básicas da ferramenta Shiny, que permite gerar aplicativos interativos em R. Nosso exemplo será um mapa da localização de jogadores famosos da Champions League ao receberem passes, utilizando os dados da plataforma StatsBomb - acessados através do pacote StatsBombR - e também a formatação em ggplot do pacote ggsoccer. Primeiramente, vamos carregar os pacotes utilizados:


library(shiny)
library(ggplot2)
library(ggsoccer)
library(tidyverse)

Um aplicativo em Shiny possui dois componentes principais: a interface do usuário, e um servidor. O primeiro indica todos os elementos que serão visíveis no programa final, e as interações que podem ocorrer entre eles. A interface apresentada abaixo contém um elemento de título, e um elemento de layout com barra lateral, que é subdivido entre o gráfico principal e a barra que faz a escolha - input do usuário - do jogador a ser apresentado.

ui <- fluidPage(

titlePanel("Posicionamento de jogadores ao receberem passes"),

sidebarLayout(

sidebarPanel(

selectInput(inputId = "players",
label = "Escolha um jogador:",
choices = c("Messi",
"Toni Kroos",
"Cristiano Ronaldo",
"Iniesta",
"Robben",
"Pirlo"))
),

mainPanel(plotOutput("fieldPlot"))

)
)

As escolhas que podem ser feitas foram definidas acima, porém o elemento fieldPlot referenciado na última linha não existe ainda. Ele é gerado internamente e apenas seu resultado é apresentado, logo seu código faz parte do servidor do programa:

server <- function(input, output){

output$fieldPlot <- renderPlot({

passes_de_jogo %>% filter(grepl(input$players, pass.recipient.name)) %>%
ggplot(aes(x=pass.end_location.x, y = pass.end_location.y))+
annotate_pitch(dimensions = pitch_statsbomb) +
geom_bin2d(binwidth = c(5, 5))+
theme_pitch()

})

}

Com os dois componentes em mãos, basta rodar o aplicativo:


shinyApp(ui = ui, server = server)

O resultado pode ser disponibilizado online, através do shinyapps.io. O aplicativo feito aqui está disponível aqui.
Abaixo, um exemplo do resultado:

É interessante notar que os dados aparentam estar invertidos - Robben está recebendo passes do lado esquerdo enquanto
que Cristiano Ronaldo do lado direito, contrariando suas posições originais.

Dicas de R: o pacote RDBnomics

By | Dicas de R

No Dicas de R de hoje, vamos mostrar como utilizar o pacote rdbnomics, que conecta o R à base de dados do DBNomics. O carro-chefe do pacote é a função rdb(), que permite acessar dados diretamente, tanto com calls para a API da base como para o ID das séries de interesse. Além disso, a função permite a aplicação de filtros - de agregação e interpolação - automaticamente, facilitando análises.

O ID de cada série está disponível logo abaixo de seu nome, dentro da página do provedor no site do DBNomics, entre chaves. Abaixo, mostraremos como exemplo como baixar os dados de taxa de desemprego da Argentina, Austrália e Áustria, com os dados do FMI.

library(rdbnomics)

arg <- rdb("IMF/WEO:2020-10/ARG.LUR.pcent_total_labor_force")
australia <- rdb("IMF/WEO:2020-10/AUS.LUR.pcent_total_labor_force")
austria <- rdb("IMF/WEO:2020-10/AUT.LUR.pcent_total_labor_force")

Com isso, temos 3 dataframes com as séries de interesse. Vamos então tratar os dados com tidyverse e visualizá-los com ggplot2. Como as séries são padronizadas pelo FMI, não precisamos nos preocupar com fazer matching das datas e inner joins, logo a transformação fica simplificada. Os dados vão de 1980 a 2025, logo a parte final é uma estimação para o futuro da trajetória de desemprego dos 3 países.

library(tidyverse)
library(ggplot2)

dados <- tibble(Argentina = arg$value,
Austrália = australia$value,
Áustria = austria$value,
Ano = seq(1980, 2025, by = 1)) %>%
pivot_longer(-Ano, values_to = "Valor", names_to = "Variável")

dados %>% ggplot(aes(x=Ano, y = Valor, color = Variável))+geom_line(size = 1.1)+
labs(title = "Taxa de desemprego entre 1980 e 2025", y = "%", x = NULL,
caption = "Fonte: Análise Macro com dados do DBNomics")+
scale_x_continuous(breaks = seq(1980, 2025, by = 5), labels = seq(1980, 2025, by = 5))+
theme_minimal()+
theme(legend.title = element_blank(),
plot.caption.position = "plot")


_____________________

Acessando e visualizando dados do COVID-19 no Brasil

By | Dicas de R

Para o Dicas de R dessa semana, vamos ensinar a baixar os dados sobre número de casos e óbitos de COVID de duas fontes, o repositório covid19br, e os datasets da plataforma brasil.io. Para fazer o download dos dados, basta acessar os arquivos CSV disponíveis online. Note que, no caso do brasil.io, os dados estão comprimidos, logo iremos utiilizar o pacote vroom, que baixa e extrai automaticamente as tabelas.

#não rodado
#dados_covid19br <- read.csv("https://raw.githubusercontent.com/wcota/covid19br/master/cases-brazil-states.csv")
dados_covid <- vroom::vroom("https://data.brasil.io/dataset/covid19/caso_full.csv.gz")

dados_obitos <- vroom::vroom("https://data.brasil.io/dataset/covid19/obito_cartorio.csv.gz")

Primeiramente, vamos analisar a trajetória do número de casos em território nacional. Como de costume, vamos utilizar a média móvel de 7 dias para suavizar os dados.

library(tidyverse)
library(RcppRoll)
library(ggplot2)
library(ggthemes)

dados_covid %>% filter(place_type == "state") %>%
group_by(date) %>% summarise(total=sum(new_confirmed)) %>%
mutate(casos = roll_meanr(total, n=7)) %>%
ggplot(aes(x=date, y=casos)) + geom_line(size=1.05) +
scale_x_date("", breaks = "1 month", minor_breaks = "2 weeks", date_labels = "%b %y") +
scale_y_continuous("Número de casos novos (em milhares)", breaks = seq(0, 150000, 25000), labels =
seq(0, 150, 25)) +
labs(title=('Evolução do número de casos de COVID-19 em território nacional')) +
theme_bw()

Além do número de casos, é interessante colocar em perspectiva o número de mortes causadas por COVID-19 em relação ao total de mortes do país. É claro que, além dos valores registrados, devemos ter em mente a existência de subidentificação do número de casos e óbitos, logo a proporção apresentada aqui deve ser considerada conservadora. Para fazermos a análise, vamos acessar os dados de óbitos registrados em cartórios por todo o país. Devido a limitações do dataset atualmente disponível no brasil.io, vamos restringir a visualização até 30/12/2020.


dados_2020 <- dados_obitos %>% group_by(date) %>%
summarise(deaths_covid = sum(new_deaths_covid19, na.rm = TRUE),
deaths_sars = sum(new_deaths_sars_2020, na.rm = TRUE),
deaths_others = sum(new_deaths_others_2020, na.rm = TRUE),
deaths_septicemia = sum(new_deaths_septicemia_2020, na.rm = TRUE),
deaths_pneumonia = sum(new_deaths_pneumonia_2020, na.rm = TRUE),
deaths_indeterminate = sum(new_deaths_indeterminate_2020, na.rm = TRUE),
deaths_respiratory = sum(new_deaths_respiratory_failure_2020, na.rm = TRUE),
deaths_total = sum(new_deaths_total_2020, na.rm = TRUE))

dados_2019 <- dados_obitos %>% group_by(date) %>%
summarise(deaths_covid = 0,
deaths_sars = sum(new_deaths_sars_2019, na.rm = TRUE),
deaths_others = sum(new_deaths_others_2019, na.rm = TRUE),
deaths_septicemia = sum(new_deaths_septicemia_2019, na.rm = TRUE),
deaths_pneumonia = sum(new_deaths_pneumonia_2019, na.rm = TRUE),
deaths_indeterminate = sum(new_deaths_indeterminate_2019, na.rm = TRUE),
deaths_respiratory = sum(new_deaths_respiratory_failure_2019, na.rm = TRUE),
deaths_total = sum(new_deaths_total_2019, na.rm = TRUE))

agregado <- rbind(dados_2019, dados_2020) %>%
mutate(date = seq(from = as.Date("2019-01-01"), to = as.Date("2021-01-01"), by = 'day'))

agregado %>% select(-deaths_total) %>%
mutate(across(-date, function(x) roll_meanr(x, n=7))) %>%
pivot_longer(-date, names_to = "variavel", values_to = "valor") %>%
ggplot(aes(x=date, y=valor, fill = variavel))+
geom_col(position = "fill") +
scale_y_continuous(labels = scales::percent)+
scale_fill_manual(values = c("#2b1a6e", "#22bfbb", "#33e8e2",
"#6492e8", "#86bfb6", "#4b3a70",
"#609fc4"),
labels = c("Mortes por COVID-19", "Mortes de causa indeterminada",
"Mortes por outras causas", "Mortes de pneumonia",
"Mortes por problemas respiratórios",
"Mortes de SRAG", "Mortes de sepse")) +
scale_x_date(date_breaks = "3 months", date_labels = "%b %y") +
labs(title = "Distribuição dos óbitos diários entre 2019 e 2020 por causa de morte",
caption = "Fonte: Análise Macro com dados do brasil.io") +
theme(axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
plot.caption = element_text(hjust = 2, face= "italic"),
axis.text.y = element_text(margin = margin(t = 0, r = -15, b = 0, l = 0)),
axis.ticks.y = element_blank()
)

_____________________

Dicas de R: dados da Zona Euro

By | Dicas de R

E aí pessoal! Para o Dicas de R dessa semana, vamos mostrar como acessar dados macroeconômicos da Zona do Euro, e mostrar uma breve visualização deles conforme fazemos nos nossos cursos com dados brasileiros. Os dados estão disponíveis no Observatório Macroeconômico do CEPREMAP, e são distribuídos em 4 arquivos:

1. O arquivo sw03 contém dados atualizados para a Zona do Euro de uma tabela utilizada para um modelo DSGE em Smets e Wouters (2003)
2. O arquivo financial contém dados financeiros conforme Christiano et al.(2014)
3. O arquivo fiscal contém dados de impostos e do governo conforme Paredes et al. (2014)
4. O arquivo open contém dados sobre o setor externo da Zona do Euro, como demanda externa, taxa de juros externa, preço de petróleo, importações e exportações, etc.

Os arquivos são atualizados com frequência, e o método de coleta deles é explicado no site do CEPREMAP para quem quiser saber mais. O código abaixo baixa os arquivos e os transforma em um único tibble:

library(tidyverse)
sw03 <- read_csv("https://shiny.cepremap.fr/data/EA_SW_rawdata.csv") %>%
filter(period >="1980-01-01")

fiscal <- read_csv("https://shiny.cepremap.fr/data/EA_Fipu_rawdata.csv")

financial <- read_csv("https://shiny.cepremap.fr/data/EA_Finance_rawdata.csv")

open <- read_csv("https://shiny.cepremap.fr/data/EA_Open_rawdata.csv")

agregado <- sw03 %>%
inner_join(fiscal,by="period") %>%
inner_join(financial,by="period") %>%
inner_join(open,by="period") %>%
mutate(employrt = employ/pop)

A tabela é extensa, possuindo desde dados mais comuns, como taxas de juros de curto e longo prazo, PIB e consumo, a dados mais interessantes, como impostos e subsídios, contribuição dos trabalhadores, empréstimos para domicílios e instituições não-financeiras, etc.

Vamos utilizar agora o ggplot para visualizar algumas dessas séries. É importante notar que a taxa de emprego utilizada não é sobre a população economicante ativa, e sim sobre a população total, logo não pode ser comparada com dados de outras áreas. Para encontrar a taxa usual, seria preciso acessar os dados desagregados de cada país.

library(ggplot2)
library(ggthemes)
library(scales)
library(ggrepel)
breaks_fun <- function(x) {
if (max(x) > 2000000) {
c(1600000, 2000000, 2400000)
} else if (max(x) > 1400000) {
seq(800000,1500000,200000)
} else if (max(x) > 500000) {
seq(300000, 600000, 100000)
} else {
seq(0.6, 0.75, 0.03)
}

}

agregado %>% rename("Consumo"=conso, "PIB"=gdp, "Investimento"=inves,
"Taxa de emprego" = employrt) %>%
pivot_longer(!period, names_to = "dados", values_to = "value") %>%
filter(dados %in% c("Consumo", "PIB", "Investimento", "Taxa de emprego")) %>%
ggplot(aes(x=period, y = value, colour=dados))+
geom_line(size = 1.1)+
facet_wrap(~dados, scales = 'free_y')+
scale_x_date(breaks = date_breaks("5 years"),
labels = date_format("%Y"))+
scale_y_continuous(breaks = breaks_fun,
labels = function(x) format(x, big.mark = ",", scientific = FALSE),
limits=c(NA, NA))+
theme_fivethirtyeight()+
theme(axis.text.x=element_text(angle=45, hjust=1),
legend.position = 'none',
axis.title.x=element_blank(),
strip.text = element_text(size=10, face='bold'))+
labs(y='',
title='Principais variáveis macroeconômicas - Zona do Euro',
caption='Fonte: analisemacro.com.br com dados do CEPREMAP')

_____________________

Seja avisado da nossa próxima aula ao vivo de R para Análise de Dados, toda terça-feira, às 21h!

Quero ser avisado
{"cart_token":"","hash":"","cart_data":""}