Câmara Municipal de Ribeirão Preto 2022: plotagens do setor da cultura e COVID-19
——————————————————————————————————
O COVID-19 afetou significativamente diversos setores municipais.
Nesse contexto, pessoa vinculada à Câmara Municipal de Ribeirão Preto requereu auxílio para a manipulação e a plotagem de dados referentes à COVID-19 e a valores pagos, sendo os últimos associados a setor da prefeitura. Os plots neste Markdown elaborados foram produzidos no processo adotado para atender a demanda da pessoa vinculada à Câmara de Ribeirão Preto, isso no processo de produção de relatório associado à Comissão Especial de Estudos.
Mais precisamente, neste Markdown é almejado visualizar a relação de casos de COVID-19 (considerando o período em que ocorrem) com valores pagos (considerando o período, a finalidade e a origem do dinheiro).
Aqui, tratamos do setor de Cultura.
Vamos ao código.
——————————————————————————————————
Dados da Cultura.
Importa pacotes.
library(readxl)
library(openxlsx)
library(xlsx)## Warning: package 'xlsx' was built under R version 4.1.3##
## Attaching package: 'xlsx'## The following objects are masked from 'package:openxlsx':
##
## createWorkbook, loadWorkbook, read.xlsx, saveWorkbook, write.xlsxlibrary(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.6 v purrr 0.3.4
## v tibble 3.1.2 v dplyr 1.0.7
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.1## Warning: package 'ggplot2' was built under R version 4.1.3## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(ggplot2)
library(lubridate)##
## Attaching package: 'lubridate'## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, unionlibrary(zoo)##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericlibrary(dplyr)Seta a pasta e importa dados.
# Seta a pasta.
setwd('C:/Users/Usuario/Documents/prefeitura_ribeirao_preto_2022')
# O arquivo que contém os dados de interesse é um .xlsx com três abas.
list_dfs <- excel_sheets('CULTURA_versao_06_06_2022.xlsx') %>%
map(~read_xlsx('CULTURA_versao_06_06_2022.xlsx',.))Foi informado que os dados de interesse estão na primeira aba do .xlsx mencionado acima.
Assim, passamos os dados desta aba (que é o primeiro item da lista list_dfs) para um novo DF e investigamos propriedades dos dados deste novo DF.
# Passa o elemento da lista para um novo DF.
cult_compl <- list_dfs[[1]]
# A seguir são identificados NAs. Todas são referentes a locais já esperados.
sum(is.na(cult_compl))## [1] 5# Visualizamos os valores inseridos na coluna "Fonte".
unique(cult_compl$Fonte)## [1] "Municipal" "Federal"# Visualiza estatísticas descritivas.
summary(cult_compl)## Fonte
## Length:1157
## Class :character
## Mode :character
##
##
##
##
## Fonte do recurso com a especificação da Normativa Federal/Estadual (ex: Lei no; Portaria no;\r\nse for a LC 173/2020, especificar i nciso I ou II do artigo 5o) ou Fonte do Recurso Próprio - para COVID
## Length:1157
## Class :character
## Mode :character
##
##
##
##
## Data do recebimento da verba em Fundo Municipal, referente aos repasses de verbas Federal OU Estadual
## Min. :2020-07-15 00:00:00
## 1st Qu.:2020-10-01 00:00:00
## Median :2020-10-01 00:00:00
## Mean :2020-10-05 10:45:00
## 3rd Qu.:2020-10-01 00:00:00
## Max. :2021-01-03 00:00:00
## NA's :5
## Número empenho Data do empenho Data do pagamento
## Length:1157 Min. :2020-05-29 00:00:00 Min. :2020-06-18 00:00:00
## Class :character 1st Qu.:2020-12-15 00:00:00 1st Qu.:2020-12-22 00:00:00
## Mode :character Median :2020-12-30 00:00:00 Median :2021-01-25 00:00:00
## Mean :2021-02-28 23:56:15 Mean :2021-03-18 05:54:42
## 3rd Qu.:2020-12-31 00:00:00 3rd Qu.:2021-02-08 00:00:00
## Max. :2021-12-15 00:00:00 Max. :2021-12-22 00:00:00
##
## Valor pago Secretaria executora do pagamento
## Min. : 500 Length:1157
## 1st Qu.: 3500 Class :character
## Median : 3600 Mode :character
## Mean : 3958
## 3rd Qu.: 3600
## Max. :30000
##
## Finalidade (especificar serviço/ação para qual\r\na verba foi destinada ex.: Compra de cesta básica; acolhimento; aquisição de EPI; Atenção Básica; Tenda COVID; Polo COVID; Folha de Pagamento; entre outros)
## Length:1157
## Class :character
## Mode :character
##
##
##
##
## Folha Pagamento SIM 1/Não 0
## Min. :0
## 1st Qu.:0
## Median :0
## Mean :0
## 3rd Qu.:0
## Max. :0
##
## duvida (1) ou não (0) perante data expressa na coluna c
## Min. :0.00000
## 1st Qu.:0.00000
## Median :0.00000
## Mean :0.04322
## 3rd Qu.:0.00000
## Max. :1.00000
## Os dados são preparados para realizar primeira plotagem e ela é efetuada.
# Transforma para formato de data a coluna abordada abaixo.
cult_compl$`Data do pagamento` <- as.Date(cult_compl$`Data do pagamento`,
format = "%y/%m/%d")
# Transforma para formato de matrix a coluna abordada abaixo.
cult_compl$`Secretaria executora do pagamento` <- as.matrix(cult_compl$`Secretaria executora do pagamento`)
# Renomeia coluna.
colnames(cult_compl)[9] <- "Finalidade"
# Cria a imagem.
imagem <- ggplot(data = cult_compl, aes(x = `Data do pagamento`, y = `Valor pago`)) +
geom_point(aes(col= Finalidade,shape = Fonte), alpha = 0.75,
size = 2.5) +
ggtitle("Comportamento temporal dos valores pagos", subtitle = "Ao considerar Finalidade e Fonte") + xlab("Data") + ylab("Valor pago em reais") + theme_bw(base_size = 10)
# Plota a imagem.
plot(imagem)
Acima percebemos que algumas finalidades distintas podem ser categorizadas como uma só.
Contatamos os stakeholders dos dados e eles confirmaram isso.
Assim, são simplificados os elementos contidos na coluna “Finalidade” para tornar o plot mais representativo.
Ainda, é desejável focalizar em dados de 2021 e que dados sejam somados caso sejam referentes a um mesmo mês, finalidade e fonte. Tal soma torna o plot mais limpo e facilita a sua interpretação.
# Cria uma categoria que engloba finalidades relacionadas com COVID.
cult_compl[,9] <- gsub("Aquisição.*", "Aquisição de insumos de higiene e EPI", cult_compl$Finalidade)
# Simplifica o nome de uma observação.
cult_compl[,9] <- gsub("Renda.*", "Renda Emerg. mens. aos trab. da cultura", cult_compl$Finalidade)
# Seleciona apenas dados a partir de 2021.
cult_compl_2021 <- cult_compl[cult_compl$`Data do pagamento` > as.Date("2021-01-01"),]
# Cria coluna que contém os meses de pagamento.
cult_compl_2021['Mes Pagamento'] <- format(cult_compl_2021$`Data do pagamento`, format="%Y-%m")
# Soma valor pago de acordo com finalidade, Mes Pagamento e fonte. Cria DF que contém esta informação.
valpag_agg <- aggregate(`Valor pago`~ Finalidade + `Mes Pagamento` + Fonte,
cult_compl_2021, sum)
# Da coluna que trata de data, mantém apenas informação de mês e passa para formato numérico.
valpag_agg[,2] <- str_sub(valpag_agg[,2], nchar(valpag_agg[,2]) - 1, nchar(valpag_agg[,2])) %>% as.numeric(.)
# Cria nova coluna que contém os valores pagos expressos por milhão de reais.
valpag_agg["val_pag_milhao_reais"] <- valpag_agg$`Valor pago`/1000000
# Cria plotagem com novo DF.
imagem_agg <- ggplot(data = valpag_agg, aes(x = `Mes Pagamento`, y = val_pag_milhao_reais)) +
geom_point(aes(col= Finalidade, shape = Fonte), alpha = 0.75,
size = 2.5) +
ggtitle("Comportamento temporal dos valores pagos") + xlab("Mês do ano de 2021") + ylab("Valor pago em milhões de reais") + theme_bw(base_size = 10) +
scale_x_continuous(breaks=seq(1, 12, 2))
# Plota a imagem. Obtemos uma plotagem muito mais clean.
plot(imagem_agg)
——————————————————————————————————
Dados da Cultura e de COVID-19.
Para além dos dados da Cultura, agora também tratamos de dados de COVID-19.
Inicialmente, dados de COVID-19 são importados
dados_covid_1 <- read.table(file = "HIST_PAINEL_COVIDBR_2021_Parte1_24mai2022.csv", header = TRUE, sep = ";", quote = "\"")
dados_covid_2 <- read.table(file = "HIST_PAINEL_COVIDBR_2021_Parte2_24mai2022.csv", header = TRUE, sep = ";", quote = "\"")Em sequência, os DFs que tratam de covid e de cultura são tratados para que possam ser fundidos.
Ao final, tal fusão é realizada.
# Condensa dados de COVID de Ribeirão Preto em um mesmo DF.
covid_tot <- rbind(dados_covid_1, dados_covid_2)
# Seleciona apenas a cidade de Ribeirão Preto.
covid_rp <- subset(covid_tot, codmun == 354340)
# Mantém apenas colunas de interesse.
covid_rp <- covid_rp[,c(8,12)]
# Mantém apenas informação de mês na coluna que aborda data. Tranforma a mesma coluna para formato numérico.
covid_rp[,1] <- str_sub(covid_rp[,1], start = 6, end = 7) %>% as.numeric(.)
# Transforma a coluna de data de interesse em caractere.
cult_compl_2021_back <- cult_compl_2021
cult_compl_2021$`Data do pagamento` <- as.character(cult_compl_2021$`Data do pagamento`)
cult_compl_2021_back$`Data do pagamento` <- as.character(cult_compl_2021_back$`Data do pagamento`)
# A coluna de data passa a ter a mesma nonemclatura entre os dois DFs.
colnames(cult_compl_2021)[6] <- "data"
# A coluna de nossa data de interesse passa a manter apenas informação de meses.
for(i in 1:nrow(cult_compl_2021)){
cult_compl_2021[i,6] <- str_sub(cult_compl_2021_back[i,6], 6,7)
}
# Transforma para numeric a coluna data, contida em cult_compl_2021.
cult_compl_2021$data <- as.numeric(cult_compl_2021$data)São formulados DFs finais para gerar a última plotagem almejada.
# Soma dados de valor pago caso apresentem mesma data, finalidade e fonte.
cult_agg <- aggregate(list(cult_compl_2021$`Valor pago`),
by = list(cult_compl_2021$data, cult_compl_2021$Fonte, cult_compl_2021$Finalidade), sum)
# Soma dados de casos novos por mês.
covid_agg <- aggregate(casosNovos ~ data, covid_rp, sum)
# Renomeia as colunas de para torná-las mais compreensíveis.
colnames(cult_agg) <- c("Mes", "Fonte", "Finalidade", "Valor Pago")
colnames(covid_agg) <- c("Mes", "Casos novos COVID-19")Vamos usar, em uma mesma plotagem, dados de Valor pago e casos de COVID. Mais precisamente, ambas são variáveis y de nossa plotagem de interesse.
Essas variáveis encontram-se em escalas distintas.
A seguir, realizamos procedimentos para solucionar esse problema e realizamos a plotagem final.
# Captamos valores próximos aos limites das duas variáveis mencionadas.
# De acordo com recomendação e naturalmente, os limites selecionados são bastante próximos aos que os dados apresentam.
ylim_val_pag <- c(0, 1118430)
ylim_casos_covid <- c(0, 8369)
# Identifica a proporção de amplitude dos limites das duas variáveis.
prop_ampl <- diff(ylim_val_pag)/diff(ylim_casos_covid)
# Cria nova imagem.
image_cult_covid_agg <- ggplot() +
geom_point(data = cult_agg, aes(col = Finalidade,shape = Fonte, x = Mes, y = `Valor Pago`), alpha = 1, size = 2.25) +
geom_line(data = covid_agg, aes(x = Mes, y = `Casos novos COVID-19`*prop_ampl), color = "pink", size = 1.25, alpha = 1) +
scale_y_continuous("Valor Pago",sec.axis = sec_axis(~ (.)/prop_ampl, name = "Casos novos COVID-19")) +
scale_x_continuous(breaks=seq(1, 12, 2)) +
ggtitle("Comportamento temporal dos Valores Pagos e de casos de COVID-19",
subtitle = "Valores Pagos são demonstrados por triângulos ou círculos; Casos de COVID-19 são expressos por linha") + xlab("Mês do ano de 2021") +
ylab("Valor pago em reais") + theme_bw(base_size = 11) +
theme(plot.subtitle=element_text(size=8.5, hjust=0))
# Plota a imagem.
image_cult_covid_agg
# Exporta a imagem final.
ggsave(file="Comportamento temporal dos valores pagos e dos casos de covid.svg", plot=image_cult_covid_agg, width=14, height=11.2)