Category

Data Science

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")


_____________________

O lockdown é eficaz? Coletando evidências para o Brasil

By | Clube AM, Data Science

Nesse post extra, iremos mostrar outra visualização dos dados de COVID-19 apresentados no Dicas de R de quarta-feira, e também fazer um breve estudo sobre o impacto do isolamento social (lockdown) sobre os casos de gripe que apresentam SRAG, dado que essa doença possui meios de transmissão semelhantes aos do coronavírus. Inicialmente, vamos mostrar como a análise de números de casos feita no post pode ser separada em estados:

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

library(tidyverse)
library(RcppRoll)
library(ggplot2)
library(ggthemes)
escalas <- function(x) {
if (max(x) > 10000) {
seq(0, 12500, 2500)
} else if (max(x) > 8000) {
seq(0, 10000, 2000)
} else if (max(x) > 6000) {
seq(0, 8000, 1600)
} else if (max(x) > 4000){
seq(0, 5000, 1000)
} else if (max(x) > 3000){
seq(0, 3000, 600)
}
}

por_estado %>%
filter(state %in% ranking[1:9]) %>%
ggplot(aes(x=date, y=value)) + geom_line(size=1.05) +
scale_y_continuous("Número de casos novos", breaks = escalas) +
scale_x_date("", breaks = "3 month", minor_breaks = "1 month", date_labels = "%b %y") +
labs(title=('Evolução da COVID-19: estados com maior número de casos')) +
theme_bw() + facet_wrap(~state, scales = "free_y")

Devemos notar que os dados desagregados possuem algumas observações que parecem ser errôneas, porém decidimos mantê-las aqui. Abaixo, um dos gráficos gerados:

Agora, vamos analisar os dados de números de casos de SRAG causados por gripe comum, conforme disponível no repositório do InfoGripe. Devido ao impacto das medidas de isolamento sobre a economia, e também sobre as fontes de renda de pessoas sob insegurança econômica, o trade-off implícito do distanciamento tem sido muito debatido, surgindo argumentos de parte da população de que o distanciamento nem mesmo seria efetivo. Como não temos dados sobre o COVID-19 sem a existência de lockdown - que seja total, parcial ou mal-aplicado -, não temos dados de controle para testar o efeito do lockdown sobre a trajetória do número de casos da doença.

Por outro lado, existem doenças que, apesar de possuírem taxas de contaminação e mortalidade menores do que o COVID-19, compartilham de seus métodos de transmissão, logo podemos inferir que, em um regime de distanciamento cujo objetivo é diminuir a transmissão do COVID-19, a redução na transmissão de outras doenças que dependem do mesmo tipo de contato evidencia a efetividade do método.

No código abaixo, vamos visualizar o número de casos ano-a-ano de gripe que apresentam SRAG:

library(ggplot2)
library(tidyverse)

infogripe <- read.csv("https://gitlab.procc.fiocruz.br/mave/repo/-/raw/master/Dados/InfoGripe/serie_temporal_com_estimativas_recentes.csv", sep = ';')

gripe_limpo <- infogripe %>% filter(Tipo == "País" & escala == "casos") %>%
select(`Ano.epidemiológico`, `Semana.epidemiológica`, `dado`,
`Casos.semanais.reportados.atÃ..a.última.atualizaÃ.Ã.o`)

srag <- gripe_limpo %>% filter(dado=="sragflu") %>%
rename(casos = Casos.semanais.reportados.atÃ..a.última.atualizaÃ.Ã.o,
ano = Ano.epidemiológico,
semana = Semana.epidemiológica) %>%
mutate(date = ano + semana/52,
date = ifelse(ano == 2014 | ano == 2020, ano+semana/53, date),
casos = as.numeric(gsub(",", ".", casos)))

srag_podado <- srag %>% filter(semana &amp;lt;53) %>%
mutate(semana = ifelse(semana&amp;lt;10, paste(0, semana, sep = ""), semana),
semana = gsub(" ", "", paste(semana, "01")),
date = paste(ano, semana, sep = ""),
date = as.Date(date, "%Y%W%w"))

srag_usual <- srag_podado %>% filter(ano > 2009)

ggplot(srag_usual, aes(x=date, y = casos)) + geom_line() + facet_wrap(~ano, scales = "free") +
scale_x_date(date_labels = "%b") + 
labs(title = "Número de casos de SRAG causada por gripe por ano", ylab="Quantidade",
caption = "Fonte: Análise Macro com dados do INFOGIPE")+
theme(axis.title.x = element_blank())

Como podemos ver, a gripe apresenta alguma sazonalidade, e seus picos tendem a decair lentamente após o início da temporada de transmissão. É interessante notar que, no ano de 2020, há uma queda brusca no número de casos, resultado bem diferente dos anos anteriores. Além disso, o número de casos até agora em 2021 é relativamente baixo, que pode indicar uma continuação no efeito anômalo, mas também pode ser resultado de ainda não ter começado a temporada de gripe em 2021. Vamos então visualizar mais claramente os dados de 2020.

library(ggrepel)

srag_usual %>% filter(ano == 2020) %>%
ggplot(aes(x=date, y=casos))+geom_line() + 
geom_vline(xintercept = as.numeric(as.Date("2020-03-15")), linetype = 4)+
scale_x_date(breaks = "2 months", minor_breaks = "1 week", date_labels = "%b %Y")+
labs(title = "Número de casos de SRAG causada por gripe em 2020", ylab="Quantidade",
caption = "Fonte: Análise Macro com dados do INFOGIPE") +
geom_label_repel(data = filter(srag_usual, date == as.Date("2020-03-15")),
label = "Ínicio do isolamento",
box.padding = 2,
aes(x=as.Date("2020-03-15"), y= 250))+
theme(axis.title.x = element_blank())

 

A data referenciada como início do isolamento é metade de março, época onde a maior parte dos governos estaduais decretou lockdown. Como podemos ver, o número de casos de gripe com SRAG cai bruscamente cerca de 10 dias depois, que é próximo do tempo de incubação de sintomas desse tipo para a gripe. Com isso, a análise exploratória parece indicar evidências de que utilizar o distanciamento como variável binária para controlar os casos de SRAG pode ser válido.

Faremos então a modelagem de um modelo ARDL, que tem como variáveis explicativas o lag do número de casos e a existência (ou não) de distanciamento. Os detalhes estarão disponíveis para os membros do Clube AM. A regressão final é:

Dependent variable:
casos
lag(casos, 1) 1.424***
(0.039)
lag(casos, 2) -0.512***
(0.046)
lag(casos, 5) 0.170***
(0.046)
lag(casos, 6) -0.165***
(0.039)
lag(casos, 52) 0.015
(0.011)
lockdown -10.129**
(4.613)
Constant 5.511***
(1.705)
Observations 527
R2 0.941
Adjusted R2 0.940
Residual Std. Error 30.076 (df = 520)
F Statistic 1,370.252*** (df = 6; 520)
Note: *p<0.1; **p<0.05; ***p<0.01

Os resultados encontrados sugerem que a existência do lockdown é estatisticamente significante, com p-valor de 0.028. O sinal do seu parâmetro é -10, logo temos evidência de que o lockdown diminui a média de casos novos semanais em mais de 10. Apesar do lag sazonal ser estatisticamente insignificante, sua exclusão aumenta o AIC e diminui a log-likelihood, logo ele é mantido aqui.

Em suma, os resultados encontrados nesse exercício sugerem que a existência do distanciamento e de medidas restritivas implica em diminuição da transmissão da gripe, que é contagiada de forma semelhante ao COVID-19. Com isso, inferimos que o lockdown é sim uma boa medida para o controle de doenças do tipo.

__________________

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()
)

_____________________

Cadastre-se em nossa Lista VIP para receber conteúdos exclusivos!

Fazer Inscrição
{"cart_token":"","hash":"","cart_data":""}