├── bases_originais ├── ies_georref.csv ├── base_artigo_v1.xlsx ├── Dataset_Port_and_Eng.csv ├── consumo_energia_pe.xlsx ├── Dataset_Port_and_Eng.xlsx ├── consulta_cand_2022_PE.csv ├── instagram_unifafire_original.xlsx ├── 10_serie_historica_global_da_execucao_orcamentaria_do_md_ate_abril_de_2023.csv ├── disclaimers defesa br.txt └── breast-cancer.names ├── bases_tratadas ├── sinistrosRecife.rds ├── BaseResultadoFinal.rds ├── ENADE2019_PRODUCAO.csv ├── estaduais_pe_2022.csv ├── Dataset_Port_and_Eng.csv ├── instagram_unifafire.RDS ├── atas_ALEPE │ ├── 2022_05_17.docx │ ├── 2022_05_18.docx │ ├── 2022_05_24.docx │ ├── 2022_05_31.docx │ ├── 2022_06_01.docx │ ├── 2022_06_07.docx │ ├── 2022_06_08.docx │ ├── 2022_06_14.docx │ ├── 2022_06_15.docx │ ├── 2022_06_21.docx │ ├── 2022_06_22.docx │ ├── 2022_06_28.docx │ ├── 2022_06_29.docx │ ├── 2022_08_01.docx │ ├── 2022_08_02.docx │ ├── 2022_08_03.docx │ └── 2022_08_09.docx ├── clusters_municipios_pe.csv ├── orcamento_defesa_brasil.rds ├── atividade_final_metadados.csv ├── escolas_tempo_integral_v2.csv ├── clusters_municipios_pe_meta.csv ├── regras_enem.csv └── breast_cancer.csv ├── scripts ├── textos │ ├── strings basico.R │ ├── fuzzy_string_match.R │ ├── filtros_com_texto.R │ ├── carregando_textos.R │ ├── operacoes_com_texto.R │ └── mineracao_texto_basica.R ├── rmarkdown │ ├── municipios_pernambuco_files │ │ └── figure-html │ │ │ ├── unnamed-chunk-1-1.png │ │ │ ├── unnamed-chunk-2-1.png │ │ │ ├── unnamed-chunk-1-1.mb.png │ │ │ └── unnamed-chunk-2-1.mb.png │ ├── municipios_processamento.R │ ├── crosstalk_intro.Rmd │ ├── kmeans_iris.Rmd │ ├── escolas_integrais.Rmd │ ├── facebook.Rmd │ ├── escolas_integrais_animacao.Rmd │ ├── leaflet_introducao.R │ ├── widgets_DT_intro.Rmd │ └── municipios_economia.Rmd ├── introducao │ ├── objetos_e_funcoes_no_R.R │ ├── arquivos_zipados.R │ ├── escrevendo_codigos_em_R.R │ ├── pacotes.R │ └── ajustando variaveis.R ├── transformacao │ ├── descoberta.R │ ├── mudando_escalas.R │ ├── data_table.R │ ├── exemplo de analise com ENEM 2019.R │ ├── enriquecimento.R │ ├── tipos_e_fatores.R │ ├── validacao.R │ ├── dplyr.R │ ├── outliers_em_regressoes.R │ ├── limpeza.R │ ├── outliers.R │ ├── estruturacao.R │ ├── imputacao.R │ ├── mais_fatores.R │ ├── valores_ausentes_basico.R │ └── ajustes_em_regressao.R ├── dataviz │ ├── alguns gráficos.R │ ├── mapas_animados.R │ ├── intro_ggplot.R │ └── ggplot_casos_variaveis.R ├── programacao │ ├── anonimizacao.R │ ├── funcoes_com_controle.R │ ├── sequencias.R │ ├── estruturas_de_controle.R │ ├── funcoes.R │ ├── funcoes_de_repeticao.R │ ├── simulacoes_e_repeticoes_no_R.R │ ├── calculando.R │ ├── index_operadores_logicos.R │ ├── tipos_de_objetos_no_R.R │ └── amostragem_e_boostrapping.R ├── app │ ├── script modelo dissertação 2024.R │ ├── did.R │ ├── did_default.R │ ├── rdd_default.R │ ├── pareamento_educacao.R │ ├── instrumentos_educacao.R │ ├── rdd_reforco.R │ ├── its_energia.R │ ├── series_interrompidas_energia.R │ └── script_alan_its.R ├── analise │ ├── aula1_fafire.R │ ├── correlacao.R │ ├── selecao_variaveis.R │ ├── qui_quadrado.R │ ├── teste_hipotese.R │ ├── estatistica_descritiva_basica.R │ ├── associacoes_comparadas.R │ ├── regressao_basico.R │ ├── box_cox.R │ ├── regressao_avancado - Copia.R │ ├── aed_instagram_fafire.R │ └── regressao_avancado.R ├── machine_learning │ ├── not_used.R │ ├── agrupamento_kmeans_iris.R │ ├── ml_insta_fafire.R │ ├── regressao_metricas.R │ ├── agrupamento_kmeans_facebook.R │ ├── balanceamento_bases.R │ ├── regras_associaco_enem.R │ ├── regressao_ENEM.R │ ├── regras_associacao_ENEM.R │ ├── arvores_decisao_introducao.R │ ├── classificacao_metricas.R │ ├── arvores_decisao_ENEM.R │ ├── regressao_ENADE.R │ ├── aprendizagem_custo.R │ ├── regras_associacao_TSE.R │ ├── regressao_com_cv_salaries.R │ ├── classificacao_com_cv_ENEM.R │ ├── ia_explicavel.R │ └── regressao_com_cv_ENEM.R ├── etl │ ├── small_medium_data.R │ ├── extracao.R │ ├── large_data_ff.R │ ├── leitura.R │ ├── large_data_polars.R │ ├── etl_instagram.R │ ├── instalacoes_pcts_bd.R │ ├── large_data_spark.R │ ├── large_data_arrow.R │ ├── extracao_com_scraping.R │ ├── extracoes_basicas.R │ ├── carga_incremental.R │ ├── etl_real.R │ ├── etl_real_defesa_br.R │ ├── large_data_criacao.R │ └── large_data.R ├── atividades │ └── exercicio1.R └── datas │ ├── intro_datas_tempos.R │ └── datas_na_pratica.R ├── cp_com_r.Rproj ├── .gitignore └── README.md /bases_originais/ies_georref.csv: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_originais/ies_georref.csv -------------------------------------------------------------------------------- /bases_originais/base_artigo_v1.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_originais/base_artigo_v1.xlsx -------------------------------------------------------------------------------- /bases_tratadas/sinistrosRecife.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/sinistrosRecife.rds -------------------------------------------------------------------------------- /bases_tratadas/BaseResultadoFinal.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/BaseResultadoFinal.rds -------------------------------------------------------------------------------- /bases_tratadas/ENADE2019_PRODUCAO.csv: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/ENADE2019_PRODUCAO.csv -------------------------------------------------------------------------------- /bases_tratadas/estaduais_pe_2022.csv: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/estaduais_pe_2022.csv -------------------------------------------------------------------------------- /bases_originais/Dataset_Port_and_Eng.csv: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_originais/Dataset_Port_and_Eng.csv -------------------------------------------------------------------------------- /bases_originais/consumo_energia_pe.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_originais/consumo_energia_pe.xlsx -------------------------------------------------------------------------------- /bases_tratadas/Dataset_Port_and_Eng.csv: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/Dataset_Port_and_Eng.csv -------------------------------------------------------------------------------- /bases_tratadas/instagram_unifafire.RDS: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/instagram_unifafire.RDS -------------------------------------------------------------------------------- /scripts/textos/strings basico.R: -------------------------------------------------------------------------------- 1 | exString1 <- "EAG 6/1996 => PEC 33/1995" 2 | 3 | sub(" =>.*", "", exString1) 4 | 5 | sub(".*=> ", "", exString1) 6 | -------------------------------------------------------------------------------- /bases_originais/Dataset_Port_and_Eng.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_originais/Dataset_Port_and_Eng.xlsx -------------------------------------------------------------------------------- /bases_originais/consulta_cand_2022_PE.csv: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_originais/consulta_cand_2022_PE.csv -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_05_17.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_05_17.docx -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_05_18.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_05_18.docx -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_05_24.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_05_24.docx -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_05_31.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_05_31.docx -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_06_01.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_06_01.docx -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_06_07.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_06_07.docx -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_06_08.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_06_08.docx -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_06_14.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_06_14.docx -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_06_15.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_06_15.docx -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_06_21.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_06_21.docx -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_06_22.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_06_22.docx -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_06_28.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_06_28.docx -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_06_29.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_06_29.docx -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_08_01.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_08_01.docx -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_08_02.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_08_02.docx -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_08_03.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_08_03.docx -------------------------------------------------------------------------------- /bases_tratadas/atas_ALEPE/2022_08_09.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atas_ALEPE/2022_08_09.docx -------------------------------------------------------------------------------- /bases_tratadas/clusters_municipios_pe.csv: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/clusters_municipios_pe.csv -------------------------------------------------------------------------------- /bases_tratadas/orcamento_defesa_brasil.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/orcamento_defesa_brasil.rds -------------------------------------------------------------------------------- /bases_tratadas/atividade_final_metadados.csv: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/atividade_final_metadados.csv -------------------------------------------------------------------------------- /bases_tratadas/escolas_tempo_integral_v2.csv: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/escolas_tempo_integral_v2.csv -------------------------------------------------------------------------------- /bases_tratadas/clusters_municipios_pe_meta.csv: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_tratadas/clusters_municipios_pe_meta.csv -------------------------------------------------------------------------------- /bases_originais/instagram_unifafire_original.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_originais/instagram_unifafire_original.xlsx -------------------------------------------------------------------------------- /scripts/rmarkdown/municipios_pernambuco_files/figure-html/unnamed-chunk-1-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/scripts/rmarkdown/municipios_pernambuco_files/figure-html/unnamed-chunk-1-1.png -------------------------------------------------------------------------------- /scripts/rmarkdown/municipios_pernambuco_files/figure-html/unnamed-chunk-2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/scripts/rmarkdown/municipios_pernambuco_files/figure-html/unnamed-chunk-2-1.png -------------------------------------------------------------------------------- /scripts/rmarkdown/municipios_pernambuco_files/figure-html/unnamed-chunk-1-1.mb.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/scripts/rmarkdown/municipios_pernambuco_files/figure-html/unnamed-chunk-1-1.mb.png -------------------------------------------------------------------------------- /scripts/rmarkdown/municipios_pernambuco_files/figure-html/unnamed-chunk-2-1.mb.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/scripts/rmarkdown/municipios_pernambuco_files/figure-html/unnamed-chunk-2-1.mb.png -------------------------------------------------------------------------------- /bases_originais/10_serie_historica_global_da_execucao_orcamentaria_do_md_ate_abril_de_2023.csv: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/HEAD/bases_originais/10_serie_historica_global_da_execucao_orcamentaria_do_md_ate_abril_de_2023.csv -------------------------------------------------------------------------------- /cp_com_r.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | -------------------------------------------------------------------------------- /scripts/introducao/objetos_e_funcoes_no_R.R: -------------------------------------------------------------------------------- 1 | # criando objetos e funções no R 2 | 3 | vetor <- c(1, 2, 3, 5, 7) # criação de um vetor 4 | 5 | str(vetor) # estrutura do vetor 6 | 7 | regCarros <- lm(mpg ~ ., mtcars) # criação de um modelo de regressão 8 | 9 | str(regCarros) # estrutura da regressão 10 | -------------------------------------------------------------------------------- /scripts/transformacao/descoberta.R: -------------------------------------------------------------------------------- 1 | pacman::p_load(funModeling, tidyverse) 2 | 3 | glimpse(iris) # olhada nos dados 4 | status(iris) # estrutura dos dados (missing etc) 5 | freq(iris) # frequência das variáveis fator 6 | plot_num(iris) # exploração das variáveis numéricas 7 | profiling_num(iris) # estatísticas das variáveis numéricas 8 | -------------------------------------------------------------------------------- /scripts/introducao/arquivos_zipados.R: -------------------------------------------------------------------------------- 1 | download.file(url = "https://download.inep.gov.br/microdados/microdados_saeb_2021_educacao_infantil.zip", destfile = "bases_originais/microdados_saeb_2021_educacao_infantil.zip") # arquivo de destino (incluindo em qual pasta deve fazer o download) 2 | saeb_2021_csv <- unzip("bases_originais/microdados_saeb_2021_educacao_infantil.zip", exdir = "bases_originais") -------------------------------------------------------------------------------- /scripts/textos/fuzzy_string_match.R: -------------------------------------------------------------------------------- 1 | library(fuzzyjoin) 2 | 3 | # Exemplo universidade de princeton 4 | baseA <- read.csv("http://www.princeton.edu/~otorres/sandp500.csv") 5 | baseB <- read.csv("http://www.princeton.edu/~otorres/nyse.csv") 6 | 7 | # Advanced 8 | baseC <- fuzzyjoin::stringdist_join(baseA, baseB, mode='left') 9 | baseC <- fuzzyjoin::distance_join(baseA, baseB, mode='left') 10 | -------------------------------------------------------------------------------- /scripts/transformacao/mudando_escalas.R: -------------------------------------------------------------------------------- 1 | # mudando escalas 2 | carsNovo <- cars # copiando a base de dados nativa para um novo objeto 3 | carsNovo$distSqrt <- sqrt(carsNovo$dist) # criando variável com raiz quadrada 4 | carsNovo$distNorm <- scale(carsNovo$dist) # criando variável normalizada 5 | carsNovo$distScale <- (carsNovo$dist-min(carsNovo$dist))/(max(carsNovo$dist) - min(carsNovo$dist)) # criano variável padronizada 6 | carsNovo$distLog <- log10(carsNovo$dist) # criano variável com log 7 | plot_num(carsNovo) -------------------------------------------------------------------------------- /scripts/introducao/escrevendo_codigos_em_R.R: -------------------------------------------------------------------------------- 1 | # boas práticas de codificação em R 2 | 3 | # atribuição 4 | 5 | x <- 5 # boa 6 | x = 5 # ruim. pode confundir com comparação == 7 | 5 -> x # ruim. o valor bem antes do objeto 8 | 9 | # nomes de objetos e variaveis 10 | 11 | eleicoes_2020 # bom. separação com _ 12 | 13 | eleicoesAno2020 # bom. separação com CamelCase 14 | 15 | ele_20 # ruim. abrevia e depois pode ser difícil para entender 16 | 17 | eleicoes.2020 # ruim. o ponto não é um bom separador 18 | -------------------------------------------------------------------------------- /scripts/dataviz/alguns gráficos.R: -------------------------------------------------------------------------------- 1 | pacman::p_load(corrplot, ggplot2, grid, gridExtra) 2 | 3 | g1 <- ggplot(iris, aes(x=Sepal.Length, y=Sepal.Width)) + geom_point() + geom_smooth(method=lm, se=FALSE) 4 | 5 | g2 <- ggplot(iris, aes(x=Petal.Length, y=Sepal.Width)) + geom_point() + geom_smooth(method=lm, se=FALSE) 6 | 7 | g3 <- ggplot(iris, aes(x=Petal.Length, y=Sepal.Length)) + geom_point() + geom_smooth(method=lm, se=FALSE) 8 | 9 | grid.arrange(g1, g2, g3, nrow = 1, ncol = 3) 10 | 11 | corrplot(cor(mtcars)) 12 | -------------------------------------------------------------------------------- /scripts/programacao/anonimizacao.R: -------------------------------------------------------------------------------- 1 | pacman::p_load(data.table, digest) 2 | 3 | ps_nomes <- read.csv2("G:/Meu Drive/ps_nomes.csv", encoding = 'Latin-1') 4 | View(ps_nomes) 5 | 6 | cols_to_mask <- c("nome") 7 | 8 | anonymize <- function(x, algo="crc32") { 9 | sapply(x, function(y) if(y == "" | is.na(y)) "" else digest(y, algo = algo)) 10 | } 11 | 12 | setDT(ps_nomes) 13 | ps_nomes[, (cols_to_mask) := lapply(.SD, anonymize), .SDcols = cols_to_mask] 14 | 15 | data.table::fwrite(ps_nomes,"ps_nomes.csv", sep = ";") 16 | -------------------------------------------------------------------------------- /scripts/app/script modelo dissertação 2024.R: -------------------------------------------------------------------------------- 1 | library(readxl) 2 | 3 | # Dados 4 | df <- read_excel("C:/Users/matoso.alan/Downloads/alan_df-1.xlsx") 5 | 6 | # modelos 7 | names(df) 8 | 9 | m1 <- lm(taxa_paulista ~ tempo + nivel + trend, data = df) 10 | summary(m1) 11 | plot(df$ano,df$taxa_paulista) 12 | m2 <- lm(taxa_cariacica ~ tempo + nivel + trend, data = df) 13 | summary(m2) 14 | plot(df$ano,df$taxa_cariacica) 15 | m3 <- lm(taxa_sao_jose ~ tempo + nivel + trend, data = df) 16 | summary(m3) 17 | plot(df$ano,df$taxa_sao_jose) 18 | m4 -------------------------------------------------------------------------------- /scripts/analise/aula1_fafire.R: -------------------------------------------------------------------------------- 1 | install.packages('pacman') 2 | 3 | pacman::p_load( 4 | # ETL 5 | data.table, 6 | dplyr, 7 | # ANÁLISE 8 | corrplot, 9 | dataMaid 10 | ) 11 | 12 | enem_pe_2019 <- fread( 13 | 'https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/master/bases_tratadas/ENEM_ESCOLA_2019.csv', 14 | stringsAsFactors = T, 15 | dec = ",") 16 | 17 | enem_pe_2019 %>% str() 18 | enem_pe_2019 %>% names() 19 | 20 | enem_pe_2019 %>% makeDataReport( 21 | output = "html", 22 | replace = TRUE) 23 | -------------------------------------------------------------------------------- /scripts/textos/filtros_com_texto.R: -------------------------------------------------------------------------------- 1 | library(electionsBR) 2 | library(dplyr) 3 | library(tidyr) 4 | 5 | tse20 <- vote_mun_zone_local(year = 2020) 6 | 7 | partidos_bolsonaro <- c("AVANTE", 'DC', "DEM", 'MDB', 'NOVO', 'PATRI', 'PL', 'PODE', 'PP', 'PROS', 'PRTB', 'PSC', 'PSD', 'PSDB', 'PSL', 'PTB', 'SD') 8 | 9 | tse20A1 <- tse20 %>% filter(DESCRICAO_CARGO == 'Prefeito' & NUM_TURNO == 1) 10 | 11 | tse20A1 <- tse20A1 %>% mutate(tag_partido = ifelse(grepl(paste(partidos_bolsonaro, collapse="|"), COMPOSICAO_LEGENDA), 'bolso_t1', 'nao_bolso_t1')) 12 | 13 | -------------------------------------------------------------------------------- /scripts/introducao/pacotes.R: -------------------------------------------------------------------------------- 1 | # trabalhando com pacotes 2 | 3 | # instala o pacote caret (machine learning) 4 | install.packages("caret") 5 | 6 | # carrega o pacote caret 7 | library(caret) 8 | featurePlot(x = iris[, 1:4], y = iris$Species) 9 | 10 | # carga temporária 11 | caret::featurePlot(x = iris[, 1:4], y = iris$Species) # plot das variáveis do conjunto de dados iris, usando o pacote caret 12 | 13 | # pacman 14 | install.packages('pacman') 15 | 16 | pacman::p_load(caret, VIM) # carrega se o pacote estiver instalado. Se não estiver, instala. 17 | -------------------------------------------------------------------------------- /scripts/programacao/funcoes_com_controle.R: -------------------------------------------------------------------------------- 1 | # função com estrutura de repetição 2 | hello_word_rep <- function(nro) { 3 | for(i in 1:nro) { 4 | cat("Hello, world!\n") 5 | } 6 | } 7 | hello_word_rep(3) 8 | 9 | formals(hello_word_rep) 10 | body(hello_word_rep) 11 | environment(hello_word_rep) 12 | 13 | # função com estrutura condicional e de repetição 14 | f <- function(nro) { 15 | if(nro < 10) { 16 | for(i in 1:nro) { 17 | cat("Hello, world!\n") 18 | } 19 | } else { 20 | cat("Tá de brincadeira imprimir isso tudo") 21 | } 22 | } 23 | f(9) 24 | f(10) -------------------------------------------------------------------------------- /scripts/app/did.R: -------------------------------------------------------------------------------- 1 | # Instale os pacotes necessários, caso ainda não tenha feito 2 | install.packages("did") 3 | install.packages("readxl") 4 | install.packages("tidyverse") 5 | 6 | # Carregue os pacotes 7 | library(did) 8 | library(readxl) 9 | library(tidyverse) 10 | 11 | data(mpdta) 12 | 13 | mpdta %>% 14 | distinct(countyreal, first.treat) %>% 15 | count(first.treat) 16 | 17 | out <- att_gt( 18 | yname = "lemp", 19 | gname = "first.treat", 20 | idname = "countyreal", 21 | tname = "year", 22 | xformla = ~1, 23 | data = mpdta 24 | ) 25 | 26 | summary(out) 27 | 28 | ggdid(out) 29 | -------------------------------------------------------------------------------- /scripts/app/did_default.R: -------------------------------------------------------------------------------- 1 | # Instale os pacotes necessários, caso ainda não tenha feito 2 | install.packages("did") 3 | install.packages("readxl") 4 | install.packages("tidyverse") 5 | 6 | # Carregue os pacotes 7 | library(did) 8 | library(readxl) 9 | library(tidyverse) 10 | 11 | data(mpdta) 12 | 13 | mpdta %>% 14 | distinct(countyreal, first.treat) %>% 15 | count(first.treat) 16 | 17 | out <- att_gt( 18 | yname = "lemp", 19 | gname = "first.treat", 20 | idname = "countyreal", 21 | tname = "year", 22 | xformla = ~1, 23 | data = mpdta 24 | ) 25 | 26 | summary(out) 27 | 28 | ggdid(out) 29 | -------------------------------------------------------------------------------- /scripts/programacao/sequencias.R: -------------------------------------------------------------------------------- 1 | pacman::p_load(corrplot, tidyverse) 2 | 3 | # instruções para criar o gráfico de correlações da base de dados iris 4 | 5 | # criando objetos 6 | iris2 <- iris[ , -5] # retirar a coluna Species (fator) 7 | irisCor <- cor(iris2) 8 | corrplot(irisCor, method = 'circle') 9 | 10 | # funções aninhadas 11 | corrplot(cor(iris[, -5]), method = 'square') 12 | 13 | # pipe antigo %>% 14 | iris %>% select(-Species) %>% cor() %>% corrplot(method = 'ellipse') 15 | 16 | # pipe novo |> 17 | iris |> select(-Species) |> cor() |> corrplot(method = 'shade') 18 | 19 | # ctrl + shift + m %>% -------------------------------------------------------------------------------- /scripts/machine_learning/not_used.R: -------------------------------------------------------------------------------- 1 | # regressão com cv - códigos não usados 2 | # Bagging para Classificação 3 | IRIS_RF = randomForest(iris[ , 1:4], iris[ , 5], ntree = 100, keep.forest=T, keep.inbag = TRUE, importance=T) # floresta aleatória 4 | 5 | plot(IRIS_RF) 6 | 7 | varImp(IRIS_RF, scale = T) # importância de cada variável 8 | varImpPlot(IRIS_RF, type=2) # importância de cada variável 9 | 10 | ENEM_RF = randomForest(treinoENEM[ , c(3, 8, 12)], treinoENEM[ , 4], ntree = 100, keep.forest=T, keep.inbag = TRUE, importance=T) # floresta aleatória 11 | 12 | # varImpPlot(ENEM_RF, type=2) # importância de cada variável -------------------------------------------------------------------------------- /scripts/analise/correlacao.R: -------------------------------------------------------------------------------- 1 | ## CORRELAÇÃO COM R ## 2 | # PRIMEIRO, VAMOS CARREGAR OS PACOTES 3 | pacman::p_load(corrplot, dplyr, ggplot2) 4 | 5 | # BASE DE DADOS IRIS SEM AS ESPÉCIES # 6 | iris2 <- iris %>% select(Species) 7 | 8 | # TABELA DE CORRELAÇÃO COM TODAS AS VARIÁVEIS # 9 | cor(iris2) 10 | 11 | # GRÁFICOS DE DISPERSÃO PAREADOS DAS VARIÁVEIS # 12 | pairs(iris2) 13 | 14 | # CORRPLOT DAS VARIÁVEIS # 15 | irisCor <- cor(iris2) # Tabela de correlações 16 | corrplot(irisCor, method = "number", order = 'alphabet') 17 | corrplot(irisCor, order = 'alphabet') 18 | corrplot(irisCor, method = "square", order = 'AOE') 19 | -------------------------------------------------------------------------------- /scripts/analise/selecao_variaveis.R: -------------------------------------------------------------------------------- 1 | subsets <- c(1:13) 2 | ctrl <- rfeControl(functions = lmFuncs, 3 | method = "repeatedcv", 4 | repeats = 5, 5 | verbose = FALSE) 6 | 7 | lmProfile <- rfe(ENEM_ESCOLA[, 2:14], ENEM_ESCOLA[, 1], 8 | sizes = subsets, 9 | rfeControl = ctrl) 10 | lmProfile 11 | predictors(lmProfile) 12 | 13 | 14 | # regressão com caret 15 | train.control <- trainControl(method = "cv", number = 10, verboseIter = T) # controle de treino 16 | regENEMCV <- train(nota ~ ., data = ENEM_ESCOLA, method = "lm", trControl = train.control) 17 | summary(regENEMCV) 18 | 19 | regENEMCV$finalModel -------------------------------------------------------------------------------- /scripts/transformacao/data_table.R: -------------------------------------------------------------------------------- 1 | library(data.table) 2 | library(dplyr) 3 | 4 | irisDT <- iris %>% setDT() 5 | class(irisDT) 6 | 7 | irisDT[species == 'setosa', ] # i, j, by 8 | 9 | irisDT[species != 'setosa', ] 10 | 11 | irisDT[Sepal.Length > 5 & species == 'setosa', ] 12 | 13 | irisDT[.N] 14 | 15 | irisDT[(.N-3)] 16 | 17 | irisDT[ , Species] 18 | 19 | cols <- c("Species", "Petal.Width") 20 | irisDT[ , ..cols] 21 | 22 | irisDT[Species == 'setosa', ][Sepal.Length > 5, ] 23 | 24 | irisDT[ , .(Sepal.Length = mean(Sepal.Length, na.rm = T))] 25 | 26 | irisDT[ , lm(formula = Sepal.Length ~ species + Sepal.Width + Petal.Length + Petal.Width)] 27 | 28 | irisDT[ , .(Sepal.Length = mean(Sepal.Length, na.rm = T)), by = species] 29 | -------------------------------------------------------------------------------- /scripts/transformacao/exemplo de analise com ENEM 2019.R: -------------------------------------------------------------------------------- 1 | ##### Análise ENEM 2 | 3 | library("caret") # carregar pacote 4 | 5 | ENEM2019 <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/cd_com_r/master/bases_tratadas/ENEM_ESCOLA_2019.csv') 6 | 7 | View(ENEM2019) 8 | 9 | ENEM2019 <- read.csv2('bases_tratadas/ENEM_ESCOLA_2019.csv') 10 | 11 | View(ENEM2019) 12 | 13 | featurePlot(x = ENEM2019[ , c(4, 5, 9)], y = ENEM2019$tipo) 14 | 15 | summary(ENEM2019) 16 | str(ENEM2019) 17 | 18 | ENEM2019$tipo <- as.factor(ENEM2019$tipo) 19 | 20 | featurePlot(x = ENEM2019[ , c(4)], y = ENEM2019$tipo) 21 | 22 | featurePlot(x = ENEM2019[ , c(5)], y = ENEM2019$tipo) 23 | 24 | featurePlot(x = ENEM2019[ , c(9)], y = ENEM2019$tipo) 25 | -------------------------------------------------------------------------------- /scripts/machine_learning/agrupamento_kmeans_iris.R: -------------------------------------------------------------------------------- 1 | # carregar as bibliotecas 2 | pacman::p_load(cluster, dplyr, factoextra, ggplot2) 3 | 4 | # pré-processamento 5 | iris_cluster <- iris[ , -5] 6 | str(iris_cluster) 7 | 8 | # definir semente aleatória 9 | set.seed(1) 10 | 11 | # Método do Cotovelo 12 | fviz_nbclust(iris_cluster, kmeans, method = "wss") 13 | 14 | # Agrupamento com kmeans 15 | cls <- kmeans(x = iris_cluster, centers = 3) # aprendizagem ns 16 | iris_cluster$cluster <- as.factor(cls$cluster) # passamos os clusters para a base original 17 | head(iris_cluster) 18 | 19 | # plot com função própria do pacote 20 | clusplot(iris_cluster, cls$cluster, xlab = 'Fator1', ylab = 'Fator2', main = 'Agrupamento Estudantes', lines = 0, shade = F, color = TRUE, labels = 2) 21 | -------------------------------------------------------------------------------- /scripts/etl/small_medium_data.R: -------------------------------------------------------------------------------- 1 | library(data.table) 2 | 3 | enderecoBase <- 'bases_originais/largeData.csv' 4 | 5 | # extração direta via read.csv 6 | system.time(extracaoLD1 <- read.csv2(enderecoBase)) 7 | 8 | # extração via amostragem com read.csv 9 | 10 | # ler apenas as primeiras 20 linhas 11 | amostraLD1 <- read.csv2(enderecoBase, nrows=20) 12 | 13 | amostraLD1Classes <- sapply(amostraLD1, class) # encontra a classe da amostra amostra 14 | 15 | # fazemos a leitura passando as classes de antemão, a partir da amostra 16 | system.time(extracaoLD2 <- data.frame(read.csv2("bases_originais/largeData.csv", colClasses=amostraLD1Classes) ) ) 17 | 18 | # extração via função fread, que já faz amostragem automaticamente 19 | system.time(extracaoLD3 <- fread(enderecoBase)) 20 | -------------------------------------------------------------------------------- /scripts/app/rdd_default.R: -------------------------------------------------------------------------------- 1 | #### pacotes ---- 2 | pacman::p_load( 3 | rdd, 4 | tidyverse) 5 | 6 | summary(RDestimate(score2 ~ time2, group2, cutpoint = 10.5)) 7 | 8 | plot(RDestimate(score2 ~ time2, group2, cutpoint = 10.5)) 9 | 10 | IKbandwidth(group2$time2, group2$score2, cutpoint = 10.5) 11 | 12 | group2_maior <- subset(group2, group2$time2 >= 10.5 & 13 | group2$time2 <= 10.5 + 14 | IKbandwidth(group2$time2, group2$score2, cutpoint = 10.5)) 15 | group2_menor <- subset(group2, group2$time2 < 10.5 & 16 | group2$time2 >= 10.5 - 17 | IKbandwidth(group2$time2, group2$score2, cutpoint = 10.5)) 18 | 19 | lm(score2 ~ I(time2 - 10.5), data = group2_maior) 20 | 21 | lm(score2 ~ I(time2 - 10.5), data = group2_menor) 22 | -------------------------------------------------------------------------------- /scripts/transformacao/enriquecimento.R: -------------------------------------------------------------------------------- 1 | #### CARREGANDO PACOTES #### 2 | pacman::p_load(dplyr, tidyverse) 3 | 4 | #### LENDO AS BASES PARA O R #### 5 | # opção para quem baixou a base 6 | baseCodMun <- read.table('bases_originais/base_codigos_mun.txt', sep = ',', header = T, encoding = 'UTF-8') 7 | 8 | campusIES <- read.csv2('bases_originais/ies_georref.csv') 9 | 10 | # opção para pegar as bases diretamente do github 11 | baseCodMun <- read.table('https://raw.githubusercontent.com/hugoavmedeiros/cp_com_r/master/bases_originais/base_codigos_mun.txt', sep = ',', header = T, encoding = 'UTF-8') 12 | 13 | campusIES <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/cp_com_r/master/bases_originais/ies_georref.csv') 14 | 15 | campusIES <- left_join(campusIES, baseCodMun, by = c('CO_MUNICIPIO' = 'id_munic_7')) 16 | -------------------------------------------------------------------------------- /bases_originais/disclaimers defesa br.txt: -------------------------------------------------------------------------------- 1 | Observacoes: 2 | a) valores em milhoes de reais 3 | b) os valores de 2000 a 2023 referem-se a valores correntes empenhados (sem correcao monetaria). 4 | c) valores de 2023: ate o mes de abril de 2023. 5 | d) Excluido grupo de despesa 9 - reserva de contingencia 6 | e) Nao inclui Acoes 0Z00 - Reserva de Contingencia - Financeira e 0Z01 Reserva de Contingencia Fiscal - Primaria 7 | UNIDADES ORCAMENTARIAS VINCULADAS A ADMINISTRACAO DIRETA DO MINISTERIO DA DEFESA: 52101, 52901, 52902 e 52903. 8 | UNIDADES ORCAMENTARIAS VINCULADAS AO COMANDO DA MARINHA: 52131, 52133, 52232, 52233, 52931 e 52932. 9 | UNIDADES ORCAMENTARIAS VINCULADAS AO COMANDO DO EXERCITO: 52121, 52221, 52222 e 52921. 10 | UNIDADES ORCAMENTARIAS VINCULADAS AO COMANDO DA AERONAUTICA: 52111, 52211 e 52911. 11 | Fonte: SIAFI. 12 | -------------------------------------------------------------------------------- /scripts/transformacao/tipos_e_fatores.R: -------------------------------------------------------------------------------- 1 | # Códigos do livro An Introduction to data cleaning with R 2 | 3 | class(c("abc", "def")) 4 | class(1:10) 5 | class(c(pi, exp(1))) 6 | class(factor(c("abc", "def"))) 7 | 8 | vrNumeric <- c("7", "7*", "7.0", "7,0") 9 | is.numeric(vrNumeric) 10 | as.numeric(vrNumeric) 11 | as.integer(vrNumeric) 12 | as.character(vrNumeric) 13 | 14 | is.na(as.numeric(vrNumeric)) 15 | 16 | vrFactor <- factor(c("a", "b", "a", "a", "c")) 17 | levels(vrFactor) 18 | 19 | gender <- c(2, 1, 1, 2, 0, 1, 1) 20 | recode <- c(male = 1, female = 2) 21 | (gender <- factor(gender, levels = recode, labels = names(recode))) 22 | 23 | (gender <- relevel(gender, ref = "female")) 24 | 25 | age <- c(27, 52, 65, 34, 89, 45, 68) 26 | (gender <- reorder(gender, age)) 27 | 28 | attr(gender, "scores") <- NULL 29 | gender 30 | -------------------------------------------------------------------------------- /scripts/rmarkdown/municipios_processamento.R: -------------------------------------------------------------------------------- 1 | # pacotes 2 | pacman::p_load(data.table, dplyr) 3 | 4 | # funções 5 | padroniza <- function(x) { 6 | x <- (x - min(x)) / (max(x) - min(x)) 7 | return(x) 8 | } 9 | 10 | # ETL 11 | mun_pe <- fread('https://raw.githubusercontent.com/hugoavmedeiros/cp_com_r/master/bases_tratadas/clusters_municipios_pe.csv', encoding = 'Latin-1', dec = ',') 12 | 13 | mun_pe <- mun_pe %>% mutate(across(c(rd, municipio), factor)) 14 | mun_pe <- mun_pe %>% mutate(across(c(pib, vab), as.numeric)) 15 | 16 | # mun_pe <- read.csv2('bases_tratadas/clusters_municipios_pe.csv') 17 | 18 | mun_pe_meta <- fread('https://raw.githubusercontent.com/hugoavmedeiros/cp_com_r/master/bases_tratadas/clusters_municipios_pe_meta.csv', encoding = 'Latin-1') 19 | 20 | # mun_pe_meta <- read.csv2('bases_tratadas/clusters_municipios_pe_meta.csv') 21 | -------------------------------------------------------------------------------- /scripts/etl/extracao.R: -------------------------------------------------------------------------------- 1 | #### Staging area e uso de memória 2 | 3 | # ficamos com staging area?? 4 | 5 | ls() # lista todos os objetos no R 6 | 7 | # vamos ver quanto cada objeto está ocupando 8 | 9 | for (itm in ls()) { 10 | print(formatC(c(itm, object.size(get(itm))), 11 | format="d", 12 | width=30), 13 | quote=F) 14 | } 15 | 16 | ls() # lista todos os objetos no R 17 | 18 | # agora, vamos remover 19 | 20 | gc() # uso explícito do garbage collector 21 | 22 | rm(list = c('sinistrosRecife2020Raw', 'sinistrosRecife2021Raw')) 23 | 24 | # deletando todos os elementos: rm(list = ls()) 25 | # deletando todos os elementos, menos os listados: rm(list=(ls()[ls()!="sinistrosRecifeRaw"])) 26 | 27 | saveRDS(sinistrosRecifeRaw, "bases_tratadas/sinistrosRecife.rds") 28 | 29 | write.csv2(sinistrosRecifeRaw, "bases_tratadas/sinistrosRecife.csv") 30 | 31 | -------------------------------------------------------------------------------- /scripts/programacao/estruturas_de_controle.R: -------------------------------------------------------------------------------- 1 | #estrutura condicional 2 | 3 | x <- runif(1, 0, 5) 4 | x 5 | 6 | if(x > 3) { 7 | y <- 5 8 | } else { 9 | y <- 0 10 | } 11 | y 12 | 13 | # avaliação condicional simples 14 | irisCopia$SpeciesDummy <- ifelse(irisCopia$Species == 'setosa', 1, 0) 15 | 16 | # estrutura de repetição 17 | par(mfrow = c(2, 2)) # prepara a tela de gráficos como uma matriz 2x2 para receber os 4 gráficos gerados abaixo 18 | 19 | for (i in 1:4) { # cria o loop, que deve ir de 1 a 4 20 | x <- iris[ , i] # atribui as colunas da base de dados a uma variável temporária 21 | hist(x, 22 | main = paste("Variável", i, names(iris)[i]), # atribui o nome ao gráfico de forma incremental, passando coluna por coluna 23 | xlab = "Valores da Variável", # rótulo do eixo x 24 | xlim = c(0, 10)) # limite mínimo e máximo do eixo x 25 | } 26 | 27 | lapply(iris[, 1:4], hist) 28 | -------------------------------------------------------------------------------- /scripts/introducao/ajustando variaveis.R: -------------------------------------------------------------------------------- 1 | pacman::p_load(dplyr, ggplot2, data.table, gridExtra) 2 | 3 | # carregar dados covid19 Pernambuco 4 | covid19PE <- fread('https://dados.seplag.pe.gov.br/apps/basegeral.csv') 5 | 6 | # agrupar casos por município ajustando variáveis 7 | covid19PEMun <- covid19PE %>% count(municipio, sort = T, name = 'casos') %>% mutate(casos2 = sqrt(casos), casosLog = log10(casos)) 8 | 9 | # criar loop para os diferentes gráficoss 10 | nomeVar <- names(covid19PEMun)[2:4] # passar nomes das vars para vetor 11 | listaPlots <- NULL 12 | 13 | for(i in nomeVar) { 14 | plot <- covid19PEMun %>% ggplot(aes_string(x = 'municipio', y=i)) + geom_bar(stat = "identity") + labs(x = "Município") 15 | listaPlots[[length(listaPlots) + 1]] <- plot 16 | } # criar lista com os plots 17 | 18 | # printar todos os plots, lado a lado 19 | grid.arrange(listaPlots[[1]], listaPlots[[2]], listaPlots[[3]], ncol=3) 20 | 21 | 22 | -------------------------------------------------------------------------------- /scripts/transformacao/validacao.R: -------------------------------------------------------------------------------- 1 | pacman::p_load(data.table, dplyr, tidyverse, validate) 2 | 3 | general_data <- fread("https://covid.ourworldindata.org/data/owid-covid-data.csv") # carrega dados de covid19 no mundo 4 | 5 | latin_america_countries <-c("Argentina", "Brazil", "Bolivia", "Chile", "Colombia", "Costa Rica", "Cuba", "Dominican Republic", "Ecuador", "El Salvador", "Guatemala", "Haiti", "Honduras", "Mexico", "Nicaragua", "Panama", "Paraguay", "Peru", "Uruguay", "Venezuela") # vetor que identifica países latino americanos 6 | 7 | latin_america <- general_data %>% filter(location %in% latin_america_countries) # filtra casos apenas no vetor 8 | 9 | latin_america <- latin_america %>% select(location, new_cases, new_deaths) 10 | 11 | regras_latin_america <- validator(new_cases >= 0, new_deaths >= 0) 12 | 13 | validacao_latin_america <- confront(latin_america, regras_latin_america) 14 | 15 | summary(validacao_latin_america) 16 | 17 | plot(validacao_latin_america) 18 | -------------------------------------------------------------------------------- /scripts/etl/large_data_ff.R: -------------------------------------------------------------------------------- 1 | ##### ARMAZENAMENTO EM DISCO ##### 2 | #### FF #### 3 | pacman::p_load(biglm, devtools, dplyr, ff, ffbase) 4 | 5 | enderecoBase <- 'bases_originais/large data/largeData.csv' 6 | 7 | # criando o arquivo ff 8 | tempo_ff <- system.time(base_ff <- read.csv.ffdf(file=enderecoBase)) 9 | 10 | tempo_ff 11 | 12 | base_ff %>% head() 13 | 14 | base_ff %>% typeof() # veja a classe do objeto 15 | 16 | base_ff %>% class() # veja a classe do objeto 17 | 18 | base_ff %>% object.size() # a vantagem está no tamanho! 19 | 20 | sum(base_ff[,3]) # algumas operações são possíveis diretamente 21 | 22 | # REGRESSÂO # 23 | 24 | lm(c ~ ., base_ff) ## não vai rodar!!!! o vetor de computação será mt grande 25 | 26 | # mas pode ser feita com amostragem 27 | base_ffAmostra <- base_ff[sample(nrow(base_ff), 100000) , ] 28 | 29 | lm(c ~ ., base_ffAmostra) # aí, funciona!!! 30 | 31 | # ou com funções otimizadas 32 | modelo <- biglm(a ~ b + c, data = base_ff) 33 | 34 | summary(modelo) -------------------------------------------------------------------------------- /scripts/analise/qui_quadrado.R: -------------------------------------------------------------------------------- 1 | ## QUI-QUADRADO COM R ## 2 | # PRIMEIRO, VAMOS CARREGAR OS PACOTES 3 | pacman::p_load(data.table, ggplot2) 4 | 5 | # AGORA, A BASE DE DADOS CAR EVALUATION # 6 | breast_cancer <- fread('https://raw.githubusercontent.com/hugoavmedeiros/cp_com_r/master/bases_tratadas/breast_cancer.csv', stringsAsFactors = T) 7 | breast_cancer <- fread('bases_tratadas/breast_cancer.csv', stringsAsFactors = T) 8 | 9 | # TABELA DE CONTINGÊNCIA # 10 | breast_cancer_table <- table(breast_cancer$idade, breast_cancer$tumor_tamanho) 11 | breast_cancer_table 12 | 13 | # GRÁFICOS DE DISPERSÃO PAREADOS DAS VARIÁVEIS # 14 | ggplot(breast_cancer) + aes(x = tumor_tamanho, fill = idade) + geom_bar(position = "fill") 15 | 16 | # TESTE QUI QUADRADO # 17 | breast_cancer_test <- chisq.test(breast_cancer_table) 18 | breast_cancer_test 19 | breast_cancer_test$observed 20 | breast_cancer_test$expected 21 | 22 | # CORRPLOT DAS VARIÁVEIS # 23 | corrplot(breast_cancer_test$residuals, is.cor = FALSE) 24 | -------------------------------------------------------------------------------- /scripts/dataviz/mapas_animados.R: -------------------------------------------------------------------------------- 1 | pacman::p_load(dplyr, leaflet, leaflet.extras, leaflet.minicharts, rgdal, tidyr) 2 | 3 | escolas_integral <- read.csv2('../../bases_tratadas/escolas_tempo_integral_v2.csv') 4 | 5 | escolas_integral$nome_escola <- as.factor(escolas_integral$nome_escola) 6 | 7 | escolas_integral_agg <- escolas_integral %>% group_by(nome_escola, ano_implantacao, .drop=FALSE) %>% summarise(n = n()) %>% na.omit() %>% complete(ano_implantacao, nome_escola, fill = list(n = 0)) %>% filter(nome_escola != '') %>% distinct() 8 | 9 | escolas_integral_agg <- merge(escolas_integral_agg, escolas_integral, by = 'nome_escola') %>% select(!ano_implantacao.y) %>% distinct() 10 | 11 | leaflet(escolas_integral_agg) %>% addTiles() %>% 12 | addMinicharts( 13 | escolas_integral_agg$lon, escolas_integral_agg$lat, 14 | chartdata = escolas_integral_agg$n, 15 | time = escolas_integral_agg$ano_implantacao.x, 16 | showLabels = F, 17 | width = 15, height = 15 18 | ) %>% 19 | addFullscreenControl() -------------------------------------------------------------------------------- /scripts/dataviz/intro_ggplot.R: -------------------------------------------------------------------------------- 1 | ## Carregar pacotes que serão usados 2 | pacman::p_load(dplyr, ggplot2) 3 | 4 | # Gráfico de Caixas Univariado 5 | iris %>% ggplot(aes(y = Sepal.Length)) + geom_boxplot() 6 | 7 | # Gráfico de Caixas Multivariado 8 | iris %>% ggplot(aes(y = Sepal.Length, x = Species)) + geom_boxplot() 9 | 10 | # Histograma 11 | iris %>% ggplot(aes(x = Sepal.Length)) + geom_histogram() 12 | 13 | # Densidade 14 | iris %>% ggplot(aes(x = Sepal.Length)) + geom_density() 15 | 16 | ## Leitura base orçamento defesa brasil 17 | defesaBrasilLong <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/master/bases_tratadas/orcamento_defesa_brasil.csv') 18 | 19 | # Séries Temporais 20 | defesaBrasilLong %>% group_by(Ano) %>% summarise(Valor = sum(Valor)) %>% ggplot(aes(x = Ano, y = Valor)) + geom_line() 21 | 22 | # Barras 23 | defesaBrasilLong %>% ggplot(aes(x = Ano, y = Valor)) + geom_bar(stat = "identity") 24 | 25 | # Dispersão 26 | defesaBrasilLong %>% ggplot(aes(x = Ano, y = Valor)) + geom_point() 27 | -------------------------------------------------------------------------------- /scripts/etl/leitura.R: -------------------------------------------------------------------------------- 1 | ########## 2 | 3 | pacman::p_load(microbenchmark) 4 | 5 | # exporta em formato nativo do R 6 | saveRDS(sinistrosRecifeRaw, "bases_tratadas/sinistrosRecife.rds") 7 | 8 | # exporta em formato tabular (.csv) - padrão para interoperabilidade 9 | write.csv2(sinistrosRecifeRaw, "bases_tratadas/sinistrosRecife.csv") 10 | 11 | # carrega base de dados em formato nativo R 12 | sinistrosRecife <- readRDS('bases_tratadas/sinistrosRecife.rds') 13 | 14 | # carrega base de dados em formato tabular (.csv) - padrão para interoperabilidade 15 | sinistrosRecife <- read.csv2('bases_tratadas/sinistrosRecife.csv', sep = ';') 16 | 17 | # compara os dois processos de exportação, usando a função microbenchmark 18 | 19 | microbenchmark(a <- saveRDS(sinistrosRecifeRaw, "bases_tratadas/sinistrosRecife.rds"), b <- write.csv2(sinistrosRecifeRaw, "bases_tratadas/sinistrosRecife.csv"), times = 30L) 20 | 21 | microbenchmark(a <- readRDS('bases_tratadas/sinistrosRecife.rds'), b <- read.csv2('bases_tratadas/sinistrosRecife.csv', sep = ';'), times = 10L) 22 | -------------------------------------------------------------------------------- /scripts/transformacao/dplyr.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | 3 | facebook <- read.table("https://raw.githubusercontent.com/hugoavmedeiros/cd_com_r/master/bases_originais/dataset_Facebook.csv", sep=";", header = T) 4 | 5 | # sumários 6 | count(facebook, Type) 7 | 8 | # sumários com agrupamentos 9 | facebook %>% group_by(Type) %>% summarise(avg = mean(like)) 10 | 11 | ### Transformação de Casos 12 | 13 | # seleção de casos 14 | facebook %>% filter(Type != "Photo") %>% summarise(avg = mean(like)) 15 | facebook %>% filter(Type != "Photo") %>% group_by(Type, Paid) %>% summarise(avg = mean(like)) 16 | 17 | # ordenar casos 18 | arrange(facebook, like) # ascendente 19 | arrange(facebook, desc(like)) # descendente 20 | 21 | ### Transformação de Variáveis 22 | 23 | # seleção de colunas 24 | facebook %>% select(like, Type, Paid) %>% arrange(like) 25 | 26 | # novas colunas 27 | facebook %>% mutate(likePerLifeTime = like/Lifetime.Post.Total.Reach) 28 | 29 | # renomear 30 | facebook %>% rename(Reach = Lifetime.Post.Total.Reach) 31 | -------------------------------------------------------------------------------- /scripts/transformacao/outliers_em_regressoes.R: -------------------------------------------------------------------------------- 1 | ### outliers em regressões 2 | 3 | # carrega as bibliotecas 4 | pacman::p_load(car, caret, corrplot, dplyr, forcats, funModeling, Hmisc, plotly) 5 | 6 | load("modelos/ENEM_LM.RData") # carrega modelo pronto 7 | 8 | summary(ENEM_LM) 9 | 10 | outlierTest(ENEM_LM) # identificar outliers na regressão 11 | 12 | # identificar pontos de alavancagem 13 | hat.plot <- function(fit) { 14 | p <- length(coefficients(fit)) 15 | n <- length(fitted(fit)) 16 | plot(hatvalues(fit), main="Pontos de Alavancagem") 17 | abline(h=c(2,3)*p/n, col="red", lty=2) 18 | identify(1:n, hatvalues(fit), names(hatvalues(fit))) 19 | } 20 | hat.plot(ENEM_LM) 21 | 22 | # identificar observações influentes 23 | influencePlot(ENEM_LM, id.method="identify", main="Observações Influentes") 24 | 25 | # base para identificação de outlier 26 | ENEM_ESCOLA_2019 <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/etl_com_r/master/bases_tratadas/ENEM_ESCOLA_2019.csv', stringsAsFactors = T) # carregando a base já tratada para o ambiente do R 27 | 28 | 29 | -------------------------------------------------------------------------------- /scripts/programacao/funcoes.R: -------------------------------------------------------------------------------- 1 | # função 2 | hello_word <- function() { 3 | cat("Hello, world!\n") 4 | } 5 | hello_word() 6 | 7 | hello_word |> formals() 8 | hello_word |> body() 9 | hello_word |> environment() 10 | 11 | # agora, uma função mais útil... 12 | centralizacao <- function(x) { 13 | x <- x - mean(x) 14 | return(x) 15 | } 16 | 17 | iris$Sepal.Length |> centralizacao() 18 | 19 | centralizacao <- function(x) { 20 | x <- x - mean(x) 21 | } 22 | 23 | iris$Sepal.Length |> centralizacao() 24 | 25 | centroTeste <- iris$Sepal.Length |> centralizacao() 26 | centroTeste 27 | 28 | ### CARREGAR PACOTES 29 | pacman::p_load(lsa) 30 | 31 | ### CRIAR FUNÇÃO PARA RODAR VÁRIAS ASSOCIAÇÕES 32 | multi.ass <- function(x, y) { 33 | corr = cor(x, y) # Correlação 34 | cos = cosine(x, y) # Distância do Cosseno 35 | Associações = as.data.frame(list(corr, cos)) 36 | names(Associações) = c('Correlação', 'Cosseno') 37 | return(Associações) 38 | } 39 | 40 | multi.ass |> formals() 41 | multi.ass |> body() 42 | multi.ass |> environment() 43 | 44 | multi.ass(cars$speed, cars$dist) 45 | -------------------------------------------------------------------------------- /scripts/etl/large_data_polars.R: -------------------------------------------------------------------------------- 1 | ##### ARMAZENAMENTO EM DISCO + COLUNARS ##### 2 | #### POLARS #### 3 | #### BASE FICTÍCIA #### 4 | # install.packages("polars", repos = "https://rpolars.r-universe.dev") 5 | pacman::p_load(arrow, dplyr, polars) 6 | 7 | enderecoBase <- 'bases_originais/large data/largeData.csv' 8 | 9 | tempo_arrow <- (system.time(base_arrow <- read_csv_arrow(file=enderecoBase))) 10 | 11 | base_polars = pl$DataFrame(base_arrow) 12 | 13 | base_polars %>% head() 14 | 15 | base_polars %>% typeof() 16 | 17 | base_polars %>% class() 18 | 19 | base_polars %>% object.size() 20 | 21 | base_polars_mod <- lm(a ~ b + c + d + e + f + g, base_polars) 22 | 23 | summary(base_polars_mod) 24 | 25 | #### BASE REAL #### 26 | EdStatsData <- read_csv_arrow('bases_originais/large data/EdStatsData.csv') 27 | 28 | EdStatsData_p = pl$DataFrame(EdStatsData) 29 | 30 | EdStatsData_p %>% head() 31 | 32 | EdStatsData_p %>% typeof() 33 | 34 | EdStatsData_p %>% class() 35 | 36 | EdStatsData_p %>% object.size() 37 | 38 | EdStatsData_p %>% names() 39 | 40 | # Sumário 41 | EdStatsData_p$describe() 42 | -------------------------------------------------------------------------------- /scripts/machine_learning/ml_insta_fafire.R: -------------------------------------------------------------------------------- 1 | #### PREPARAÇÃO #### 2 | ### PACOTES ### 3 | pacman::p_load( 4 | # ETL 5 | data.table, dplyr, lubridate, tidyr, 6 | # ML 7 | arules, arulesCBA, arulesViz, caret, rattle 8 | ) 9 | 10 | ### ETL ### 11 | instagram_unifafire <- fread('https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/master/bases_tratadas/instagram_unifafire.csv') 12 | 13 | str(instagram_unifafire) 14 | 15 | # mudar o tipo de dado das colunas mes e turno para fator 16 | instagram_unifafire <- instagram_unifafire %>% 17 | mutate_at( # mutate_at modifica colunas que já existem 18 | c('mes', 'turno'), 19 | as.factor) # muda tipo do dado para fator 20 | 21 | # mudar o tipo de dado da coluna "Data" para date 22 | instagram_unifafire <- instagram_unifafire %>% 23 | mutate_at( # mutate_at modifica colunas que já existem 24 | c('Data'), 25 | mdy) # muda o tipo de dado para Date, a partir do formato MM/DD/YY 26 | 27 | # converter mes para 28 | instagram_unifafire$mes <- month(instagram_unifafire$Data, label = TRUE) 29 | 30 | glimpse(instagram_unifafire) 31 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # R 2 | .Rproj.user 3 | .Rhistory 4 | .RData 5 | .Ruserdata 6 | 7 | # Python 8 | *.pyc 9 | *~ 10 | __pycache__ 11 | python/scrap_instagram/__pycache__/ 12 | python/scrap_instagram/env/ 13 | python/scrap_instagram/unifafire/ 14 | python/scrap_instagram/dados_instagram.xlsx 15 | python/scrap_instagram/instagram_unifafire_original.xlsx 16 | 17 | # html 18 | *.html 19 | scripts/rmarkdown/escolas_integrais.html 20 | scripts/rmarkdown/escolas_integrais_novo.html 21 | scripts/rmarkdown/facebook.html 22 | scripts/rmarkdown/kmeans_iris.html 23 | 24 | # Env 25 | .env 26 | myvenv/ 27 | venv/ 28 | 29 | # Windows 30 | Thumbs.db* 31 | ehthumbs*.db 32 | [Dd]esktop.ini 33 | $RECYCLE.BIN/ 34 | 35 | # Visual Studio 36 | .vscode/ 37 | .history/ 38 | *.code-workspace 39 | 40 | # Extras 41 | documentos/ 42 | tabelaBrasileirao.csv 43 | data_integrity.R 44 | unifafire/ 45 | dados_instagram.csv 46 | instagram_unifafire_original.csv 47 | extras/ 48 | bases_originais/largeData.csv 49 | /análise instagram FAFIRE_files/ 50 | /python/ 51 | /modelos/ 52 | análise instagram FAFIRE_files/ 53 | python/ 54 | modelos/ 55 | análise instagram FAFIRE.qmd -------------------------------------------------------------------------------- /scripts/transformacao/limpeza.R: -------------------------------------------------------------------------------- 1 | library(data.table) 2 | library(dplyr) 3 | library(tidyverse) 4 | library(funModeling) 5 | 6 | general_data <- fread("https://covid.ourworldindata.org/data/owid-covid-data.csv") # carrega dados de covid19 no mundo 7 | 8 | latin_america_countries <-c("Argentina", "Brazil", "Bolivia", "Chile", "Colombia", "Costa Rica", "Cuba", "Dominican Republic", "Ecuador", "El Salvador", "Guatemala", "Haiti", "Honduras", "Mexico", "Nicaragua", "Panama", "Paraguay", "Peru", "Uruguay", "Venezuela") # vetor que identifica países latino americanos 9 | 10 | latin_america <- general_data %>% filter(location %in% latin_america_countries) # filtra casos apenas no vetor 11 | 12 | latin_america <- latin_america %>% select(location, new_cases, new_deaths) 13 | 14 | status(latin_america) # estrutura dos dados (missing etc) 15 | freq(latin_america) # frequência das variáveis fator 16 | plot_num(latin_america) # exploração das variáveis numéricas 17 | profiling_num(latin_america) # estatísticas das variáveis numéricas 18 | 19 | latin_america %>% filter(new_cases < 0) 20 | 21 | latin_america <- latin_america %>% filter(new_cases>=0) 22 | -------------------------------------------------------------------------------- /scripts/dataviz/ggplot_casos_variaveis.R: -------------------------------------------------------------------------------- 1 | ### CARREGAR PACOTES 2 | pacman::p_load(dplyr, ggplot2, plotly, readxl, tidyr) 3 | 4 | ### CARREGAR BASES 5 | baseArtigo <- read_excel("bases_originais/base_artigo_v1.xlsx") 6 | 7 | ### EXPLORAR BASE 8 | View(baseArtigo) 9 | str(baseArtigo) 10 | 11 | baseArtigo$casos <- as.factor(baseArtigo$casos) 12 | 13 | ### ESTRUTURAR BASE 14 | baseArtigo2 <- baseArtigo %>% 15 | select(casos, Ano, v_positive_e_ios, v_negative_e_ios) %>% 16 | pivot_longer(cols=c('v_positive_e_ios', 'v_negative_e_ios'), names_to='avaliacao', values_to="valor") 17 | 18 | ### CRIAR GRÁFICO 19 | gCasos <- ggplot( 20 | data = baseArtigo2, # base utilizada 21 | mapping = aes(x = Ano, # eixo x 22 | y = valor, # eixo y 23 | fill=avaliacao) # cor das variáveis 24 | ) + 25 | geom_bar(stat='identity', position='dodge') + # identity soma y e agrupa por x, e dodge coloca lado a lado 26 | facet_wrap(facets = vars(casos), scales = "free") + # cria facetas, ou seja, minigráficos de acordo com a variável indicada 27 | theme_classic() # tema clássico, para ficar mais legível 28 | 29 | gCasos 30 | 31 | ggplotly(gCasos) 32 | -------------------------------------------------------------------------------- /scripts/textos/carregando_textos.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | library(pdftools) 3 | library(textreadr) 4 | 5 | # ler textos (Exemplo do Handling Strings with R) 6 | top105 <- readLines("http://www.textfiles.com/music/ktop100.txt") 7 | 8 | # ler pdf 9 | documentoAula <- read_pdf('documentos/programa-ELT com R.pdf', ocr = T) 10 | 11 | # agrupar páginas em 1 doc: 1) agrupa por id 2) cria nova coluna colando a coluna texto na mesma linha 3) seleciona apenas colunas de interesse 4) remove duplicata 12 | documentoAula2 <- documentoAula %>% group_by(element_id) %>% mutate(all_text = paste(text, collapse = " | ")) %>% select(element_id, all_text) %>% unique() 13 | 14 | # automatização de conferência: 1) usa função grepl para buscar termos na coluna de texto 2) se os textos forem achados, classifica 15 | documentoAula2$classe <- ifelse( 16 | grepl("Bibliografia", documentoAula2$all_text) & 17 | grepl("Ciência Política", documentoAula2$all_text) & 18 | grepl("Avaliação", documentoAula2$all_text), "Ementa", NA) 19 | 20 | # também podemos extrair informações de forma automática, como as datas das aulas 21 | ( datas <- str_extract_all(documentoAula2$all_text, "\\d{2}/\\d{2}") ) 22 | 23 | -------------------------------------------------------------------------------- /scripts/machine_learning/regressao_metricas.R: -------------------------------------------------------------------------------- 1 | # MAE = Mean absolute error (Erro médio absoluto) - Média dos módulos dos resíduos 2 | # RMSE = Root Mean Squared Error (Raiz quadrada do erro-médio) - Média da raiz quadrada do quadrado do resíduo 3 | # Semelhanças 4 | # Mesma escala da variável de interesse 5 | # Quanto menor melhor (orientadas negativamente) 6 | # Diferenças 7 | # RMSE capta melhor a variância dos erros 8 | # MAE é mais simples de interpretar 9 | 10 | plot(erros1 <- c(rep(2,10))) 11 | plot(erros2 <- c(rep(1,5), rep(3,5))) 12 | plot(erros3 <- c(rep(0,8), rep(10,2))) 13 | lista_erros <- matrix(c(sum(erros1)/10,sum(erros2)/10, sum(erros3)/10, sqrt(sum(erros1^2)/10), sqrt(sum(erros2^2)/10), sqrt(sum(erros3^2)/10)), ncol = 2, dimnames = list(c('Erros 1', 'Erros 2', 'Erros 3'), c('MAE', 'RMSE'))) 14 | lista_erros 15 | 16 | # Rsquared ou R² = Coeficiente de Determinação - quantidade da variância que é explicada pelo modelo. 17 | # Varia entre 0 e 1 18 | # Quanto maior melhor (orientada positivamente) 19 | 20 | melhor_modelo <- resamples(list(LM = ENEM_LM, RPART = ENEM_RPART, RF = ENEM_RF, ADABOOST = ENEM_ADA)) 21 | melhor_modelo 22 | 23 | summary(melhor_modelo) 24 | -------------------------------------------------------------------------------- /scripts/analise/teste_hipotese.R: -------------------------------------------------------------------------------- 1 | # PACOTES # 2 | pacman::p_load(data.table) 3 | 4 | # LEITURA PARA TESTE DE CORRELAÇÃO # 5 | enem_escola_pe_2019 <- fread('https://raw.githubusercontent.com/hugoavmedeiros/cp_com_r/master/bases_tratadas/ENEM_ESCOLA_2019.csv', dec = ',') 6 | 7 | cor.test(enem_escola_pe_2019$nota, enem_escola_pe_2019$TDI_03) 8 | # H0: variáveis são independentes / não têm associação. p-valor (p-value) > 0.05 9 | # H1: variáveis são dependentes / há associação. p-valor (p-value) <= 0.05 10 | 11 | t.test(enem_escola_pe_2019$nota, mu = 500.0) 12 | shapiro.test(enem_escola_pe_2019$nota) 13 | hist(enem_escola_pe_2019$nota) 14 | 15 | shapiro.test((enem_escola_pe_2019$nota - min(enem_escola_pe_2019$nota)) / (max(enem_escola_pe_2019$nota) - min(enem_escola_pe_2019$nota))) 16 | hist((enem_escola_pe_2019$nota - min(enem_escola_pe_2019$nota)) / (max(enem_escola_pe_2019$nota) - min(enem_escola_pe_2019$nota))) 17 | 18 | # LEITURA PARA TESTE DE FREQUÊNCIAS # 19 | milsa <- fread("http://www.leg.ufpr.br/~paulojus/dados/milsa.dat") 20 | chisq.test(milsa$civil, milsa$instrucao) 21 | # H0: variáveis são independentes / não há associação. p-valor (p-value) > 0.05 22 | # H1: variáveis são dependentes / há associação. p-valor (p-value) <= 0.05 -------------------------------------------------------------------------------- /scripts/transformacao/outliers.R: -------------------------------------------------------------------------------- 1 | pacman::p_load(data.table, dplyr, plotly) 2 | 3 | # carregar dados covid19 Pernambuco 4 | covid19PE <- fread('https://dados.seplag.pe.gov.br/apps/basegeral.csv') 5 | 6 | covid19PEMun <- covid19PE %>% count(municipio, sort = T, name = 'casos') %>% mutate(casos2 = sqrt(casos), casosLog = log10(casos)) 7 | 8 | ## outliers em variáveis 9 | # distância interquartil 10 | 11 | plot_ly(y = covid19PEMun$casos, type = "box", text = covid19PEMun$municipio, boxpoints = "all", jitter = 0.3) 12 | boxplot.stats(covid19PEMun$casos)$out 13 | boxplot.stats(covid19PEMun$casos, coef = 2)$out 14 | 15 | covid19PEOut <- boxplot.stats(covid19PEMun$casos)$out 16 | covid19PEOutIndex <- which(covid19PEMun$casos %in% c(covid19PEOut)) 17 | covid19PEOutIndex 18 | 19 | # filtro de Hamper 20 | lower_bound <- median(covid19PEMun$casos) - 3 * mad(covid19PEMun$casos, constant = 1) 21 | upper_bound <- median(covid19PEMun$casos) + 3 * mad(covid19PEMun$casos, constant = 1) 22 | (outlier_ind <- which(covid19PEMun$casos < lower_bound | covid19PEMun$casos > upper_bound)) 23 | 24 | # teste de Rosner 25 | library(EnvStats) 26 | covid19PERosner <- rosnerTest(covid19PEMun$casos, k = 10) 27 | covid19PERosner 28 | covid19PERosner$all.stats 29 | -------------------------------------------------------------------------------- /scripts/programacao/funcoes_de_repeticao.R: -------------------------------------------------------------------------------- 1 | # funções de repetição - família apply 2 | 3 | # média de cada variável do data frame iris 4 | apply(iris[ ,-5], 2, mean) # iris[,-5] retira a última coluna, que não é numérica. no segundo parâmetro, o 2 indica que queremos a média das colunas. 5 | lapply(iris[, -5], mean) # sintaxe mais simples, pois não precisa especificar se é coluna ou linha 6 | sapply(iris[, -5], mean) # mesma sintaxe, sendo a principal diferença que a sapply sempre tenta simplificar o resultado 7 | 8 | par(mfrow = c(2, 2)) # prepara a área de plotagem para receber 4 plots 9 | 10 | sapply(iris[ , 1:4], hist) 11 | mapply(hist, iris[ , 1:4], MoreArgs=list(main='Histograma', xlab = 'Valores', ylab = 'Frequência')) # mapply tem a vantagem de aceitar argumentos da função original 12 | 13 | for (i in 1:4) { # cria o loop, que deve ir de 1 a 4 14 | x <- iris[ , i] # atribui as colunas da base de dados a uma variável temporária 15 | hist(x, 16 | main = names(iris)[i], # atribui o nome ao gráfico de forma incremental, passando coluna por coluna 17 | xlab = "Valores da Variável", # rótulo eixo x 18 | ylab = 'Frequência', # rótulo eixo y 19 | xlim = c(min(iris[, i]), max(iris[, i]))) # limites do eixo x 20 | } 21 | -------------------------------------------------------------------------------- /scripts/programacao/simulacoes_e_repeticoes_no_R.R: -------------------------------------------------------------------------------- 1 | # seta a semente aleatória de geração de dados 2 | # usando a função addTaskCallback deixamos a set.seed fixa, rodando no back 3 | 4 | tarefaSemente <- addTaskCallback(function(...) {set.seed(123);TRUE}) # atribui a tarefa à variável tarefaSemente 5 | tarefaSemente # chama a tarefaSemente 6 | 7 | # distribuição normal simulada 8 | distNormalSimulacao <- rnorm(100) # usa a função rnorm para criar uma distribuição normal, indicando o total de casos 9 | 10 | summary(distNormalSimulacao) # sumário da distNormalSimulacao 11 | 12 | # distribuição binomial simulada 13 | distBinominalSimulacao <- rbinom(100, 1, 0.7) # rbinom para criar distribuição binominal, indicando casos, tamanho e probabilidade 14 | 15 | # repetições 16 | classeSimulacao <- c(rep("Jovem", length(distBinominalSimulacao)/2), rep("Jovem Adulto", length(distBinominalSimulacao)/2)) # vetor repetindo a classe Jovem 15x e Jovem Adulto 15x 17 | 18 | # sequências 19 | indexSimulacao <- seq(1, length(distNormalSimulacao)) # vetor com índex dos dados, usando a função length para pegar o total de casos 20 | 21 | # por fim, podemos usar a função removeTaskCallback para remover a tarefa que criamos lá em cima 22 | removeTaskCallback(tarefaSemente) 23 | -------------------------------------------------------------------------------- /scripts/etl/etl_instagram.R: -------------------------------------------------------------------------------- 1 | pacman::p_load(dplyr, lubridate, readxl) 2 | 3 | instagram_unifafire <- read_xlsx( 4 | 'bases_originais/instagram_unifafire_original.xlsx' 5 | ) 6 | 7 | instagram_unifafire$DataC <- mdy(instagram_unifafire$Data) 8 | instagram_unifafire$Tempo <- paste(instagram_unifafire$DataC, instagram_unifafire$`Hora Min`) 9 | instagram_unifafire$Tempo <- as.POSIXlt(instagram_unifafire$Tempo) 10 | instagram_unifafire$Hora <- format(instagram_unifafire$Tempo, "%H") 11 | instagram_unifafire$Hora <- as.integer(instagram_unifafire$Hora) 12 | 13 | instagram_unifafire$mes <- month( 14 | instagram_unifafire$DataC, 15 | label = TRUE, 16 | abbr = TRUE) 17 | 18 | instagram_unifafire <- instagram_unifafire %>% mutate( 19 | turno = case_when( 20 | Hora >= 18 ~ 'Noite', 21 | Hora >= 12 ~ 'Tarde', 22 | Hora >= 6 ~ 'Manhã', 23 | Hora >= 0 ~ 'Madrugada' 24 | )) 25 | 26 | instagram_unifafire <- instagram_unifafire %>% mutate( 27 | Curtidas = ifelse(Curtidas <0, 0, Curtidas) 28 | ) 29 | 30 | # SALVAR # 31 | 32 | instagram_unifafire %>% select(-Tempo) %>% data.table::fwrite("bases_tratadas/instagram_unifafire.csv", sep = ";") 33 | 34 | saveRDS( 35 | instagram_unifafire, 36 | file = "bases_tratadas/instagram_unifafire.RDS") 37 | -------------------------------------------------------------------------------- /scripts/analise/estatistica_descritiva_basica.R: -------------------------------------------------------------------------------- 1 | pacman::p_load( 2 | tidyverse 3 | ) 4 | 5 | ### Estatística Descritiva com R 6 | ## Tabela de frequência absoluta da variável Species da base iris 7 | iris %>% select(Species) %>% table() 8 | 9 | ## Tabela de frequência relativa da variável Species da base iris 10 | iris %>% select(Species) %>% table() %>% prop.table() 11 | 12 | ## Média da variável Sepal.Length da base iris 13 | iris$Sepal.Length %>% mean() 14 | 15 | ## Mediana da variável Sepal.Length da base iris 16 | iris$Sepal.Length %>% median() 17 | 18 | ## Separatrizes da variável Sepal.Length da base iris 19 | iris$Sepal.Length %>% quantile(probs=0.75) 20 | iris$Sepal.Length %>% quantile(probs=0.10) 21 | iris$Sepal.Length %>% quantile(probs=0.99) 22 | iris$Sepal.Length %>% boxplot() # boxplot - gráfico que resume as sepatrizes 23 | 24 | ## Desvio-padrão da variável Sepal.Length da base iris 25 | iris$Sepal.Length %>% sd() 26 | iris$Sepal.Length %>% plot() 27 | 28 | ## Sumário descritivo básico das variáveis 29 | iris %>% summary() 30 | 31 | ## Sumário descritivo completo das variáveis usando o pacote fBasics 32 | pacman::p_load(fBasics) 33 | iris %>% select(1:4) %>% basicStats() 34 | iris$Sepal.Length %>% hist() # histograma - gráfico que permite conhecer a curva dos dados 35 | -------------------------------------------------------------------------------- /scripts/transformacao/estruturacao.R: -------------------------------------------------------------------------------- 1 | library(data.table) 2 | library(dplyr) 3 | library(tidyverse) 4 | 5 | general_data<-fread("https://covid.ourworldindata.org/data/owid-covid-data.csv") # carrega dados de covid19 no mundo 6 | 7 | latin_america_countries<-c("Argentina", "Brazil", "Bolivia", "Chile", "Colombia", "Costa Rica", "Cuba", "Dominican Republic", "Ecuador", "El Salvador", "Guatemala", "Haiti", "Honduras", "Mexico", "Nicaragua", "Panama", "Paraguay", "Peru", "Uruguay", "Venezuela") # vetor que identifica países latino americanos 8 | 9 | latin_america<- general_data %>% filter(location %in% latin_america_countries) # filtra casos apenas no vetor 10 | 11 | mlatin <- latin_america %>% group_by(location) %>% mutate(row = row_number()) %>% select(location, new_cases, row) # cria matriz dos países, agrupando por local, criando uma nova linha com index e selecionando apenas algumas variáveis 12 | 13 | # filtra dados para garantir que todos os países tenham mesmo nro de casos 14 | result <- mlatin %>% group_by(location) %>% filter(row == max(row)) 15 | mlatin <- mlatin %>% filter(row<=min(result$row)) 16 | 17 | # pivota o data frame de long para wide 18 | mlatinw <- mlatin %>% pivot_wider(names_from = row, values_from = new_cases) %>% remove_rownames %>% column_to_rownames(var="location") 19 | -------------------------------------------------------------------------------- /scripts/rmarkdown/crosstalk_intro.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: Terremotos Fiji 3 | output: html_document 4 | --- 5 | 6 | ```{r setup, include=FALSE} 7 | pacman::p_load(crosstalk, dplyr, DT, plotly) 8 | 9 | quakes <- quakes %>% dplyr::mutate( 10 | stations = as.factor(stations) 11 | ) 12 | 13 | sd <- SharedData$new(quakes) 14 | ``` 15 | 16 | ```{r, warning=FALSE, out.width='100%', echo = FALSE, message = FALSE} 17 | 18 | filter_slider("mag", "Magnitude", sd, column=~mag, step=0.1, width=250) 19 | 20 | filter_checkbox("stations", "Estações", sd, ~stations, inline = TRUE) 21 | 22 | sd %>% plot_ly() %>% 23 | add_trace(lon = ~long, lat = ~lat 24 | , type = "scattermapbox" 25 | , text = ~stations 26 | , alpha = 0.8 27 | , mode = "marker" 28 | , color = I("#1f77b4") 29 | , hoverinfo = ~stations) %>% 30 | layout( 31 | mapbox = list( 32 | style = 'open-street-map', 33 | zoom = 3, 34 | center = list(lon = 179.462, 35 | lat = -20.64275))) %>% highlight(on = "plotly_selected", off = "plotly_deselect", color = 'red') 36 | 37 | sd %>% plot_ly(x = ~depth, y = ~mag, color = ~stations) 38 | 39 | sd %>% datatable( 40 | filter = list( 41 | position = 'bottom', clear = FALSE, plain = TRUE) 42 | ) 43 | ``` 44 | -------------------------------------------------------------------------------- /scripts/etl/instalacoes_pcts_bd.R: -------------------------------------------------------------------------------- 1 | ##### ARROW ##### 2 | # PASSO 1 - INSTALAR / CARREGAR O arrow 3 | pacman::p_load(arrow) 4 | 5 | ##### FF ##### 6 | # PASSO 1 - INSTALAR R TOOLS 7 | # https://cran.r-project.org/bin/windows/Rtools/rtools43/files/rtools43-5550-5548.exe 8 | # PASSO 2 - INSTALAR E CARREGAR devtools 9 | pacman::p_load(devtools) 10 | # PASSO 3 - INSTALAR ffbase 11 | install_github("edwindj/ffbase", subdir="pkg") 12 | # PASSO 4 - iNSTALAR E CARREGAR OS OUTROS PACOTES ff 13 | pacman::p_load(biglm, ff, ffbase) 14 | 15 | ##### POLARS ##### 16 | # PASSO 1 - INSTALAR O polars 17 | install.packages("polars", repos = "https://rpolars.r-universe.dev") 18 | 19 | ##### SPARK ##### 20 | # PASSO 1 - INSTALAR O java 8 21 | https://docs.aws.amazon.com/corretto/latest/corretto-8-ug/downloads-list.html 22 | 23 | # PASSO 2 - INSTALAR E DEPOIS CARREGAR O sparklyr 24 | install.packages("sparklyr") 25 | library(sparklyr) 26 | 27 | # PASSO 3 - INSTALAR O Spark 28 | spark_install("3.5") 29 | 30 | # PASSO 4 - INSTALAR O SparkR 31 | install.packages("https://cran.r-project.org/src/contrib/Archive/SparkR/SparkR_2.3.0.tar.gz", repos = NULL, type="source") 32 | 33 | # PASSO 5 - CARREGAR OS PACOTES SPARK 34 | pacman::p_load(SparkR, sparklyr) 35 | 36 | sc <- spark_connect(master = "local", version = "3.5") 37 | 38 | spark_web(sc) 39 | -------------------------------------------------------------------------------- /scripts/programacao/calculando.R: -------------------------------------------------------------------------------- 1 | # o R como calculadora 2 | 3 | binomialnegSimulacao <- rnbinom(300, mu = 3, size = 10) 4 | 5 | poissonSimulacao <- rpois(300, 3) 6 | 7 | hist(binomialnegSimulacao) 8 | hist(poissonSimulacao) 9 | 10 | binomialnegSimulacao + poissonSimulacao # soma as distribuições 11 | 12 | poissonSimulacao + 100 # soma 100 a cada elemento 13 | 14 | poissonSimulacao^2 # eleva ao quadrado 15 | 16 | poissonSimulacao * binomialnegSimulacao # multiplica 17 | 18 | round(distNormalSimulacao, 0) # arredonda o vetor para inteiros 19 | 20 | ceiling(distNormalSimulacao) # arredonda para cima 21 | 22 | floor(distNormalSimulacao) # arredonda para baixo 23 | 24 | distNormalSimulacao %% poissonSimulacao # módulo dos vetores 25 | 26 | # também podemos usar funções estatísticas no R 27 | 28 | # média 29 | mean(poissonSimulacao) 30 | mean(binomialnegSimulacao) 31 | 32 | # mediana 33 | median(poissonSimulacao) 34 | median(binomialnegSimulacao) 35 | 36 | # desvio padrão 37 | sd(poissonSimulacao) 38 | sd(binomialnegSimulacao) 39 | 40 | # variância 41 | var(poissonSimulacao) 42 | var(binomialnegSimulacao) 43 | 44 | # uma aplicação prática?? vamos centralizar a nossa simulação poisson 45 | poissonSimulacaoCentral <- poissonSimulacao - mean(poissonSimulacao) 46 | hist(poissonSimulacao) 47 | hist(poissonSimulacaoCentral) 48 | -------------------------------------------------------------------------------- /scripts/textos/operacoes_com_texto.R: -------------------------------------------------------------------------------- 1 | library(electionsBR) 2 | library(dplyr) 3 | library(stringr) 4 | library(tidyr) 5 | 6 | ## Exemplo do Handling Strings with R 7 | states <- rownames(USArrests) 8 | 9 | set1 <- c("some", "random", "words", "some") 10 | set2 <- c("some", "many", "none", "few") 11 | 12 | grep(pattern = "k", x = states, value = TRUE) # estados com k no nome 13 | grep(pattern = "^[wW]", x = states, value = TRUE) # estados que começam com w ou W 14 | 15 | nchar(states) # tamanho do nome de cada estado 16 | 17 | tolower(states) # minúsculas 18 | toupper(states) # maiúsculas 19 | 20 | abbreviate(states, minlength = 3, method = "both.sides") # abrevia reduzindo a 3 letras, pelos dois lados 21 | 22 | str_replace_all(string = set1, pattern = "s", replacement = " ") # modifica um padrão # no caso, retiramos a letra 's' 23 | 24 | union(set1, set2) # união 25 | 26 | ## outas funções: intersect, setdiff... 27 | 28 | set2 %in% set1 # faz uma busca de um vetor de texto em outro 29 | 30 | ## extraindo partes de acordo com delimitador 31 | 32 | exString1 <- "EAG 6/1996 => PEC 33/1995" 33 | sub(" =>.*", "", exString1) # extrair antes do separador 34 | sub(".*=> ", "", exString1) # extrair depois do separador 35 | 36 | ## extraindo partes com regex 37 | teste <- c('81 32364555', '87 32456712', '81 987251232', '50619-322') 38 | str_extract_all(teste, "\\d{2}\\s\\d+") 39 | -------------------------------------------------------------------------------- /scripts/etl/large_data_spark.R: -------------------------------------------------------------------------------- 1 | pacman::p_load(SparkR, sparklyr) 2 | 3 | sc <- spark_connect(master = "local") 4 | 5 | base_spark <- spark_read_parquet( 6 | sc, 7 | name = "largeData", 8 | path = "bases_originais/large data/largeData.parquet", memory = FALSE) 9 | 10 | base_EdStatsData <- spark_read_csv( 11 | sc, 12 | name = "EdStatsData", 13 | path = "bases_originais/large data/EdStatsData.csv", memory = FALSE) 14 | 15 | base_pisa2015 <- spark_read_parquet( 16 | sc, 17 | name = "pisa2015", 18 | path = "bases_originais/large data/pisa2015_arrow.parquet", memory = F) 19 | 20 | spark_web(sc) 21 | 22 | base_spark %>% head() 23 | 24 | base_spark %>% typeof() 25 | 26 | base_spark %>% class() 27 | 28 | base_spark %>% object.size() # há vantagem no tamanho 29 | 30 | dplyr::count(base_spark) 31 | 32 | dplyr::select(base_spark, a, b) %>% 33 | dplyr::sample_n(100000) %>% 34 | dplyr::collect() %>% 35 | plot() 36 | 37 | base_spark_mod <- ml_linear_regression(base_spark, a ~ b + c + d + e + f + g) 38 | 39 | base_spark_mod 40 | 41 | ##### GRÁFICOS ##### 42 | pacman::p_load( 43 | # Gráficos 44 | dbplot 45 | ) 46 | 47 | base_spark %>% dbplot_histogram(a, binwidth = 3) 48 | 49 | 50 | base_spark <- base_spark %>% cache() 51 | 52 | base_pisa2015 %>% object.size() # há vantagem no tamanho 53 | 54 | dplyr::count(base_pisa2015) 55 | 56 | base_pisa2015 %>% names() 57 | -------------------------------------------------------------------------------- /scripts/etl/large_data_arrow.R: -------------------------------------------------------------------------------- 1 | ##### COLUNAR ##### 2 | #### ARROW #### 3 | pacman::p_load(arrow, dplyr) 4 | 5 | enderecoBase <- 'bases_originais/largeData.csv' 6 | 7 | # criando o arquivo ff 8 | tempo_arrow <- (system.time(base_arrow <- read_csv_arrow(file=enderecoBase))) 9 | 10 | base_arrow %>% head() 11 | 12 | base_arrow %>% typeof() 13 | 14 | base_arrow %>% class() 15 | 16 | base_arrow %>% object.size() # não ha vantagem no tamanho 17 | 18 | base_arrow_t <- arrow_table(base_arrow) 19 | 20 | base_arrow_t %>% typeof() 21 | 22 | base_arrow_t %>% class() 23 | 24 | base_arrow_t %>% object.size() # não ha vantagem no tamanho 25 | 26 | base_arrow_t 27 | 28 | base_arrow_t %>% 29 | group_by(d) %>% 30 | summarize( 31 | mean_a = mean(a), 32 | mean_b = mean(b), 33 | total = n()) %>% 34 | filter(mean_a > 0) %>% 35 | arrange(mean_a) %>% 36 | collect() 37 | 38 | base_arrow_s1 <- base_arrow %>% sample_n(500000, replace = TRUE) %>% compute() 39 | 40 | base_arrow_s1 %>% typeof() 41 | 42 | base_arrow_s1 %>% class() 43 | 44 | base_arrow_s1 %>% object.size() 45 | 46 | base_arrow_s1_mod <- lm(a ~ b + c + d + e + f + g, base_arrow_s1) 47 | 48 | summary(base_arrow_s1_mod) 49 | 50 | ###### 51 | pisa2015_arrow <- read_csv_arrow("bases_originais/large data/pisa2015.csv") 52 | 53 | pisa2015_arrow %>% object.size() 54 | 55 | arrow::write_parquet(pisa2015_arrow, 'pisa2015_arrow.parquet') 56 | -------------------------------------------------------------------------------- /scripts/machine_learning/agrupamento_kmeans_facebook.R: -------------------------------------------------------------------------------- 1 | # carregar as bibliotecas 2 | pacman::p_load(cluster, factoextra, ggplot2, plotly) 3 | 4 | facebook <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/cd_com_r/master/bases_tratadas/facebook_2021.csv') 5 | 6 | facebook_cluster <- facebook[ , -(1:4)] 7 | 8 | # setar semente aleatória 9 | set.seed(1) 10 | 11 | # elbow method 12 | fviz_nbclust(facebook_cluster, kmeans, method = "wss") 13 | 14 | # Agrupamento com kmeans 15 | cls <- kmeans(facebook_cluster, centers = 5) # aprendizagem ns 16 | facebook_cluster$cluster <- as.factor(cls$cluster) # passamos os clusters para a base original 17 | 18 | # plot com ggplot 19 | clusterPlot <- ggplot() + 20 | geom_point(data = facebook_cluster, 21 | mapping = aes(x = num_comments, 22 | y = num_shares, 23 | colour = cluster)) + 24 | geom_point(mapping = aes_string(x = cls$centers[ , "num_comments"], 25 | y = cls$centers[ , "num_shares"]), 26 | color = "red", size = 4) + 27 | geom_text(mapping = aes_string(x = cls$centers[ , "num_comments"], 28 | y = cls$centers[ , "num_shares"], 29 | label = 1:5), 30 | color = "white", size = 2) + 31 | theme_light() 32 | 33 | # gráfico interativo 34 | ggplotly(clusterPlot) 35 | -------------------------------------------------------------------------------- /scripts/rmarkdown/kmeans_iris.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Análise iris" 3 | output: html_document 4 | --- 5 | 6 | ```{r setup, include=FALSE} 7 | # carregar as bibliotecas 8 | pacman::p_load(cluster, ggplot2, plotly) 9 | 10 | # pré-processamento 11 | iris_cluster <- iris[ , -5] 12 | str(iris_cluster) 13 | 14 | # setar semente aleatória 15 | set.seed(1) 16 | 17 | # Agrupamento com kmeans 18 | cls <- kmeans(x = iris_cluster, centers = 3) # aprendizagem ns 19 | iris_cluster$cluster <- as.factor(cls$cluster) # passamos os clusters para a base original 20 | head(iris_cluster) 21 | ``` 22 | 23 | # Agrupamento dos dados 'Iris' 24 | ## K-means 25 | 26 | Abaixo, você encontra o agrupamento da base de dados Iris, usando a técnica de k-means. 27 | 28 | ```{r iriscluster, echo=FALSE, warning=FALSE, message=FALSE} 29 | grafico1 <- ggplot() + 30 | geom_point(data = iris_cluster, mapping = aes(x = Sepal.Length, y = Petal.Length, colour = cluster)) + 31 | geom_point(mapping = aes_string(x = cls$centers[ , "Sepal.Length"], y = cls$centers[ , "Petal.Length"]), color = "red", size = 4) + 32 | geom_text(mapping = aes_string(x = cls$centers[ , "Sepal.Length"], y = cls$centers[ , "Petal.Length"], label = 1:3), color = "white", size = 2) + 33 | theme_light() 34 | ggplotly(grafico1) 35 | ``` 36 | 37 | Observe que existe um cluster (nro 1) bastante separados dos outros. Alguns pontos desses dois clusters (nro 2 e nro 3) são semelhantes, dificultando a aprendizagem da máquina -------------------------------------------------------------------------------- /scripts/etl/extracao_com_scraping.R: -------------------------------------------------------------------------------- 1 | # arquivos html 2 | library(rvest) 3 | library(dplyr) 4 | 5 | # tabelas da wikipedia 6 | url <- "https://pt.wikipedia.org/wiki/%C3%93scar" 7 | 8 | urlTables <- url %>% read_html %>% html_nodes("table") 9 | 10 | urlLinks <- url %>% read_html %>% html_nodes("link") 11 | 12 | filmesPremiados <- as.data.frame(html_table(urlTables[5])) 13 | 14 | # resultados do brasileirão 15 | 16 | resultadosBrasileirao <- read_html("https://www.cbf.com.br") 17 | 18 | resultadosBrasileirao <- resultadosBrasileirao %>% html_nodes(".swiper-slide") 19 | 20 | rodada <- resultadosBrasileirao %>% html_nodes(".aside-header .text-center") %>% html_text() 21 | 22 | resultados <- resultadosBrasileirao %>% html_nodes(".aside-content .clearfix") 23 | 24 | mandante <- resultados %>% html_nodes(".pull-left .time-sigla") %>% html_text() 25 | 26 | visitante <- resultados %>% html_nodes(".pull-right .time-sigla") %>% html_text() 27 | 28 | tabelaBrasileirao <- data.frame( 29 | mandante = mandante, 30 | visitante = visitante, 31 | time = timestamp()) 32 | 33 | write.csv2(tabelaBrasileirao, 'tabelaBrasileirao.csv') 34 | 35 | # tabelas da globo.com 36 | url <- "https://globoesporte.globo.com/futebol/futebol-internacional/futebol-espanhol/" 37 | 38 | stock <- read_html("https://globoesporte.globo.com/futebol/futebol-internacional/futebol-espanhol/") %>% 39 | html_nodes(xpath = "//*[@id='classificacao__wrapper']/section/ul/li[1]") %>% html_text() 40 | -------------------------------------------------------------------------------- /scripts/transformacao/imputacao.R: -------------------------------------------------------------------------------- 1 | # imputação de valores em outliers ou missing 2 | pacman::p_load(data.table, Hmisc, VIM) # carrega pacotes 3 | 4 | ## imputação numérica 5 | # preparação da base, colocando NA aleatórios 6 | irisDT <- iris %>% setDT() #copiar base iris, usando a data.table 7 | 8 | (irisNASeed <- round(runif(10, 1, 50))) # criamos 10 valores aleatórios 9 | 10 | (irisDT$Sepal.Length[irisNASeed] <- NA) # imputamos NA nos valores aleatórios 11 | 12 | # tendência central 13 | irisDT$Sepal.Length <- impute(irisDT$Sepal.Length, fun = mean) # média 14 | irisDT$Sepal.Length <- impute(irisDT$Sepal.Length, fun = median) # mediana 15 | 16 | is.imputed(irisDT$Sepal.Length) # teste se o valor foi imputado 17 | table(is.imputed(irisDT$Sepal.Length)) # tabela de imputação por sim / não 18 | 19 | # predição 20 | irisDT$Sepal.Length[irisNASeed] <- NA # recolocamos os NA 21 | 22 | regIris <- lm(Sepal.Length ~ ., data = irisDT) # criamos a regressão 23 | irisNAIndex <- is.na(irisDT$Sepal.Length) # localizamos os NA 24 | irisDT$Sepal.Length[irisNAIndex] <- predict(regIris, newdata = irisDT[irisNAIndex, ]) # imputamos os valores preditos 25 | 26 | ## Hot deck 27 | # imputação aleatória 28 | irisDT$Sepal.Length[irisNASeed] <- NA # recolocamos os NA 29 | 30 | (irisDT$Sepal.Length <- impute(irisDT$Sepal.Length, "random")) # fazemos a imputação aleatória 31 | 32 | # imputação por instâncias /semelhança 33 | irisDT$Sepal.Length[irisNASeed] <- NA # recolocamos os NA 34 | irisDT2 <- kNN(irisDT) 35 | -------------------------------------------------------------------------------- /scripts/atividades/exercicio1.R: -------------------------------------------------------------------------------- 1 | # Crie um data frame com pelo menos 500 casos e a seguinte composição: duas variáveis normais de desvio padrão diferente, uma variável de contagem (poisson), uma variável de contagem com dispersão (binomial negativa), uma variável binomial (0,1), uma variável qualitativa que apresenta um valor quando a variável binomial é 0 e outro quando é 1, e uma variável de index. 2 | 3 | exercicio1 <- data.frame( # criando data.frame 4 | varNorm1 = rnorm(500, sd = 4), # var Normal desvio 4 5 | varNorm2 = rnorm(500, sd = 5), # var Normal desvio 5 6 | varCont1 = rpois(500, 3), # var Contagem poisson 7 | varCont2 = rnbinom(500, mu = 3, size = 10), # var Contagem Binomial Negativa 8 | varBin = rbinom(500, 1, 0.7), # var binomial binária com 70% chance de 1 9 | varIndex = seq(1:500) 10 | ) 11 | 12 | exercicio1$varFactor = ifelse(exercicio1$varBin == 1, 'Azul', 'Vermelho') # codificação fatorial da variável binomial binária 13 | 14 | # 2. Centralize as variáveis normais. 15 | 16 | centralizacao <- function(x) { 17 | x - mean(x) 18 | } 19 | 20 | exercicio1[ , 1:2] <- sapply(exercicio1[ , 1:2], centralizacao) 21 | 22 | # 3. Troque os zeros (0) por um (1) nas variáveis de contagem. 23 | 24 | mudaZero <- function(x) { 25 | x <- ifelse(x == 0, 1, x) 26 | } 27 | 28 | exercicio1[ , 3:4] <- sapply(exercicio1[ , 3:4], mudaZero) 29 | 30 | # 4. Crie um novo data.frame com amostra (100 casos) da base de dados original. 31 | 32 | exercicio1Amostra <- exercicio1[sample(nrow(exercicio1), 100) , ] 33 | -------------------------------------------------------------------------------- /scripts/machine_learning/balanceamento_bases.R: -------------------------------------------------------------------------------- 1 | # carrega as bibliotecas 2 | pacman::p_load(ade4, arules, car, caret, corrplot, data.table, dplyr, e1071, forcats, funModeling, ggplot2, mlbench, mltools, randomForest, rattle, tidyverse) 3 | 4 | # leitura da base de dados 5 | ENEM_ESCOLA_2019 <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/etl_com_r/master/bases_tratadas/ENEM_ESCOLA_2019.csv', stringsAsFactors = T) # carregando a base já tratada para o ambiente do R 6 | 7 | # Dummies 8 | ENEM_ESCOLA_2019_D <- acm.disjonctif(as.data.frame(ENEM_ESCOLA_2019$tipo)) 9 | names(ENEM_ESCOLA_2019_D) <- c('EREM', 'ETE', 'Federal', 'Privada', 'Regular') 10 | 11 | ENEM_ESCOLA_2019 <- cbind(ENEM_ESCOLA_2019, ENEM_ESCOLA_2019_D) 12 | 13 | # Discretização 14 | ENEM_ESCOLA_2019$notaDisc <- discretize(ENEM_ESCOLA_2019$nota, method = "interval", breaks = 2, labels = c("baixa", "alta")) 15 | 16 | table(ENEM_ESCOLA_2019$notaDisc) 17 | 18 | # Treino e Teste: Pré-processamento 19 | particaoENEM = createDataPartition(ENEM_ESCOLA_2019$nota, p=.7, list = F) # cria a partição 70-30 20 | treinoENEM = ENEM_ESCOLA_2019[particaoENEM, ] # treino 21 | testeENEM = ENEM_ESCOLA_2019[-particaoENEM, ] # - treino = teste 22 | 23 | table(treinoENEM$notaDisc) 24 | 25 | # down / under 26 | treinoENEMDs <- downSample(x = treinoENEM[, -ncol(treinoENEM)], y = treinoENEM$notaDisc) 27 | table(treinoENEMDs$Class) 28 | 29 | # up 30 | treinoENEMUs <- upSample(x = treinoENEM[, -ncol(treinoENEM)], y = treinoENEM$notaDisc) 31 | table(treinoENEMUs$Class) 32 | -------------------------------------------------------------------------------- /scripts/transformacao/mais_fatores.R: -------------------------------------------------------------------------------- 1 | pacman::p_load( 2 | #ETL 3 | janitor, 4 | # DISCRETIZAÇÃO 5 | ade4, 6 | arules, 7 | # FATORES 8 | forcats) 9 | 10 | facebook <- read.table( 11 | "https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/master/bases_originais/dataset_Facebook.csv", 12 | sep=";", 13 | header = T) 14 | 15 | str(facebook) 16 | 17 | # conversão em fatores 18 | 19 | for(i in 2:7) { 20 | facebook[,i] <- as.factor(facebook[,i]) } 21 | 22 | facebook %>% str() 23 | 24 | # filtro por tipo de dado 25 | 26 | factorsFacebook <- unlist(lapply(facebook, is.factor)) 27 | facebookFactor <- facebook[ , factorsFacebook] 28 | str(facebookFactor) 29 | 30 | # One Hot Encoding 31 | facebookDummy <- facebookFactor %>% acm.disjonctif() 32 | 33 | # Discretização 34 | inteirosFacebook <- unlist(lapply(facebook, is.integer)) 35 | facebookInteiros <- facebook[, inteirosFacebook] 36 | facebookInteiros %>% str() 37 | 38 | facebookInteiros$Page.total.likes.Disc <- discretize(facebookInteiros$Page.total.likes, method = "interval", breaks = 3, labels = c("poucos", 'médio', 'muitos')) 39 | 40 | facebookInteiros <- facebookInteiros %>% clean_names() # simplifica nomes usando janitor 41 | 42 | facebookInteiros %>% names() 43 | 44 | # forcats - usando tidyverse para fatores 45 | fct_count(facebookFactor$Type) # conta os fatores 46 | 47 | fct_anon(facebookFactor$Type) # anonimiza os fatores 48 | 49 | fct_lump(facebookFactor$Type, n = 1) # reclassifica os fatores em mais comum e outros 50 | 51 | -------------------------------------------------------------------------------- /scripts/analise/associacoes_comparadas.R: -------------------------------------------------------------------------------- 1 | ### CARREGAR PACOTES 2 | pacman::p_load(ccaPP, lsa, minerva, Rfast) 3 | 4 | ### CRIAR FUNÇÃO PARA RODAR VÁRIAS ASSOCIAÇÕES 5 | multi.cor <- function(x, y) { 6 | corr = cor(x, y) # Correlação 7 | corrD = dcor(x, y) # Distance correlation 8 | cos = cosine(x, y) # Distância do Cosseno 9 | maxCor = maxCorProj(x, y) # Maximal correlation 10 | MIC = mine(x, y) # Maximal Information Coefficient 11 | Associações = as.data.frame(list(corr, corrD[4], cos, maxCor[1], MIC[1])) 12 | names(Associações) = c('Correlação', 'Distãncia', 'Cosseno', 'Máxima', 'MIC') 13 | return(Associações) 14 | } 15 | 16 | ### EXEMPLO 1 LINEAR 17 | x <- runif(1000, 0, 10) 18 | y <- 5 - 1.7*x 19 | 20 | plot(x, y) # Plotar o gráfico 21 | 22 | corList <- multi.cor(x, y) 23 | corList 24 | 25 | ### EXEMPLO 1.1 LINEAR 26 | y1 <- y - runif(1000, 0, 1) 27 | 28 | plot(x, y1) 29 | 30 | corList1 <- multi.cor(x, y1) 31 | corList1 32 | 33 | ### EXEMPLO 1.2 LINEAR 34 | y2 <- y - runif(1000, 0, 2) 35 | 36 | plot(x, y2) 37 | 38 | corList2 <- multi.cor(x, y2) 39 | corList2 40 | 41 | ### EXEMPLO 2 QUADRÁTICA 42 | k <- runif(1000, -10, 10) 43 | l <- 5 - 1.7*k + k^2 44 | 45 | plot(k, l) 46 | 47 | corList <- multi.cor(k, l) 48 | corList 49 | 50 | ### EXEMPLO 2.1 QUADRÁTICA 51 | l1 <- l - runif(1000, -1, 1) 52 | 53 | plot(k, l1) 54 | 55 | corList3 <- multi.cor(k, l1) 56 | corList3 57 | 58 | ### EXEMPLO 2.2 QUADRÁTICA 59 | l2 <- l - runif(1000, -2, 2) 60 | 61 | plot(k, l2) 62 | 63 | corList4 <- multi.cor(k, l2) 64 | corList4 65 | -------------------------------------------------------------------------------- /scripts/app/pareamento_educacao.R: -------------------------------------------------------------------------------- 1 | #### pacotes ---- 2 | pacman::p_load(cobalt, data.table, MatchIt, tidyverse) 3 | 4 | #### etl ---- 5 | escolas_integrais <- fread( 6 | 'bases_tratadas/idepe_par.csv', 7 | dec = ',', 8 | encoding = 'UTF-8') %>% 9 | mutate( 10 | TP_LOCALIZACAO = as.factor(TP_LOCALIZACAO) 11 | ) 12 | 13 | escolas_integrais %>% glimpse() 14 | 15 | escolas_integrais %>% 16 | count(ano, tratamento) 17 | 18 | escolas_integrais_2008 <- escolas_integrais %>% 19 | filter(ano == 2008) 20 | 21 | #### pareamento ---- 22 | pareamento_integrais <- matchit( 23 | tratamento ~ tdi_3em + TP_LOCALIZACAO + IN_INTERNET + IN_NOTURNO + IN_EJA, 24 | data = escolas_integrais_2008, 25 | method = "nearest" 26 | ) 27 | 28 | #### diagnóstico ---- 29 | # combinar dados 30 | integrais_pareadas <- match.data(pareamento_integrais) 31 | 32 | # análise gráfica do ajuste 33 | love.plot(pareamento_integrais) 34 | 35 | # análise gráfica da sobreposição 36 | plot(pareamento_integrais, type = "histogram") 37 | 38 | ggplot(integrais_pareadas, aes(x = distance, fill = as.factor(tratamento))) + 39 | geom_density(alpha = 0.5) + 40 | scale_fill_manual(values = c("red", "blue"), 41 | labels = c("Controle", "Tratado")) + # Cores 42 | labs( 43 | title = "Distribuição dos Escores de Propensão", 44 | x = "Escore de Propensão", 45 | y = "Densidade", 46 | fill = "Grupo" 47 | ) + 48 | theme_minimal() + 49 | theme(plot.title = element_text(hjust = 0.5)) 50 | 51 | # análise numérica do ajuste 52 | summary(pareamento_integrais)$sum.matched -------------------------------------------------------------------------------- /scripts/etl/extracoes_basicas.R: -------------------------------------------------------------------------------- 1 | # extrair / carregar arquivos texto 2 | 3 | # arquivos de texto com read.table 4 | census_income <- read.table("https://archive.ics.uci.edu/ml/machine-learning-databases/adult/adult.data", header = FALSE, sep = ',', dec = '.', col.names = c('age', 'workclass', 'fnlwgt', 'education', 'education-num', 'marital-status', 'occupation', 'relationship', 'race', 'sex', 'capital-gain', 'capital-loss', 'hours-per-week', 'native-country', 'class') 5 | ) 6 | # arquivos de texto com read.csv2 7 | sinistrosRecife2019Raw <- read.csv2('http://dados.recife.pe.gov.br/dataset/44087d2d-73b5-4ab3-9bd8-78da7436eed1/resource/3531bafe-d47d-415e-b154-a881081ac76c/download/acidentes-2019.csv', sep = ';', encoding = 'UTF-8' 8 | ) 9 | 10 | # também é possível usar a função read.delim2 11 | 12 | # arquivos de excel 13 | # install.packages('readxl') 14 | library(readxl) 15 | 16 | surveyCovidMun <- read_excel('bases_originais/Dataset_Port_and_Eng.xlsx', sheet=1) 17 | 18 | # arquivos json 19 | # install.packages('rjson') 20 | library(rjson) 21 | 22 | empresasMetadados <- fromJSON(file= "http://dados.recife.pe.gov.br/dataset/eb9b8a72-6e51-4da2-bc2b-9d83e1f198b9/resource/b4c77553-4d25-4e3a-adb2-b225813a02f1/download/empresas-da-cidade-do-recife-atividades.json" ) 23 | 24 | empresasMetadados <- as.data.frame(empresasMetadados) 25 | 26 | # arquivos xml 27 | # install.packages('XML') 28 | library(XML) 29 | 30 | reedCollegeCourses <- xmlToDataFrame("http://aiweb.cs.washington.edu/research/projects/xmltk/xmldata/data/courses/reed.xml") 31 | -------------------------------------------------------------------------------- /scripts/machine_learning/regras_associaco_enem.R: -------------------------------------------------------------------------------- 1 | ##### Regras de Associação 2 | pacman::p_load( 3 | # ETL 4 | data.table, dplyr, janitor, 5 | # MACHINE LEARNING 6 | caret, 7 | # REGRAS DE ASSOCIAÇÃO 8 | arules, arulesCBA, arulesViz, 9 | # TABELAS 10 | reactablefmtr 11 | ) 12 | 13 | enem <- fread( 14 | 'https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/master/bases_tratadas/ENEM_REGRAS.csv', 15 | encoding = 'Latin-1', 16 | stringsAsFactors = T) %>% 17 | clean_names() 18 | 19 | enem <- enem %>% 20 | filter( 21 | v2 != 'tipo' 22 | ) %>% 23 | select( 24 | -c( 25 | v1 26 | ) 27 | ) 28 | 29 | names(enem) <- c( 30 | 'tipo', 'localizacao', 'ICG', 'INSE', 'TDI_EM', 'MHA_EM', 'REP_EM' 31 | ) 32 | 33 | regras_enem <- enem %>% 34 | apriori( 35 | parameter = list( 36 | supp = 0.2, 37 | conf = 0.5, 38 | minlen = 2, 39 | maxlen = 5)) 40 | 41 | quality(regras_enem) <- round(quality(regras_enem), digits = 3) 42 | 43 | regras_enem <- sort( 44 | regras_enem, 45 | by="lift") 46 | 47 | regras_enem_res <- regras_enem[!is.redundant(regras_enem, measure="lift")] 48 | 49 | inspect(regras_enem_res) 50 | 51 | regras_enem_df = data.frame( 52 | lhs = labels(lhs(regras_enem_res)), 53 | rhs = labels(rhs(regras_enem_res)), 54 | regras_enem_res@quality) 55 | 56 | regras_enem_df %>% 57 | write.csv2('regras_enem.csv') 58 | 59 | reactable( 60 | regras_enem_df, 61 | defaultColDef = colDef(cell = data_bars( 62 | regras_enem_df, 63 | text_position = 'outside-base')), 64 | pagination = F 65 | ) 66 | -------------------------------------------------------------------------------- /scripts/machine_learning/regressao_ENEM.R: -------------------------------------------------------------------------------- 1 | # carrega as bibliotecas 2 | pacman::p_load(car, caret, corrplot, data.table, dplyr, forcats, funModeling, mltools) 3 | 4 | # Github 5 | ENEM_ESCOLA_2019 <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/etl_com_r/master/bases_tratadas/ENEM_ESCOLA_2019.csv', stringsAsFactors = T) # carregando a base já tratada para o ambiente do R 6 | 7 | # AED 8 | status(ENEM_ESCOLA_2019) # explorar a qualidade das variáveis 9 | freq(ENEM_ESCOLA_2019) # explorar os fatores 10 | plot_num(ENEM_ESCOLA_2019) # exploração das variáveis numéricas 11 | profiling_num(ENEM_ESCOLA_2019) # estatísticas das variáveis numéricas 12 | 13 | # Pré-processamento 14 | particaoENEM = createDataPartition(1:nrow(ENEM_ESCOLA_2019), p=.7) # cria a partição 70-30 15 | treinoENEM = ENEM_ESCOLA_2019[particaoENEM$Resample1, ] # treino 16 | testeENEM = ENEM_ESCOLA_2019[-particaoENEM$Resample1, ] # - treino = teste 17 | 18 | # regressão 19 | ENEM_LM <- lm(media ~ tipo + MED_CAT_0 + MED_01_CAT_0 + MED_02_CAT_0 + TDI_03 + MED_MHA + MED_01_MHA + MED_02_MHA + MHA_03, data = treinoENEM) 20 | 21 | summary(ENEM_LM) 22 | 23 | corrplot(cor(treinoENEM[ , c(4:12)])) 24 | 25 | ENEM_LM <- lm(media ~ tipo + MED_CAT_0 + MED_MHA, data = treinoENEM) 26 | 27 | summary(ENEM_LM) 28 | 29 | plot(ENEM_LM$residuals, pch = 16, col = "red") 30 | 31 | plot(cooks.distance(ENEM_LM), pch = 16, col = "blue") 32 | 33 | predicaoLM = predict(ENEM_LM, testeENEM) 34 | 35 | postResample(testeENEM[ , 4], predicaoLM) 36 | 37 | save(ENEM_LM, file = "modelos/ENEM_LM.RData") # salvar e exportar modelos 38 | -------------------------------------------------------------------------------- /scripts/etl/carga_incremental.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | 3 | # carrega base de dados original 4 | chamadosTempoReal <- read.csv2('http://dados.recife.pe.gov.br/dataset/99eea78a-1bd9-4b87-95b8-7e7bae8f64d4/resource/079fd017-dfa3-4e69-9198-72fcb4b2f01c/download/sedec_chamados_tempo_real.csv', sep = ';', encoding = 'UTF-8') 5 | 6 | chamadosTempoReal <- chamadosTempoReal[-3,] 7 | 8 | # carrega base de dados para atualização 9 | chamadosTempoRealNew <- read.csv2('http://dados.recife.pe.gov.br/dataset/99eea78a-1bd9-4b87-95b8-7e7bae8f64d4/resource/079fd017-dfa3-4e69-9198-72fcb4b2f01c/download/sedec_chamados_tempo_real.csv', sep = ';', encoding = 'UTF-8') 10 | 11 | # compara usando a chave primária 12 | chamadosTempoRealIncremento <- (!chamadosTempoRealNew$processo_numero %in% chamadosTempoReal$processo_numero) 13 | 14 | # compara usando a chave substituta 15 | # criar a chave substituta 16 | chamadosTempoReal$chaveSubstituta = apply(chamadosTempoReal[, c(4,5)], MARGIN = 1, FUN = function(i) paste(i, collapse = "")) 17 | 18 | chamadosTempoRealNew$chaveSubstituta = apply(chamadosTempoRealNew[, c(4,5)], MARGIN = 1, FUN = function(i) paste(i, collapse = "")) 19 | 20 | # cria base de comparação 21 | chamadosTempoRealIncremento <- (!chamadosTempoRealNew$chaveSubstituta %in% chamadosTempoReal$chaveSubstituta) 22 | 23 | # comparação linha a linha 24 | setdiff(chamadosTempoRealNew, chamadosTempoReal) 25 | 26 | # retorna vetor com incremento 27 | chamadosTempoReal[chamadosTempoRealIncremento,] 28 | 29 | # junta base original e incremento 30 | chamadosTempoReal <- rbind(chamadosTempoReal, chamadosTempoReal[chamadosTempoRealIncremento,]) 31 | -------------------------------------------------------------------------------- /scripts/rmarkdown/escolas_integrais.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Escolas Integrais em Pernambuco" 3 | output: html_document 4 | --- 5 | 6 | ```{r setup, include=FALSE} 7 | knitr::opts_chunk$set(echo = TRUE) 8 | 9 | pacman::p_load(data.table, dplyr, leaflet, leaflet.extras, leaflet.minicharts, plotly, rgdal, tidyr) # carregar os pacotes 10 | 11 | escolas_integrais <- fread('https://raw.githubusercontent.com/hugoavmedeiros/cp_com_r/master/bases_tratadas/escolas_tempo_integral_v2.csv', dec = ',', encoding = 'Latin-1') # carregar a base de dados 12 | 13 | escolas_integrais$nome_escola <- as.factor(escolas_integrais$nome_escola) # conversão de dados 14 | 15 | escolas_integrais_agg <- escolas_integrais %>% group_by(nome_escola, lat, lon, .drop=FALSE) %>% summarise(n = n()) %>% na.omit() 16 | 17 | escolas_integrais_ano <- escolas_integrais %>% group_by(ano_implantacao) %>% summarise(n = n()) %>% mutate(n_ant = lag(n, 10L)) 18 | 19 | ``` 20 | 21 | ## Evolução da Rede Integral 22 | 23 | ### Série Histórica 24 | 25 | ```{r sh, echo=FALSE, warning=FALSE, message=FALSE} 26 | 27 | plot_ly(escolas_integrais_ano, x = ~ano_implantacao) %>% add_trace(y = ~n_ant, name = 'década anterior', mode = 'lines+markers') %>% add_trace(y = ~n, name = 'ano', mode = 'lines+markers') 28 | 29 | ``` 30 | 31 | ### Mapa Interativo 32 | 33 | ```{r mi, echo=FALSE, warning=FALSE, message=FALSE} 34 | 35 | leaflet(escolas_integrais_agg) %>% addTiles() %>% addMarkers( 36 | clusterOptions = markerClusterOptions(), 37 | ~lon, 38 | ~lat, 39 | popup = ~as.character(nome_escola), 40 | label = ~as.character(nome_escola) 41 | ) %>% addFullscreenControl() 42 | 43 | ``` 44 | 45 | -------------------------------------------------------------------------------- /scripts/datas/intro_datas_tempos.R: -------------------------------------------------------------------------------- 1 | # Conversão para data 2 | (str(minhaData1 <- as.Date(c("2015-10-19 10:15", "2009-12-07 19:15")) ) ) 3 | # Conversão é robusta até com lixo no dado 4 | (str(minhaData2 <- as.Date(c("2015-10-19 Hello", "2009-12-07 19:15")) ) ) 5 | unclass(minhaData2) 6 | 7 | # Conversão para POSIXct 8 | (str(minhaData3 <- as.POSIXct(c("2015-10-19 10:15", "2009-12-07 19:15")) ) ) 9 | unclass(minhaData3) # observamos o POSIXct no formato original (segundos) 10 | 11 | # Conversão para POSIXlt 12 | (str(minhaData4 <- as.POSIXlt(c("2015-10-19 10:15", "2009-12-07 19:15")) ) ) 13 | unclass(minhaData4) # observamos o POSIXlt no formato original (componentes de tempo) 14 | 15 | ### Extrações de Componentes 16 | library(lubridate) 17 | 18 | year(minhaData4) # ano 19 | 20 | month(minhaData4) # mês 21 | 22 | month(minhaData4, label = T) # mês pelo nome usando label = T 23 | 24 | wday(minhaData4, label = T, abbr = T) # dia da semana abreviado 25 | 26 | isoweek(minhaData4) # semana ISO 8601 27 | 28 | epiweek(minhaData4) # semana epidemiológica 29 | 30 | ### Operações 31 | 32 | (minhaSequencia <- seq(as.Date('2009-12-07 19:15'), as.Date('2015-10-19 10:15'), by = "day") ) # sequência usando a ideia de intervalo e de período 33 | 34 | minhaData4 + minutes(90) # período 35 | 36 | minhaData4 + dminutes(90) # duração 37 | 38 | meuIntervalo <- as.interval(minhaData4[2], minhaData4[1]) # transforma em intervalo 39 | 40 | now() %within% meuIntervalo # investiga se está dentro do intervalo 41 | 42 | table( (minhaSequencia + years(1) ) %within% meuIntervalo ) # observa se a frequência de casos da sequência 1 ano na frente que estão dentro do intervalo 43 | -------------------------------------------------------------------------------- /scripts/machine_learning/regras_associacao_ENEM.R: -------------------------------------------------------------------------------- 1 | ### Regras de Associação 2 | pacman::p_load( 3 | arules, arulesCBA, arulesViz, caret, dplyr 4 | ) 5 | 6 | # Github 7 | ENEM_ESCOLA_2019 <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/etl_com_r/master/bases_tratadas/ENEM_ESCOLA_2019.csv', stringsAsFactors = T) # carregando a base já tratada para o ambiente do R 8 | 9 | ENEM_ESCOLA_2019 <- ENEM_ESCOLA_2019 %>% select(id, tipo, nota, TDI_03, MHA_03) # selecionando variáveis de interesse 10 | 11 | # Pré-processamento de variáveis 12 | ENEM_ESCOLA_2019[ , -c(1:2)] <- discretizeDF(ENEM_ESCOLA_2019[ , -c(1:2)]) # transforma variáveis numéricas em fatores 13 | 14 | associacaoENEM <- apriori( 15 | ENEM_ESCOLA_2019[ , -1], 16 | parameter = list(supp = 0.2, conf = 0.5, maxlen = 10)) 17 | 18 | summary(associacaoENEM) 19 | 20 | inspect(associacaoENEM) 21 | 22 | associacaoENEMPrin <- head(associacaoENEM, n = 10, by = "lift") 23 | 24 | plot(associacaoENEMPrin, method = "paracoord") 25 | 26 | plot(head(sort(associacaoENEMPrin, by = "lift"), 10), method = "graph") 27 | 28 | # Pré-processamento de base 29 | particaoENEM = createDataPartition(1:nrow(ENEM_ESCOLA_2019), p=.7) # cria a partição 70-30 30 | treinoENEM = ENEM_ESCOLA_2019[particaoENEM$Resample1, ] # treino 31 | testeENEM = ENEM_ESCOLA_2019[-particaoENEM$Resample1, ] # - treino = teste 32 | 33 | treinoENEM <- treinoENEM[ , -1] 34 | testeENEM <- testeENEM[ , -1] 35 | 36 | # Modelagem 37 | regrasENEM = arulesCBA::CBA(nota ~ ., treinoENEM, supp=0.2, conf=0.5) 38 | 39 | inspect(regrasENEM$rules) 40 | 41 | plot(regrasENEM$rules) 42 | 43 | predicaoRegrasENEM <- predict(regrasENEM, testeENEM) 44 | 45 | confusionMatrix(predicaoRegrasENEM, testeENEM$nota) 46 | -------------------------------------------------------------------------------- /scripts/rmarkdown/facebook.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "facebook" 3 | output: html_document 4 | --- 5 | 6 | ```{r setup, include=FALSE} 7 | # carregar as bibliotecas 8 | pacman::p_load(cluster, ggplot2) 9 | 10 | # pré-processamento 11 | iris_cluster <- iris[ , -5] 12 | str(iris_cluster) 13 | 14 | # setar semente aleatória 15 | set.seed(1) 16 | 17 | # Agrupamento com kmeans 18 | cls <- kmeans(x = iris_cluster, centers = 3) # aprendizagem ns 19 | iris_cluster$cluster <- as.factor(cls$cluster) # passamos os clusters para a base original 20 | head(iris_cluster) 21 | ``` 22 | 23 | # Análise dos dados do facebook 24 | ## AED 25 | 26 | Abaixo, você encontra o agrupamento da base de dados Iris, usando a técnica de k-means. 27 | 28 | ```{r iris} 29 | ggplot() + 30 | geom_point(data = iris_cluster, 31 | mapping = aes(x = Sepal.Length, 32 | y = Petal.Length, 33 | colour = cluster)) + 34 | geom_point(mapping = aes_string(x = cls$centers[ , "Sepal.Length"], 35 | y = cls$centers[ , "Petal.Length"]), 36 | color = "red", size = 4) + 37 | geom_text(mapping = aes_string(x = cls$centers[ , "Sepal.Length"], 38 | y = cls$centers[ , "Petal.Length"], 39 | label = 1:3), 40 | color = "white", size = 2) + 41 | theme_light() 42 | ``` 43 | 44 | Observe que existe um cluster (nro 1) bastante separados dos outros. Alguns pontos desses dois clusters (nro 2 e nro 3) são semelhantes, dificultando a aprendizagem da máquina 45 | 46 | ## Modelo Preditivo (RF) 47 | 48 | ## K-means 49 | 50 | ## Prescrição 51 | 52 | ### Post com mais interações positivas 53 | 54 | ### Post com mais interações negativas -------------------------------------------------------------------------------- /scripts/rmarkdown/escolas_integrais_animacao.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Escolas Integrais em Pernambuco" 3 | output: html_document 4 | --- 5 | 6 | ```{r setup, include=FALSE} 7 | knitr::opts_chunk$set(echo = TRUE) 8 | 9 | pacman::p_load(data.table, dplyr, leaflet, leaflet.extras, leaflet.minicharts, plotly, rgdal, tidyr) # carregar os pacotes 10 | 11 | escolas_integrais <- fread('https://raw.githubusercontent.com/hugoavmedeiros/cp_com_r/master/bases_tratadas/escolas_tempo_integral_v2.csv', encoding = 'Latin-1', dec = ',') # carregar a base de dados 12 | 13 | escolas_integrais$nome_escola <- as.factor(escolas_integrais$nome_escola) # conversão de dados 14 | 15 | escolas_integrais_agg <- escolas_integrais %>% group_by(nome_escola, ano_implantacao, .drop=FALSE) %>% summarise(n = n()) %>% na.omit() 16 | # %>% complete(ano_implantacao, nome_escola, fill = list(n = 0)) %>% filter(nome_escola != '') %>% distinct() 17 | 18 | escolas_integrais_agg <- merge(escolas_integrais_agg, escolas_integrais, by = 'nome_escola') %>% select(!ano_implantacao.y) %>% distinct() 19 | 20 | escolas_integrais_ano <- escolas_integrais %>% group_by(ano_implantacao) %>% summarise(n = n()) %>% mutate(n_ant = lag(n, 10L)) 21 | 22 | ``` 23 | 24 | ## Evolução da Rede Integral 25 | 26 | ### Série Histórica 27 | 28 | ```{r sh, echo=FALSE, warning=FALSE, message=FALSE} 29 | 30 | plot_ly(escolas_integrais_ano, x = ~ano_implantacao) %>% add_trace(y = ~n_ant, name = 'década anterior', mode = 'lines+markers') %>% add_trace(y = ~n, name = 'ano', mode = 'lines+markers') 31 | 32 | ``` 33 | 34 | ### Mapa Interativo 35 | 36 | ```{r mi, echo=FALSE, warning=FALSE, message=FALSE} 37 | 38 | leaflet(escolas_integrais_agg) %>% addTiles() %>% 39 | addMarkers(~lon, ~lat) %>% 40 | addFullscreenControl() 41 | 42 | ``` 43 | 44 | -------------------------------------------------------------------------------- /scripts/app/instrumentos_educacao.R: -------------------------------------------------------------------------------- 1 | #### pacotes --- 2 | pacman::p_load(AER, coefplot) 3 | 4 | # importa os dados de distância até a escola 5 | data("CollegeDistance") 6 | 7 | #passa os dados para um objeto 8 | cd.d <- CollegeDistance 9 | 10 | #regress?o com educa??o 11 | simple.lm.1s <- simple.ed.2s <- lm(wage ~ urban + gender + ethnicity + unemp + 12 | education , data=cd.d) 13 | summary(simple.lm.1s) 14 | 15 | #regressão de educa??o com base na dist?ncia 16 | simple.ed.1s <- lm(education ~ distance, data=cd.d) 17 | summary(simple.ed.1s) 18 | 19 | #cria nov atributo = predição do atributo educacão com base na dist?ncia 20 | cd.d$ed.pred <- predict(simple.ed.1s) 21 | 22 | #2? regressão, com a variável criada anteriormente 23 | simple.ed.2s <- lm(wage ~ urban + gender + ethnicity + unemp + ed.pred , data=cd.d) 24 | summary(simple.ed.2s) 25 | 26 | # usa função encomptest para testar qual dos dois modelos é melhor: com 1 passo ou com 2 27 | simple.comp <- encomptest( 28 | wage ~ urban + gender + ethnicity + unemp + ed.pred, 29 | wage ~ urban + gender + ethnicity + unemp + education, data=cd.d) 30 | simple.comp 31 | 32 | # testa qual dos dois modelos é melhor: prever educação pela distância ou pelo vetor gênero, etnia e urbanidade 33 | ftest<- encomptest( 34 | education ~ tuition + gender + ethnicity + urban, 35 | education ~ distance, data=cd.d) 36 | ftest 37 | 38 | #usa função coefplot para plotar os coeficientes da regressão direta (sem VI), que considera a educação sem impacto 39 | coefplot(simple.lm.1s, vertical=FALSE,var.las=1, 40 | varnames=c("Education","Unemp","Hispanic","Af-am","Female","Urban","Education")) 41 | 42 | #usa função coefplot para plotar os coeficientes da regress?o direta (com VI), que mostra o impacto da educa??o 43 | coefplot(simple.ed.2s) 44 | -------------------------------------------------------------------------------- /scripts/programacao/index_operadores_logicos.R: -------------------------------------------------------------------------------- 1 | # vetores 2 | poissonSimulacao[1] # acessa o primeiro elemento 3 | poissonSimulacao[c(1:10, 15)] # acessa os elementos 1, 2 até 10 e 15 4 | 5 | # matrizes 6 | matrix1[1, ] # linha 1 7 | matrix1[ ,1] # coluna 1 8 | matrix1[1,1] # linha 1, coluna 1 9 | 10 | # data.frames 11 | iris$Species # retorna apenas a coluna species do data.frame iris 12 | 13 | iris[ , 5] # retorna todas as linhas apenas a coluna species do data.frame iris 14 | 15 | iris[1:10, 2:5] # retorna as 10 primeiras linhas das colunas 2 a 5 do data.frame iris 16 | 17 | iris[, 'Species'] # retorna a coluna espécies, indexada pelo nome 18 | 19 | iris[, 'Species', drop = FALSE] # retorna a coluna espécies, indexada pelo nome, em formato de coluna 20 | 21 | iris[ , -5] # retorna todas as colunas, menos a 5 - espécies 22 | 23 | # listas 24 | regCarros$coefficients 25 | regCarros$coefficients[1] 26 | regCarros[['coefficients']][1] 27 | regCarros[[1]][1] 28 | 29 | # usando operadores lógicos 30 | a <- 5 31 | b <- 7 32 | c <- 5 33 | 34 | a < b 35 | a <= b 36 | a > b 37 | a >= b 38 | a == b 39 | a != b 40 | 41 | a %in% c(b, c) 42 | a == c & a < b 43 | a != c | a > b 44 | xor(a != c, a < b) 45 | !a != c 46 | any(a != c, a < c, a == c) 47 | all(a != c, a < c, a == c) 48 | 49 | # operadores lógicos na prática 50 | iris$Sepal.Length <= 0 # testa se os valores na sepal.length são menores ou iguais a 0 51 | 52 | iris$Sepal.Length >= 0 & iris$Sepal.Width <= 0.2 # testa se, numa dada linha, os valores na sepal.length são menores ou iguais a 0 OU se os valores em sepal.width são iguais ou menores que 0.2 53 | 54 | which(iris$Sepal.Length <= 5) # a função which mostra a posição (as linhas) em que a condição é atendida 55 | 56 | match(iris$Species, 'setosa') # também é possível usar a função match para encontrar a correspondência entre dados ou objetos 57 | 58 | -------------------------------------------------------------------------------- /scripts/machine_learning/arvores_decisao_introducao.R: -------------------------------------------------------------------------------- 1 | # pacotes 2 | pacman::p_load( 3 | caret, ggplot2, plotly, rattle 4 | ) 5 | 6 | # Github 7 | ENEM_ESCOLA_2019 <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/etl_com_r/master/bases_tratadas/ENEM_ESCOLA_2019.csv', stringsAsFactors = T) # carregando a base já tratada para o ambiente do R 8 | 9 | ENEM_ESCOLA_2019 <- ENEM_ESCOLA_2019 %>% dplyr::filter(tipo != 'Privada') 10 | 11 | set.seed(3) 12 | 13 | # Pré-processamento 14 | particaoENEM = createDataPartition(1:nrow(ENEM_ESCOLA_2019), p=0.7) # cria a partição 70-30 15 | treinoENEM = ENEM_ESCOLA_2019[particaoENEM$Resample1, ] # treino 16 | testeENEM = ENEM_ESCOLA_2019[-particaoENEM$Resample1, ] # - treino = teste 17 | 18 | # Controle de treinamento 19 | train.control <- trainControl(method = "cv", number = 100, verboseIter = T) # controle de treino 20 | 21 | # Mineração e predição com Árvores de Decisão 22 | ## Árvore de Decisão 23 | ENEM_RPART <- train( 24 | nota ~ tipo + localizacao + ICG + TDI_03 + MHA_03 + REP_EM, 25 | data = treinoENEM, 26 | method = "rpart", 27 | trControl = train.control, 28 | tuneGrid = expand.grid(cp = c(0.00362, runif(19, 0, 0.25))) 29 | # , tuneLength = 20 30 | ) 31 | 32 | plot(ENEM_RPART) 33 | 34 | fancyRpartPlot(ENEM_RPART$finalModel) # desenho da árvore 35 | 36 | plot(varImp(ENEM_RPART)) # importância das variáveis 37 | 38 | predicaoTree = predict(ENEM_RPART, newdata = testeENEM) 39 | 40 | postResample(testeENEM[ , 7], predicaoTree) # teste de performance da Árvore Condicional 41 | 42 | base_avaliacao <- data.frame( 43 | Observado = testeENEM[ , 7], 44 | Predição = predicaoTree) 45 | 46 | predicao_arvore <- base_avaliacao %>% 47 | ggplot(aes(x=Observado, y=Predição)) + 48 | geom_point() + # cria os pontos 49 | geom_smooth() # cria a curva de associação 50 | ggplotly(predicao_arvore) 51 | -------------------------------------------------------------------------------- /scripts/app/rdd_reforco.R: -------------------------------------------------------------------------------- 1 | #### pacotes ---- 2 | pacman::p_load(data.table, ggcorrplot, rdd, tidyverse) 3 | 4 | corte = 3.2 5 | 6 | #### etl ---- 7 | escolas_reforco <- fread( 8 | 'bases_tratadas/idepe_rdd.csv', 9 | dec = ',', 10 | encoding = 'UTF-8') %>% 11 | mutate( 12 | TP_RURAL = ifelse(TP_LOCALIZACAO == "Rural", 1, 0), 13 | tratamento = ifelse(idepe_2014 > corte, 0, 1) 14 | ) 15 | 16 | escolas_reforco %>% glimpse() 17 | 18 | escolas_reforco %>% 19 | count(ano, tratamento) 20 | 21 | #### regressão descontínua ---- 22 | mc_test <- DCdensity( 23 | escolas_reforco$idepe_2014, 24 | cutpoint = corte) 25 | 26 | mc_test 27 | 28 | covariaveis <- escolas_reforco %>% 29 | select(tdi_3em, TP_RURAL, IN_NOTURNO, IN_EJA, IN_INTERNET) 30 | 31 | # Calcular a matriz de correlação 32 | matriz_correlacao <- cor(covariaveis, use = "complete.obs") 33 | 34 | ggcorrplot( 35 | matriz_correlacao, 36 | type = "full", 37 | lab = TRUE, 38 | title = "Matriz de Correlação das Covariáveis" 39 | ) 40 | 41 | #### rdd --- 42 | escolas_rdd_padrao <- RDestimate( 43 | idepe_2015 ~ idepe_2014, 44 | data = escolas_reforco, 45 | cutpoint = corte) 46 | 47 | summary(escolas_rdd_padrao) 48 | 49 | escolas_rdd_cov <- RDestimate( 50 | idepe_2015 ~ idepe_2014 | tdi_3em + TP_RURAL + IN_NOTURNO + IN_EJA + IN_INTERNET + tp_escola, 51 | data = escolas_reforco, 52 | cutpoint = corte) 53 | 54 | summary(escolas_rdd_cov) 55 | 56 | ggplot(escolas_reforco, aes(x = idepe_2014, y = idepe_2015, color = as.factor(tratamento))) + 57 | geom_point(alpha = 0.6) + 58 | geom_smooth(method = "loess") + 59 | geom_vline(xintercept = corte, linetype = "dashed", color = "red") + 60 | labs( 61 | title = "Visualização da Regressão Descontínua", 62 | x = "IDEP de 2014 (Running Variable)", 63 | y = "IDEP de 2015 (Desfecho)", 64 | color = "Grupo" 65 | ) + 66 | theme_minimal() 67 | -------------------------------------------------------------------------------- /scripts/machine_learning/classificacao_metricas.R: -------------------------------------------------------------------------------- 1 | # Matriz de Confusão: matriz que relaciona as classes observadas (também chamadas de referência) e as classes preditas. Para melhor interpretação, oferece várias estatísticas auxiliares. Vamos ver as principais delas 2 | # Accuracy (Acc) = Acuidade, ou performance geral do modelo - total de acertos, sem considerar nenhuma penalidade ou ajuste 3 | # No Information Rate (NIR) = proporção da classe mais frequente - indica o quão a classe mais frequente está presente nos dados. É um valor de referência para compararmos com a acuidade, uma vez que o modelo poderia ganhar performance artificialmente aprendendo a sempre "chutar" na classe mais frequente. É oferecido também um teste de hipótese para verificar a hipótese de que a Acc é maior que o NIR. 4 | # Kappa = coeficiente kappa de Cohen - em geral, mede a concordância de duas classificações. No caso de ML, tem a ver com a estimativa de acuidade controlada pela possibilidade de classificação aleatória. Assim, permite saber se o modelo é bom, mesmo considerando a chance de "sortear" o resultado. 5 | 6 | predicaoENEM_RF_CLASS = predict(ENEM_RF_CLASS, testeENEM) # criar predição 7 | cmENEM_RF_CLASS <- confusionMatrix(predicaoENEM_RF_CLASS, testeENEM$nota) 8 | cmENEM_RF_CLASS 9 | cmENEM_RF_CLASS$table 10 | 11 | # Expected Accuracy (AccE) = Acuidade Esperada = estimativa de acuidade "esperada", ou seja, uma acuidade mínima que poderia ser conseguida simplesmente "chutando" a classe de forma aleatória. 12 | 13 | gtBaixa <- cmENEM_RF_CLASS$table[1]+cmENEM_RF_CLASS$table[2] 14 | gtAlta <- cmENEM_RF_CLASS$table[3]+cmENEM_RF_CLASS$table[4] 15 | 16 | pdBaixa <- cmENEM_RF_CLASS$table[1]+cmENEM_RF_CLASS$table[3] 17 | pdAlta <- cmENEM_RF_CLASS$table[2]+cmENEM_RF_CLASS$table[4] 18 | 19 | gtTotal <- gtAlta + gtBaixa 20 | 21 | estAcc <- (gtBaixa*pdBaixa/gtTotal^2)+(gtAlta*pdAlta/gtTotal^2) 22 | estAcc 23 | -------------------------------------------------------------------------------- /scripts/analise/regressao_basico.R: -------------------------------------------------------------------------------- 1 | ### CARREGANDO PACOTES ### 2 | pacman::p_load(car, gvlma, lm.beta, lmtest, MASS, sandwich) 3 | 4 | ### REGRESSÃO FERTILIDADE - BASE SWISS 5 | regSwiss <- lm(Fertility ~ ., data = swiss) # ESTIMANDO A REGRESSÃO 6 | summary(regSwiss) # SUMÁRIO 7 | regRSwiss <- rlm(Fertility ~ . -Examination, data = swiss) 8 | summary(regRSwiss) # SUMÁRIO 9 | lm.beta(regSwiss) # COEFICIENTES PADRONIZADOS 10 | 11 | # Stepwise # 12 | regSwissBack <- step(lm(Fertility ~ ., data = swiss), direction = 'backward') # de trás pra frente 13 | summary(regSwissBack) 14 | regSwissForw <- step(lm(Fertility ~ ., data = swiss), direction = 'forward') # do início pro fim 15 | summary(regSwissForw) 16 | regSwissBoth <- step(lm(Fertility ~ ., data = swiss), direction = 'both') # nos dois sentidos 17 | summary(regSwissBoth) 18 | 19 | ### VERIFICAÇÃO DOS PRESSUPOSTOS ### 20 | # normalidade dos resíduos 21 | shapiro.test(residuals(regSwiss)) 22 | par(mfrow=c(1,3)) 23 | plot(regSwiss, which=1, col=c("blue")) # resíduos x ajuste 24 | plot(regSwiss, which=2, col=c("red")) # Q-Q Plot 25 | plot(regSwiss, which=5, col=c("blue")) # Observações Influentes 26 | 27 | #= Correção seria retirar as observações influentes =# 28 | 29 | # inflação da variância / multicolinearidade 30 | vif(regSwiss) 31 | barplot(vif(regSwiss), main = "VIF Values", horiz = FALSE, col = "steelblue", ylim = c(0,5)) 32 | abline(h = 5, lwd = 3, lty = 2) 33 | 34 | #= Correção seria usar apenas uma das variáveis correlacionadas =# 35 | 36 | # homocedasticidade (H0 = homocedasticidade) 37 | bptest(regSwiss) # teste de homocedasticidade 38 | plot(regSwiss, which=3, col=c("blue")) # Scale-Location Plot 39 | 40 | #= Correção seria usar estimativas robustas =# 41 | regSwiss$robse <- vcovHC(regSwiss, type = "HC1") 42 | coeftest(regSwiss, regSwiss$robse) 43 | 44 | # 45 | regSwissRob <- rlm(Fertility ~ ., data = swiss) 46 | summary(regSwissBoth) 47 | -------------------------------------------------------------------------------- /scripts/transformacao/valores_ausentes_basico.R: -------------------------------------------------------------------------------- 1 | pacman::p_load(data.table, funModeling, tidyverse) 2 | 3 | idade <- c(floor(runif(70, 0, 80)), NA, NA) 4 | mean(idade) 5 | mean(idade, na.rm = TRUE) 6 | 7 | covid19PE <- fread('https://dados.seplag.pe.gov.br/apps/basegeral.csv') 8 | 9 | ## identificando e removendo valores ausentes 10 | status(covid19PE) # estrutura dos dados (missing etc) 11 | 12 | # Complete-case analysis – listwise deletion 13 | dim(covid19PECompleto <- na.omit(covid19PE)) # deixa apenas os casos completos, mas vale a pena? 14 | 15 | # Variação de Complete-case analysis – listwise deletion 16 | dim(covid19PECompleto <- covid19PE %>% filter(!is.na(faixa_etaria))) 17 | 18 | ## estimando se o NA é MCAR, MAR ou MANR 19 | ## Shadow Matrix do livro R in Action 20 | 21 | data(sleep, package = "VIM") # importa a base sleep 22 | 23 | head(sleep) # observa a base 24 | 25 | x <- as.data.frame(abs(is.na(sleep))) # cria a matrix sombra 26 | head(x) # observa a matriz sombra 27 | 28 | y <- x[which(sapply(x, sd) > 0)] # mantém apenas variáveis que possuem NA 29 | cor(y) # observa a correlação entre variáveis 30 | 31 | cor(sleep, y, use="pairwise.complete.obs") # busca padrões entre os valores específicos das variáveis e os NA 32 | 33 | ## Shadow Matrix da nossa base de covid19 com adaptações 34 | 35 | covid19PENA <- as.data.frame(abs(is.na(covid19PE))) # cria a matriz sombra da base de covid19 36 | 37 | covid19PENA <- covid19PENA[which(sapply(covid19PENA, sd) > 0)] # mantém variáveis com NA 38 | round(cor(covid19PENA), 3) # calcula correlações 39 | 40 | # modificação já que vão temos uma base numérica 41 | covid19PENA <- cbind(covid19PENA, municipio = covid19PE$municipio) # trazemos uma variável de interesse (municípios) de volta pro frame 42 | covid19PENAMun <- covid19PENA %>% group_by(municipio) %>% summarise(across(everything(), list(sum))) # sumarizamos e observamos se os NA se concentram nos municípios com mais casos 43 | -------------------------------------------------------------------------------- /scripts/machine_learning/arvores_decisao_ENEM.R: -------------------------------------------------------------------------------- 1 | # pacotes 2 | pacman::p_load( 3 | # ML 4 | caret, party, randomForest 5 | ) 6 | 7 | # Github 8 | ENEM_ESCOLA_2019 <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/etl_com_r/master/bases_tratadas/ENEM_ESCOLA_2019.csv', stringsAsFactors = T) # carregando a base já tratada para o ambiente do R 9 | 10 | # Pré-processamento 11 | particaoENEM = createDataPartition(1:nrow(ENEM_ESCOLA_2019), p=.7) # cria a partição 70-30 12 | treinoENEM = ENEM_ESCOLA_2019[particaoENEM$Resample1, ] # treino 13 | testeENEM = ENEM_ESCOLA_2019[-particaoENEM$Resample1, ] # - treino = teste 14 | 15 | # Mineração e predição com Árvores de Decisão 16 | cTreeENEM <- party::ctree(nota ~ tipo + ICG + TDI_03 + MHA_03, treinoENEM) # árvore de decisão com inferência condicional 17 | plot(cTreeENEM) # plot 18 | 19 | forestENEM = randomForest(treinoENEM[ , c(3, 5, 11, 15)], treinoENEM[ , 4], ntree = 100, keep.forest=T, keep.inbag = TRUE, importance=T) # floresta aleatória 20 | 21 | plot(forestENEM) 22 | 23 | varImp(forestENEM, scale = T) # importância de cada variável 24 | varImpPlot(forestENEM, type=2) # importância de cada variável 25 | 26 | predicaoForest = predict(forestENEM, testeENEM) # criar predição 27 | predicaoCTree = predict(cTreeENEM, testeENEM) # criar predição 28 | 29 | postResample(testeENEM[ , 4], predicaoForest) # teste de performance da Floresta Aleatória 30 | postResample(testeENEM[ , 4], predicaoCTree) # teste de performance da Árvore Condicional 31 | 32 | ## novos dados 33 | novosDados <- data.frame( 34 | ANO = as.integer(c(2019, 2019)), 35 | ID = as.integer(c(9999999, 9999999)), 36 | tipo = as.factor(c('Regular', 'Federal')), 37 | media = c(0,0), 38 | MED_CAT_0 = c(0,0), 39 | MED_01_CAT_0 = c(0,0), 40 | MED_02_CAT_0 =c(0,0), 41 | TDI_03 = c(23, 7), 42 | MED_MHA = c(0,0), 43 | MED_01_MHA = c(0,0), 44 | MED_02_MHA = c(0,0), 45 | MHA_03 = c(9, 8) 46 | ) 47 | levels(novosDados$tipo) <- levels(testeENEM$tipo) 48 | 49 | predict(forestENEM, novosDados) 50 | -------------------------------------------------------------------------------- /scripts/etl/etl_real.R: -------------------------------------------------------------------------------- 1 | pacman::p_load(dplyr) 2 | 3 | sinistrosRecife2019Raw <- read.csv2('http://dados.recife.pe.gov.br/dataset/44087d2d-73b5-4ab3-9bd8-78da7436eed1/resource/3531bafe-d47d-415e-b154-a881081ac76c/download/acidentes-2019.csv', sep = ';', encoding = 'UTF-8') 4 | 5 | # carrega a base de snistros de transito do site da PCR 6 | sinistrosRecife2020Raw <- read.csv2('http://dados.recife.pe.gov.br/dataset/44087d2d-73b5-4ab3-9bd8-78da7436eed1/resource/fc1c8460-0406-4fff-b51a-e79205d1f1ab/download/acidentes_2020-novo.csv', sep = ';', encoding = 'UTF-8') 7 | 8 | sinistrosRecife2021Raw <- read.csv2('http://dados.recife.pe.gov.br/dataset/44087d2d-73b5-4ab3-9bd8-78da7436eed1/resource/2caa8f41-ccd9-4ea5-906d-f66017d6e107/download/acidentes_2021-jan.csv', sep = ';', encoding = 'UTF-8') 9 | 10 | # junta as bases de dados com comando rbind (juntas por linhas) 11 | colunas_iguais <- names(sinistrosRecife2020Raw[ 12 | intersect( 13 | names(sinistrosRecife2020Raw), names(sinistrosRecife2021Raw))]) 14 | 15 | sinistrosRecife2020Raw <- sinistrosRecife2020Raw %>% select(all_of(colunas_iguais)) 16 | 17 | sinistrosRecifeRaw <- rbind(sinistrosRecife2020Raw, sinistrosRecife2021Raw) 18 | 19 | # observa a estrutura dos dados 20 | str(sinistrosRecifeRaw) 21 | 22 | # modifca a data para formato date 23 | sinistrosRecifeRaw$data <- as.Date(sinistrosRecifeRaw$data, format = "%Y-%m-%d") 24 | 25 | # modifica natureza do sinistro de texto para fator 26 | sinistrosRecifeRaw$natureza_acidente <- as.factor(sinistrosRecifeRaw$natureza_acidente) 27 | 28 | # cria função para substituir not available (na) por 0 29 | naZero <- function(x) { 30 | x <- ifelse(is.na(x), 0, x) 31 | } 32 | 33 | # aplica a função naZero a todas as colunas de contagem 34 | sinistrosRecifeRaw[, 15:25] <- sapply(sinistrosRecifeRaw[, 15:25], naZero) 35 | 36 | # exporta em formato nativo do R 37 | saveRDS(sinistrosRecifeRaw, "bases_tratadas/sinistrosRecife.rds") 38 | 39 | # exporta em formato tabular (.csv) - padrão para interoperabilidade 40 | write.csv2(sinistrosRecifeRaw, "bases_tratadas/sinistrosRecife.csv") 41 | -------------------------------------------------------------------------------- /scripts/etl/etl_real_defesa_br.R: -------------------------------------------------------------------------------- 1 | ## ETL ## 2 | ## Carregar pacotes que serão usados 3 | pacman::p_load(dplyr, data.table, readr, tidyr) 4 | 5 | ## Extrair base de dados de execução orçamentária da Defesa do Brasil, a partir de https://dados.gov.br/dados/conjuntos-dados/serie-historica 6 | 7 | defesaBrasil <- fread('bases_originais/10_serie_historica_global_da_execucao_orcamentaria_do_md_ate_abril_de_2023.csv', encoding = 'Latin-1', dec=",") 8 | 9 | ## Olhar a base para verificar necessidades de transformação 10 | View(defesaBrasil) 11 | str(defesaBrasil) 12 | 13 | ## Problemas identificados 14 | ## Na coluna "GRUPO DE DESPESA" há linha com TOTAIS que pode trazer erros para a análise 15 | ## Na Coluna "UNIDADE ORCAMENTARIA" há linhas com o TOTAL DO ÓRGÃO, as quais podem distorcar a análise 16 | ## A coluna dotação atual traz um dado que não dialoga com as outras colunas 17 | ## A base está orientada em wide, com os anos como colunas 18 | 19 | # para fazer as transformações de forma correta, vamos pegar os nomes das variáveis com a função names 20 | names(defesaBrasil) 21 | 22 | # Primeira transformação: retirar a coluna dotação e as linhas de TOTAL nas colunas "GRUPO DE DESPESA" e "UNIDADE ORCAMENTARIA" 23 | defesaBrasil <- defesaBrasil %>% select(-27) %>% filter(`GRUPO DE DESPESA` != 'TOTAL' & `UNIDADE ORCAMENTARIA` != 'MINISTERIO DA DEFESA - TOTAL DO ORGAO') 24 | 25 | # Segunda transformação: mudar de largo para longo 26 | defesaBrasilLong <- defesaBrasil %>% 27 | pivot_longer( 28 | cols = c(`EMPENHADO 2000`:`EMPENHADO 2023`), 29 | names_to = "Ano", 30 | values_to = "Valor" 31 | ) 32 | 33 | # Terceira transformação: deixar apenas números na nova coluna de Ano 34 | defesaBrasilLong$Ano <- parse_number(defesaBrasilLong$Ano) 35 | 36 | # Quarta transformação: modificar colunas de texto para fator 37 | defesaBrasilLong <- defesaBrasilLong %>% mutate_at(c('UNIDADE ORCAMENTARIA', 'GRUPO DE DESPESA'), as.factor) 38 | str(defesaBrasilLong) 39 | 40 | # Salvar a base tratada 41 | saveRDS(defesaBrasilLong, "bases_tratadas/orcamento_defesa_brasil.rds") 42 | 43 | -------------------------------------------------------------------------------- /scripts/etl/large_data_criacao.R: -------------------------------------------------------------------------------- 1 | # install.packages('data.table') 2 | pacman::p_load(data.table) 3 | 4 | casos= 2e7 # reduza os números antes e depois do e, caso esteja difícil de computar # mas tente manter pelo menos 1e6, para garantir o efeito se large data 5 | 6 | # cria o data.frame com o total de casos definido acima 7 | largeData = data.table( 8 | a = rpois(casos, 3), 9 | b = rbinom(casos, 1, 0.7), 10 | c = rnorm (casos), 11 | d = sample(c("fogo","agua","terra","ar"), casos, replace=TRUE), 12 | e = rnorm(casos), 13 | f = rpois(casos, 3), 14 | g = rnorm(casos)) 15 | 16 | object.size(largeData) # retorna o tamanho do objeto 17 | 18 | head(largeData) # vê as primeiras linhas 19 | 20 | write.table(largeData,"bases_originais/largeData.csv",sep=",",row.names=FALSE,quote=FALSE) # salva em disco 21 | 22 | ### base correlacionada ### 23 | # cria o data.frame com o total de casos definido acima 24 | a = rpois(casos, 3) 25 | e = rnorm(casos) 26 | 27 | largeData2 = data.table( 28 | a = a, 29 | b = 10 + 0.5*a, 30 | c = sqrt(a), 31 | d = sample(c("fogo","agua","terra","ar"), casos, replace=TRUE), 32 | e = e, 33 | f = a - e, 34 | g = e^2 +2*a) 35 | 36 | object.size(largeData2) # retorna o tamanho do objeto 37 | 38 | head(largeData2) # vê as primeiras linhas 39 | 40 | write_parquet(largeData2,"bases_originais/largeData2.parquet") # salva em disco 41 | 42 | # versão menor 43 | 44 | casos= 9e6 # reduza os números antes e depois do e, caso esteja difícil de computar # mas tente manter pelo menos 1e6, para garantir o efeito se large data 45 | 46 | # cria o data.frame com o total de casos definido acima 47 | largeData1 = data.table(a=rpois(casos, 3), 48 | b=rbinom(casos, 1, 0.7), 49 | c=rnorm(casos), 50 | d=sample(c("fogo","agua","terra","ar"), casos, replace=TRUE), 51 | e=rnorm(casos), 52 | f=rpois(casos, 3) 53 | ) 54 | 55 | object.size(largeData1) # retorna o tamanho do objeto 56 | 57 | head(largeData1) # vê as primeiras linhas 58 | 59 | write.table(largeData1,"bases_originais/largeData1.csv",sep=",",row.names=FALSE,quote=FALSE) # salva em disco 60 | -------------------------------------------------------------------------------- /scripts/transformacao/ajustes_em_regressao.R: -------------------------------------------------------------------------------- 1 | ## ajuste em regressão 2 | pacman::p_load(car, caret, corrplot, data.table, dplyr, forcats, funModeling, mltools) 3 | 4 | ENEM_ESCOLA_2019 <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/etl_com_r/master/bases_tratadas/ENEM_ESCOLA_2019.csv', stringsAsFactors = T) # carregando a base já tratada para o ambiente do R 5 | 6 | ENEM_ESCOLA_2019$codCasos <- seq(1:nrow(ENEM_ESCOLA_2019)) 7 | 8 | # Análise exploratória de casos 9 | ENEM_ESCOLA_2019_FEDERAL <- ENEM_ESCOLA_2019 %>% filter(tipo == 'Federal') 10 | 11 | p1 <- plot_ly(y = ENEM_ESCOLA_2019_FEDERAL$MED_CAT_0, type = "box", text = ENEM_ESCOLA_2019_FEDERAL$codCasos, boxpoints = "all", jitter = 0.3) 12 | 13 | p2 <-plot_ly(y = ENEM_ESCOLA_2019_FEDERAL$MED_MHA, type = "box", text = ENEM_ESCOLA_2019_FEDERAL$codCasos, boxpoints = "all", jitter = 0.3) 14 | 15 | p3 <-plot_ly(y = ENEM_ESCOLA_2019_FEDERAL$media, type = "box", text = ENEM_ESCOLA_2019_FEDERAL$codCasos, boxpoints = "all", jitter = 0.3) 16 | 17 | subplot(p1, p2, p3) 18 | 19 | # anular o valor discrepante 20 | ENEM_ESCOLA_2019$MED_CAT_0[which(ENEM_ESCOLA_2019$codCasos == 407)] <- NA 21 | 22 | # corrigir o valor anulado 23 | ENEM_ESCOLA_2019$MED_CAT_0 <- impute(ENEM_ESCOLA_2019$MED_CAT_0, fun = mean) 24 | 25 | # Pré-processamento 26 | particaoENEM = createDataPartition(1:nrow(ENEM_ESCOLA_2019), p=.7) # cria a partição 70-30 27 | treinoENEM = ENEM_ESCOLA_2019[particaoENEM$Resample1, ] # treino 28 | testeENEM = ENEM_ESCOLA_2019[-particaoENEM$Resample1, ] # - treino = teste 29 | 30 | ENEM_LM_v2 <- lm(media ~ tipo + TDI_03 + MHA_03, data = treinoENEM) 31 | 32 | summary(ENEM_LM_v2) 33 | 34 | #### OUTLIERS 35 | outlierTest(ENEM_LM_v2) # identificar outliers na regressão 36 | 37 | # identificar pontos de alavancagem 38 | hat.plot <- function(fit) { 39 | p <- length(coefficients(fit)) 40 | n <- length(fitted(fit)) 41 | plot(hatvalues(fit), main="Pontos de Alavancagem") 42 | abline(h=c(2,3)*p/n, col="red", lty=2) 43 | identify(1:n, hatvalues(fit), names(hatvalues(fit))) 44 | } 45 | hat.plot(ENEM_LM_v2) 46 | 47 | # identificar observações influentes 48 | influencePlot(ENEM_LM_v2, id.method="identify", main="Observações Influentes") 49 | 50 | ENEM_ESCOLA_2019[10 , 5:12] <- NA 51 | 52 | 53 | -------------------------------------------------------------------------------- /scripts/machine_learning/regressao_ENADE.R: -------------------------------------------------------------------------------- 1 | pacman::p_load(caret, dplyr, forcats, funModeling) 2 | 3 | # 4 | ENADE2019_PRODUCAO <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/cd_com_r/master/bases_tratadas/ENADE2019_PRODUCAO.csv') 5 | status(ENADE2019_PRODUCAO) 6 | 7 | # AED 8 | status(ENADE2019_PRODUCAO) # explorar a qualidade das variáveis 9 | 10 | ENADE2019_PRODUCAO[ , c(1,3,4,6:13)] <- lapply(ENADE2019_PRODUCAO[ , c(1,3,4,6:13)], as.factor) 11 | 12 | freq(ENADE2019_PRODUCAO) # explorar os fatores 13 | 14 | # Pré-processamento 15 | particaoENADE = createDataPartition(1:nrow(ENADE2019_PRODUCAO), p=.7) # cria a partição 70-30 16 | treinoENADE = ENADE2019_PRODUCAO[particaoENEM$Resample1, ] # treino 17 | testeENADE = ENADE2019_PRODUCAO[-particaoENEM$Resample1, ] # - treino = teste 18 | 19 | ENADE2019_PRODUCAO_LM <- lm(NT_GER ~ CO_ORGACAD + NU_IDADE + CO_TURNO_GRADUACAO + QE_I08 + QE_I15, data = treinoENADE) 20 | 21 | summary(ENADE2019_PRODUCAO_LM) 22 | 23 | plot(ENADE2019_PRODUCAO_LM$residuals, pch = 16, col = "red") 24 | 25 | plot(cooks.distance(ENADE2019_PRODUCAO_LM), pch = 16, col = "blue") 26 | 27 | ###### ETL com a base original 28 | 29 | # ENADE2019 <- read.table('bases_originais/3.DADOS/microdados_enade_2019.txt', header = T, sep = ';', dec = ',') 30 | # 31 | # ENADE2019_PRODUCAO <- ENADE2019 %>% filter(CO_GRUPO == 6208, TP_PRES == 555, CO_UF_CURSO == 26) %>% select(CO_ORGACAD, NU_IDADE, TP_SEXO, CO_TURNO_GRADUACAO, NT_GER, QE_I02, QE_I04, QE_I05, QE_I08, QE_I09, QE_I15, QE_I17, QE_I21) 32 | # 33 | # status(ENADE2019_PRODUCAO) 34 | # 35 | # ENADE2019_PRODUCAO[ , c(1,3,4,6:13)] <- lapply(ENADE2019_PRODUCAO[ , c(1,3,4,6:13)], as.factor) 36 | # 37 | # status(ENADE2019_PRODUCAO) 38 | # 39 | # levels(ENADE2019_PRODUCAO$CO_TURNO_GRADUACAO) 40 | # 41 | # ENADE2019_PRODUCAO$CO_TURNO_GRADUACAO <- factor(ENADE2019_PRODUCAO$CO_TURNO_GRADUACAO, levels = c(3, 4), labels=c('Integral', 'Noturno')) 42 | # 43 | # levels(ENADE2019_PRODUCAO$CO_TURNO_GRADUACAO) 44 | # 45 | # ENADE2019_PRODUCAO$CO_ORGACAD <- factor(ENADE2019_PRODUCAO$CO_ORGACAD, levels = c(10019, 10020, 10022, 10026, 10028), labels=c('CEFET', 'Centro Universitário', 'Faculdade', 'IF', 'Universidade')) 46 | # 47 | # write.csv2(ENADE2019_PRODUCAO, "bases_tratadas/ENADE2019_PRODUCAO.csv", row.names = F) -------------------------------------------------------------------------------- /scripts/machine_learning/aprendizagem_custo.R: -------------------------------------------------------------------------------- 1 | # carrega as bibliotecas 2 | pacman::p_load(ade4, arules, car, caret, corrplot, data.table, dplyr, DMwR, e1071, forcats, funModeling, ggplot2, mlbench, mltools, randomForest, rattle, tidyverse) 3 | 4 | # leitura da base de dados 5 | ENEM_ESCOLA_2019 <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/etl_com_r/master/bases_tratadas/ENEM_ESCOLA_2019.csv', stringsAsFactors = T) # carregando a base já tratada para o ambiente do R 6 | 7 | # Dummies 8 | ENEM_ESCOLA_2019_D <- acm.disjonctif(as.data.frame(ENEM_ESCOLA_2019$tipo)) 9 | names(ENEM_ESCOLA_2019_D) <- c('EREM', 'ETE', 'Federal', 'Privada', 'Regular') 10 | 11 | ENEM_ESCOLA_2019 <- cbind(ENEM_ESCOLA_2019, ENEM_ESCOLA_2019_D) 12 | 13 | # Discretização 14 | ENEM_ESCOLA_2019$notaDisc <- discretize(ENEM_ESCOLA_2019$nota, method = "interval", breaks = 2, labels = c("baixa", "alta")) 15 | 16 | table(ENEM_ESCOLA_2019$notaDisc) 17 | 18 | # Treino e Teste: Pré-processamento 19 | particaoENEM = createDataPartition(ENEM_ESCOLA_2019$nota, p=.7, list = F) # cria a partição 70-30 20 | treinoENEM = ENEM_ESCOLA_2019[particaoENEM, ] # treino 21 | testeENEM = ENEM_ESCOLA_2019[-particaoENEM, ] # - treino = teste 22 | 23 | prop.table(table(treinoENEM$notaDisc)) 24 | 25 | # Validação Cruzada: Pré-processamento 26 | # Controle de treinamento 27 | train.control <- trainControl(method = "cv", number = 10, verboseIter = T) # controle de treino 28 | 29 | matrizCusto <- matrix(c(0,1,1000,0), ncol = 2) 30 | rownames(matrizCusto) <- levels(treinoENEM$notaDisc) 31 | colnames(matrizCusto) <- levels(treinoENEM$notaDisc) 32 | matrizCusto 33 | 34 | ENEM_RF_CLASS <- randomForest(notaDisc ~ EREM + ETE + Federal + Privada + Regular + TDI_03 + MHA_03, data = treinoENEM, method = "cforest", parms = list(loss = matrizCusto)) 35 | ENEM_RF_CLASS 36 | 37 | ENEM_C5_CLASS <- train(notaDisc ~ EREM + ETE + Federal + Privada + Regular + TDI_03 + MHA_03, data = treinoENEM, method = "C5.0Cost", trControl = train.control) 38 | ENEM_C5_CLASS 39 | 40 | predicaoENEM_RF_CLASS = predict(ENEM_RF_CLASS, testeENEM) # criar predição 41 | cmENEM_RF_CLASS <- confusionMatrix(predicaoENEM_RF_CLASS, testeENEM$notaDisc) 42 | cmENEM_RF_CLASS 43 | 44 | predicaoENEM_C5_CLASS = predict(ENEM_C5_CLASS, testeENEM) # criar predição 45 | cmENEM_C5_CLASS <- confusionMatrix(predicaoENEM_C5_CLASS, testeENEM$notaDisc) 46 | cmENEM_C5_CLASS 47 | -------------------------------------------------------------------------------- /scripts/machine_learning/regras_associacao_TSE.R: -------------------------------------------------------------------------------- 1 | ##### Regras de Associação 2 | pacman::p_load( 3 | # ETL 4 | data.table, dplyr, janitor, 5 | # MACHINE LEARNING 6 | caret, 7 | # REGRAS DE ASSOCIAÇÃO 8 | arules, arulesCBA, arulesViz, 9 | # TABELAS 10 | reactablefmtr 11 | ) 12 | 13 | ##### ETL ##### 14 | candidatos_pe_2022 <- fread('https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/master/bases_originais/consulta_cand_2022_PE.csv', encoding = 'Latin-1', stringsAsFactors = T) %>% 15 | janitor::clean_names() 16 | 17 | # filtrar apenas deputados estaduais e variáveis de perfil 18 | estaduais_pe_2022 <- candidatos_pe_2022 %>% 19 | filter(ds_cargo == 'DEPUTADO ESTADUAL') %>% 20 | select(tp_agremiacao, nm_municipio_nascimento, nr_idade_data_posse, ds_genero, ds_grau_instrucao, ds_estado_civil, ds_cor_raca, ds_ocupacao) 21 | 22 | # observar se os dados estão com as classes certas 23 | estaduais_pe_2022 %>% glimpse() 24 | 25 | # discretizar variável numérica 26 | estaduais_pe_2022[ , 3] <- discretizeDF(estaduais_pe_2022[ , 3]) # transforma variáveis numéricas em fatores 27 | 28 | ##### MINERAÇÃO ##### 29 | # mineração com a priori 30 | regras_estaduais <- estaduais_pe_2022 %>% 31 | apriori(parameter = list(supp = 0.2, conf = 0.5, minlen = 2, maxlen = 5)) 32 | 33 | ## limpar e organizar regras 34 | # três casas decimais 35 | quality(regras_estaduais) <- round(quality(regras_estaduais), digits = 3) 36 | 37 | # organizar por lift 38 | regras_estaduais <- sort(regras_estaduais, by="lift") 39 | # remover regras redundantes 40 | regras_estaduais_res <- regras_estaduais[!is.redundant(regras_estaduais, measure="lift")] 41 | 42 | # inspecionar regras 43 | inspect(regras_estaduais_res) 44 | 45 | regras_estaduais_df = data.frame( 46 | lhs = labels(lhs(regras_estaduais_res)), 47 | rhs = labels(rhs(regras_estaduais_res)), 48 | regras_estaduais_res@quality) 49 | 50 | reactable( 51 | regras_estaduais_df, 52 | defaultColDef = colDef(cell = data_bars(regras_estaduais_df ,text_position = 'outside-base')), 53 | pagination = F 54 | ) 55 | 56 | # gráfico de coordenadas 57 | plot(regras_estaduais_res, method="paracoord", control=list(reorder=T), measure=c("lift"), lty = "dotted") 58 | 59 | # gráfico de relações agrupadas 60 | plot(regras_estaduais_res, method="grouped", measure=c("lift")) 61 | -------------------------------------------------------------------------------- /scripts/programacao/tipos_de_objetos_no_R.R: -------------------------------------------------------------------------------- 1 | # tipos de objetos no R 2 | 3 | # vetor 4 | vetor1 <- c(1, 2, 3, 4, 5, 6) # vetor usando a função c (concatenar) 5 | 6 | is.vector(vetor1) # testa se é vetor 7 | typeof(vetor1) # tipo do objeto 8 | class(vetor1) # classe do objeto 9 | str(vetor1) # estrutura do objeto 10 | length(vetor1) # tamanho objeto 11 | 12 | # array 13 | array1 <- array(c(c('João', 'Luis', 'Ana', 'Claudia'), 21:24), dim = c(2, 2, 2)) # cria array usando as funções array e c 14 | 15 | is.array(array1) # teste se é array 16 | typeof(array1) # tipo do objeto 17 | class(array1) # classe do objeto 18 | str(array1) # estrutura do objeto 19 | length(array1) # tamanho objeto 20 | 21 | # matriz 22 | matrix1 <- matrix(vetor1, nrow = 2) 23 | 24 | is.matrix(matrix1) # teste se é matriz 25 | typeof(matrix1) # tipo do objeto 26 | class(matrix1) # classe do objeto 27 | str(matrix1) # estrutura do objeto 28 | length(matrix1) # tamanho objeto 29 | 30 | # lista 31 | regCarros <- lm(mpg ~ ., mtcars) # criação de um modelo de regressão 32 | 33 | is.list(regCarros) # teste se é lista 34 | typeof(regCarros) # tipo do objeto 35 | class(regCarros) # classe do objeto 36 | str(regCarros) # estrutura do objeto 37 | length(regCarros) # tamanho objeto 38 | 39 | # data frame / quadro de dados 40 | iris # data frame nativo do R 41 | 42 | is.data.frame(iris) # teste se é lista 43 | typeof(iris) # tipo do objeto 44 | class(iris) # classe do objeto 45 | str(iris) # estrutura do objeto 46 | length(iris) # tamanho objeto 47 | 48 | #### Vamos criar nosso próprio data.frame 49 | 50 | #primeiro, vamos instalar um novo pacote: eeptools 51 | install.packages('eeptools') 52 | 53 | #depois, vamos chamar o pacote 54 | library(eeptools) 55 | 56 | # vetor com nome dos alunos 57 | nomeAluno <- c("João", "José", "Luis", "Maria", "Ana", "Olga") 58 | 59 | # vetor com datas de nascimento 60 | nascimentoAluno <- as.Date(c("1990-10-23", "1992-03-21", "1993-07-20", "1989-07-20", "1994-01-25", "1985-12-15")) 61 | 62 | # vetor com as idades 63 | idadeAluno <- round( age_calc( nascimentoAluno, units = 'years')) # Idade usando a função age_calc do pacote eeptools e a função round (arredondar) 64 | 65 | # data.frame com base nos vetores 66 | listaAlunos <- data.frame( 67 | nome = nomeAluno, # Nome 68 | dataNascimento = nascimentoAluno, # Data de nascimento 69 | idade = idadeAluno # idade 70 | ) 71 | 72 | # matrix1 <- matrix(vetor1, nrow = 2) 73 | -------------------------------------------------------------------------------- /scripts/rmarkdown/leaflet_introducao.R: -------------------------------------------------------------------------------- 1 | library(leaflet) 2 | 3 | cidades_eua <- data.frame( 4 | Cidade = c("Nova York", "Los Angeles", "Chicago", "Houston", "Phoenix", "Philadelphia", "San Antonio", "San Diego", "Dallas", "San Jose", "Austin", "Seattle", "Denver", "Miami", "Boston"), 5 | Latitude = c(40.7128, 34.0522, 41.8781, 29.7604, 33.4484, 39.9526, 29.4241, 32.7157, 32.7767, 37.3541, 30.2672, 47.6062, 39.7392, 25.7617, 42.3601), 6 | Longitude = c(-74.0060, -118.2437, -87.6298, -95.3698, -112.0740, -75.1652, -98.4936, -117.1611, -96.7970, -121.9552, -97.7431, -122.3321, -104.9903, -80.1918, -71.0589), 7 | Populacao = c(8398748, 3986559, 2716000, 2320268, 1680992, 1584138, 1547253, 1423851, 1343573, 1030119, 978908, 744955, 715522, 467963, 694583) 8 | ) 9 | 10 | # Criação do mapa com marcadores com o provedor Esri 11 | leaflet(cidades_eua) %>% 12 | addProviderTiles(providers$Esri.NatGeoWorldMap) %>% 13 | addCircleMarkers( 14 | lng = ~Longitude, 15 | lat = ~Latitude, 16 | color = "red", 17 | popup = ~paste(Cidade, "
População: ", Populacao) 18 | ) 19 | 20 | # Criação do mapa com marcadores com o provedor padrão OpenStreetMap 21 | leaflet(cidades_eua) %>% 22 | addTiles() %>% 23 | addCircleMarkers( 24 | lng = ~Longitude, 25 | lat = ~Latitude, 26 | color = "red", 27 | popup = ~paste(Cidade, "
População: ", Populacao) 28 | ) 29 | 30 | # Criação do mapa com marcadores com o provedor padrão OpenStreetMap 31 | leaflet(cidades_eua) %>% 32 | addTiles() %>% 33 | addCircleMarkers( 34 | lng = ~Longitude, 35 | lat = ~Latitude, 36 | color = "red", 37 | clusterOptions = markerClusterOptions(), 38 | popup = ~paste(Cidade, "
População: ", Populacao) 39 | ) 40 | 41 | estadios_br <- data.frame( 42 | Estadio = c("Maracanã", "Allianz Parque", "Mineirão", "Beira-Rio", "Arena Corinthians", "Estádio Mané Garrincha", "Morumbi", "Vila Belmiro", "Arena Fonte Nova", "São Januário", "Arena da Baixada", "Nilton Santos", "Couto Pereira", "Castelão", "Ilha do Retiro", "Arena Pantanal", "Independência", "Barradão", "Rei Pelé", "Serra Dourada", "Fonte Nova"), 43 | Latitude = c(-22.9122, -23.5467, -19.8697, -30.0603, -23.5460, -15.7835, -23.5990, -23.9572, -12.9711, -22.8925, -25.4478, -22.8919, -25.4194, -3.7172, -8.0731, -15.5667, -15.6506, -19.8822, -12.9744, -9.9617, -16.6770), 44 | Longitude = c(-43.2302, -46.6729, -43.9693, -51.2286, -46.4723, -47.8997, -46.7213, -46.3336, -38.5033, -43.2279, -49.2770, -43.2877, -49.2604, -38.4814, -34.8996, -56.0902, -56.1118, -43.9253, -38.4993, -36.6369, -49.2700), 45 | Capacidade = c(78838, 44000, 61204, 50080, 49206, 72722, 66728, 16965, 48098, 21137, 42680, 46072, 39997, 63903, 35303, 30000, 44123, 23959, 51408, 19817, 45302) 46 | ) 47 | 48 | -------------------------------------------------------------------------------- /scripts/analise/box_cox.R: -------------------------------------------------------------------------------- 1 | ##### PREPARAÇÃO ##### 2 | # limpar ambiente: rm(list=ls()) 3 | ### CARREGANDO PACOTES ### 4 | pacman::p_load(dplyr, EnvStats, fastDummies, performance) 5 | 6 | ### ETL ### 7 | # leitura da base de dados 8 | idepeOriginal <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/master/bases_tratadas/idepe_escolas_2019.csv', stringsAsFactors = T, encoding = 'UTF-8') # carregando a base já tratada para o ambiente do R 9 | # remover casos ausentes 10 | idepeOriginal <- idepeOriginal[complete.cases(idepeOriginal), ] 11 | # remover escolas técnicas 12 | idepeTratada <- idepeOriginal %>% dplyr::filter(tp_escola != 'TECNICA') 13 | idepeTratada <- droplevels(idepeTratada) 14 | # criar dummies 15 | idepeTratada <- fastDummies::dummy_cols(idepeTratada) 16 | # remover variáveis que não serão usadas 17 | idepeTratada <- idepeTratada %>% dplyr::select(-c(tp_escola, tp_localizacao, p_em, nota_lp, nota_mt, idepe)) 18 | # renomear variáveis 19 | colnames(idepeTratada)[13:17] <- c('Integral', 'Regular', "SemiIntegral", 'Rural', "Urbana") 20 | 21 | ##### MODELAGEM ##### 22 | ### REGRESSÃO ### 23 | regIdepeBoth <- step(lm(nota_saep ~ tx_mat_med_int + tx_mat_bas_fem + tx_mat_bas_branca + Integral + Rural, data = idepeTratada), direction = "both") 24 | # análise # 25 | summary(regIdepeBoth) 26 | par(ask = FALSE) 27 | performance::check_model(regIdepeBoth) 28 | 29 | # Transformação Box-Cox# 30 | idepeBoxCox <- EnvStats::boxcox(regIdepeBoth, optimize = T) 31 | 32 | # Comparação dos resíduos 33 | par(mfrow=c(1,2), ask = FALSE) 34 | plot(regIdepeBoth, which=2, col=c("red"), main = 'Regressão original') 35 | plot(idepeBoxCox, plot.type = "Q-Q Plots", main = 'Regressão Box Cox') 36 | 37 | # Extração de lambda 38 | idepeBoxCox$optimize.bounds 39 | (lambda <- idepeBoxCox$lambda) 40 | idepeTratada$nota_saep_bc <- idepeTratada$nota_saep^lambda 41 | 42 | # Comparação das variáveis 43 | par(mfrow=c(1,2), ask = FALSE) 44 | hist(idepeTratada$nota_saep, col='blue', main = 'Variável Original', xlab = 'Nota SAEP') 45 | hist((idepeTratada$nota_saep)^lambda, col='red', main = 'Variável Transformada', xlab = 'Nota SAEP Box-Cox') 46 | 47 | # Remodelagem 48 | regIdepeBoxCox <- step(lm((nota_saep^lambda)~ tx_mat_med_int + tx_mat_bas_fem + tx_mat_bas_branca + Integral + Rural, data = idepeTratada), direction = "both") 49 | regIdepeBoxCox2 <- step(lm((nota_saep^lambda-1)/lambda ~ tx_mat_med_int + tx_mat_bas_fem + tx_mat_bas_branca + Integral + Rural, data = idepeTratada), direction = "both") 50 | 51 | # Comparação dos resíduos 52 | par(mfrow=c(1,3), ask = FALSE) 53 | plot(regIdepeBoth, which=2, col=c("red"), main = 'Regressão original') 54 | plot(regIdepeBoxCox, which=2, col=c("blue"), main = 'Regressão Box Cox 1') 55 | plot(regIdepeBoxCox2, which=2, col=c("blue"), main = 'Regressão Box Cox 2') 56 | -------------------------------------------------------------------------------- /scripts/programacao/amostragem_e_boostrapping.R: -------------------------------------------------------------------------------- 1 | # distribuição normal simulada 2 | distNormalSimulacao <- rnorm(1000, mean = 3, sd = 1) # usa a função rnorm para criar uma distribuição normal, indicando o total de casos 3 | 4 | # amostragem sem reposição usando função sample 5 | sample(distNormalSimulacao, 15, replace = FALSE) # se você não tiver o objeto distNormalSimulacao no seu ambiente, crie com o script anterior 6 | 7 | # amostragem com reposição usando função sample 8 | sample(distNormalSimulacao, 15, replace = TRUE) 9 | 10 | # bootstraping com função replicate 11 | set.seed(412) # agora, não vamos mais usar como tarefa mas como execução ponto a ponto 12 | 13 | bootsDistNormal10 <- replicate(10, sample(distNormalSimulacao, 10, replace = TRUE)) # replicamos 10x a amostra, criando assim um bootstrapping 14 | bootsDistNormal10 15 | 16 | # calculando uma estatística com bootstrapping (10 amostras) 17 | mediaBootsNormal10 <- replicate(10, mean(sample(distNormalSimulacao, 10, replace = TRUE))) # calculamos a média de 10 amostras de 10 casos 18 | mediaBootsNormal50 <- replicate(50, mean(sample(distNormalSimulacao, 10, replace = TRUE))) # calculamos a média de 50 amostras de 10 casos 19 | mediaBootsNormal100 <- replicate(100, mean(sample(distNormalSimulacao, 10, replace = TRUE))) # calculamos a média de 100 amostras de 10 casos 20 | 21 | # vamos comparar??? 22 | mean(mediaBootsNormal10) # media do boostraping 10 23 | mean(mediaBootsNormal50) # media do boostraping 50 24 | mean(mediaBootsNormal100) # media do boostraping 100 25 | mean(distNormalSimulacao) # media dos dados originais 26 | 27 | # vamos comparar??? 28 | par(mfrow=c(2,2), ask = FALSE) 29 | hist(mediaBootsNormal10, main = 'Bootstrap 10 Repetições', xlab = 'Média 10 Repetições') # media do boostraping 10 30 | hist(mediaBootsNormal50, col='blue', main = 'Bootstrap 50 Repetições', xlab = 'Média 50 Repetições') # media do boostraping 50 31 | hist(mediaBootsNormal100, col='red', main = 'Bootstrap 100 Repetições', xlab = 'Média 100 Repetições') # media do boostraping 100 32 | hist(distNormalSimulacao, col='black', main = 'Dados Originais', xlab = 'Média Original') # media dos dados originais 33 | 34 | # partições 35 | pacman::p_load(caret) 36 | 37 | # primeiro, criamos as partições de dados 38 | particaoDistNormal <- createDataPartition(1:length(distNormalSimulacao), p=.7) # passamos o tamanho do vetor e o parâmetro de divisão 39 | treinoDistNormal <- distNormalSimulacao[unlist(particaoDistNormal)] # criamos uma partição para treinar os dados, usando a partição anterior. Atenção: o comando unlist é muito usado para transformar uma lista num vetor 40 | testeDistNormal <- distNormalSimulacao[- unlist(particaoDistNormal)] # criamos uma partição para testar os dados, usando a partição anterior. Atenção: o comando unlist é muito usado para transformar uma lista num vetor 41 | -------------------------------------------------------------------------------- /scripts/machine_learning/regressao_com_cv_salaries.R: -------------------------------------------------------------------------------- 1 | # carrega as bibliotecas 2 | pacman::p_load(ade4, car, mboost, caret, corrplot, data.table, dplyr, forcats, funModeling, ggplot2, mlbench, mltools, randomForest, rattle, tidyverse) 3 | 4 | # carregando base pronta do tidyverse 5 | salarios <- carData::Salaries 6 | 7 | salarios_D <- acm.disjonctif(as.data.frame(salarios$sex)) 8 | names(salarios_D) <- c('Female','Male') 9 | 10 | salarios <- cbind(salarios, salarios_D) 11 | 12 | # AED 13 | status(salarios) # explorar a qualidade das variáveis 14 | freq(salarios) # explorar os fatores 15 | plot_num(salarios) # exploração das variáveis numéricas 16 | profiling_num(salarios) # estatísticas das variáveis numéricas 17 | 18 | corrplot(cor(salarios[ , c(6,3:4)])) # correlação entre as variáveis 19 | 20 | # Treino e Teste: Pré-processamento 21 | particao_salarios = createDataPartition(salarios$salary, p=.7, list = F) # cria a partição 70-30 22 | treino_salarios = salarios[particao_salarios, ] # treino 23 | teste_salarios = salarios[-particao_salarios, ] # - treino = teste 24 | 25 | # Validação Cruzada: Pré-processamento 26 | # Controle de treinamento 27 | 28 | train.control <- trainControl(method = "cv", number = 10, verboseIter = T) # controle de treino 29 | 30 | # Treinamentos 31 | ## Regressão Linear 32 | 33 | salarios_LM <- train(salary ~ yrs.since.phd + yrs.service + Female + Male, data = treino_salarios, method = "lm", trControl = train.control) 34 | summary(salarios_LM) # sumário do modelo linear 35 | 36 | ## Árvore de Decisão 37 | salarios_RPART <- train(salary ~ yrs.since.phd + yrs.service + Female + Male, data = treino_salarios, method = "rpart", trControl = train.control) 38 | 39 | summary(salarios_RPART) 40 | fancyRpartPlot(salarios_RPART$finalModel) # desenho da árvore 41 | plot(varImp(salarios_RPART)) # importância das variáveis 42 | 43 | # Bagging com Floresta Aleatória 44 | salarios_RF <- train(salary ~ yrs.since.phd + yrs.service + Female + Male, data = treino_salarios, method = "cforest", trControl = train.control) 45 | 46 | plot(salarios_RF) # evolução do modelo 47 | varImp(salarios_RF, scale = T) # importância de cada variável 48 | plot(varImp(salarios_RF, scale = T)) # plot de importância 49 | 50 | # Boosting com Boosted Generalized Linear Model 51 | salarios_ADA <- train(salary ~ yrs.since.phd + yrs.service + Female + Male, data = treino_salarios, method = "glmboost", trControl = train.control) 52 | 53 | plot(salarios_ADA) # evolução do modelo 54 | print(salarios_ADA) # modelo 55 | summary(salarios_ADA) # sumário 56 | 57 | salarios_KNN <- train(salary ~ yrs.since.phd + yrs.service + Female + Male, data = treino_salarios, method = "knn", trControl = train.control) 58 | summary(salarios_LM) # sumário do modelo de vizinhança 59 | 60 | melhor_modelo <- resamples(list(LM = salarios_LM, RF = salarios_RF, RPART = salarios_RPART, ADABOOST = salarios_ADA, KNN = salarios_KNN)) 61 | melhor_modelo 62 | 63 | summary(melhor_modelo) 64 | 65 | predVals <- extractPrediction(list(salarios_KNN), testX = teste_salarios[, c(3, 4, 7, 8)], testY = teste_salarios$salary) 66 | plotObsVsPred(predVals) 67 | -------------------------------------------------------------------------------- /scripts/etl/large_data.R: -------------------------------------------------------------------------------- 1 | ##### ARMAZENAMENTO EM DISCO ##### 2 | #### FF #### 3 | #library(devtools) 4 | #install_github("edwindj/ffbase", subdir="pkg") 5 | pacman::p_load(biglm, devtools, dplyr, ff, ffbase) 6 | 7 | enderecoBase <- 'bases_originais/largeData.csv' 8 | 9 | # criando o arquivo ff 10 | tempo_ff <- system.time(base_ff <- read.csv.ffdf(file=enderecoBase)) 11 | 12 | tempo_ff 13 | 14 | base_ff %>% head() 15 | 16 | base_ff %>% typeof() # veja a classe do objeto 17 | 18 | base_ff %>% class() # veja a classe do objeto 19 | 20 | base_ff %>% object.size() # a vantagem está no tamanho! 21 | 22 | sum(base_ff[,3]) # algumas operações são possíveis diretamente 23 | 24 | # REGRESSÂO # 25 | 26 | lm(c ~ ., base_ff) ## não vai rodar!!!! o vetor de computação será mt grande 27 | 28 | # mas pode ser feita com amostragem 29 | base_ffAmostra <- base_ff[sample(nrow(base_ff), 100000) , ] 30 | 31 | lm(c ~ ., base_ffAmostra) # aí, funciona!!! 32 | 33 | # ou com funções otimizadas 34 | modelo <- biglm(a ~ b + c, data = base_ff) 35 | 36 | summary(modelo) 37 | 38 | #### POLARS #### 39 | # install.packages("polars", repos = "https://rpolars.r-universe.dev") 40 | pacman::p_load(arrow, polars) 41 | 42 | tempo_arrow <- (system.time(base_arrow <- read_csv_arrow(file=enderecoBase))) 43 | 44 | base_polars = pl$DataFrame(base_arrow) 45 | 46 | base_polars %>% head() 47 | 48 | base_polars %>% typeof() 49 | 50 | base_polars %>% class() 51 | 52 | base_polars %>% object.size() 53 | 54 | base_polars_mod <- lm(a ~ b + c + d + e + f + g, base_polars) 55 | 56 | summary(base_polars_mod) 57 | 58 | ##### COLUNAR ##### 59 | #### ARROW #### 60 | pacman::p_load(arrow, dplyr) 61 | 62 | enderecoBase <- 'bases_originais/largeData.csv' 63 | 64 | # criando o arquivo ff 65 | tempo_arrow <- (system.time(base_arrow <- read_csv_arrow(file=enderecoBase))) 66 | 67 | base_arrow %>% head() 68 | 69 | base_arrow %>% typeof() 70 | 71 | base_arrow %>% class() 72 | 73 | base_arrow %>% object.size() # não ha vantagem no tamanho 74 | 75 | base_arrow_t <- arrow_table(base_arrow) 76 | 77 | base_arrow_t %>% typeof() 78 | 79 | base_arrow_t %>% class() 80 | 81 | base_arrow_t %>% object.size() # não ha vantagem no tamanho 82 | 83 | base_arrow_t 84 | 85 | base_arrow_t %>% 86 | group_by(d) %>% 87 | summarize( 88 | mean_a = mean(a), 89 | mean_b = mean(b), 90 | total = n()) %>% 91 | filter(mean_a > 0) %>% 92 | arrange(mean_a) %>% 93 | collect() 94 | 95 | base_arrow_s1 <- base_arrow %>% sample_n(500000, replace = TRUE) %>% compute() 96 | 97 | base_arrow_s1 %>% typeof() 98 | 99 | base_arrow_s1 %>% class() 100 | 101 | base_arrow_s1 %>% object.size() 102 | 103 | base_arrow_s1_mod <- lm(a ~ b + c + d + e + f + g, base_arrow_s1) 104 | 105 | summary(base_arrow_s1_mod) 106 | 107 | ##### RDD ##### 108 | #### SPARK #### 109 | # spark_install("3.5") 110 | 111 | # install.packages("sparklyr") 112 | 113 | # packageVersion("sparklyr") 114 | 115 | # install.packages("https://cran.r-project.org/src/contrib/Archive/SparkR/SparkR_2.3.0.tar.gz", repos = NULL, type="source") -------------------------------------------------------------------------------- /scripts/datas/datas_na_pratica.R: -------------------------------------------------------------------------------- 1 | ### 2 | url = 'https://raw.githubusercontent.com/wcota/covid19br/master/cases-brazil-states.csv' # passar a url para um objeto 3 | covidBR = read.csv2(url, encoding='latin1', sep = ',') # baixar a base de covidBR 4 | 5 | covidPE <- subset(covidBR, state == 'PE') # filtrar para Pernambuco 6 | 7 | str(covidPE) # observar as classes dos dados 8 | 9 | covidPE$date <- as.Date(covidPE$date, format = "%Y-%m-%d") # modificar a coluna data de string para date 10 | 11 | str(covidPE) # observar a mudança na classe 12 | 13 | covidPE$dia <- seq(1:length(covidPE$date)) # criar um sequencial de dias de acordo com o total de datas para a predição 14 | 15 | predDia = data.frame(dia = covidPE$dia) # criar vetor auxiliar de predição 16 | predSeq = data.frame(dia = seq(max(covidPE$dia)+1, max(covidPE$dia)+180)) # criar segundo vetor auxiliar 17 | 18 | predDia <- rbind(predDia, predSeq) # juntar os dois 19 | 20 | library(drc) # pacote para predição 21 | 22 | fitLL <- drm(totalCases ~ dia, fct = LL2.5(), 23 | data = covidPE, robust = 'mean') # fazendo a predição log-log com a função drm 24 | 25 | plot(fitLL, log="", main = "Log logistic") # observando o ajuste 26 | 27 | predLL <- data.frame(predicao = ceiling(predict(fitLL, predDia))) # usando o modelo para prever para frente, com base no vetor predDia 28 | predLL$data <- seq.Date(as.Date('2020-03-12'), by = 'day', length.out = length(predDia$dia)) # criando uma sequência de datas para corresponder aos dias extras na base de predição 29 | 30 | predLL <- merge(predLL, covidPE, by.x ='data', by.y = 'date', all.x = T) # juntando as informações observadas da base original 31 | 32 | library(plotly) # biblioteca para visualização interativa de dados 33 | 34 | plot_ly(predLL) %>% add_trace(x = ~data, y = ~predicao, type = 'scatter', mode = 'lines', name = "Casos - Predição") %>% add_trace(x = ~data, y = ~totalCases, name = "Casos - Observados", mode = 'lines') %>% layout( 35 | title = 'Predição de Casos de COVID 19 em Pernambuco', 36 | xaxis = list(title = 'Data', showgrid = FALSE), 37 | yaxis = list(title = 'Casos Acumulados por Dia', showgrid = FALSE), 38 | hovermode = "compare") # plotando tudo junto, para comparação 39 | 40 | library(zoo) # biblioteca para manipulação de datas e séries temporais 41 | 42 | covidPE <- covidPE %>% mutate(newCasesMM7 = round(rollmean(x = newCases, 7, align = "right", fill = NA), 2)) # média móvel de 7 dias 43 | 44 | covidPE <- covidPE %>% mutate(newCasesL7 = dplyr::lag(newCases, 7)) # valor defasado em 7 dias 45 | 46 | plot_ly(covidPE) %>% add_trace(x = ~date, y = ~newCases, type = 'scatter', mode = 'lines', name = "Novos Casos") %>% add_trace(x = ~date, y = ~newCasesMM7, name = "Novos Casos MM7", mode = 'lines') %>% layout( 47 | title = 'Novos Casos de COVID19 em Pernambuco', 48 | xaxis = list(title = 'Data', showgrid = FALSE), 49 | yaxis = list(title = 'Novos Casos por Dia', showgrid = FALSE), 50 | hovermode = "compare") # plotando tudo junto, para comparação 51 | 52 | library(xts) 53 | 54 | (covidPETS <- xts(covidPE$newCases, covidPE$date)) # transformar em ST 55 | str(covidPETS) 56 | 57 | autoplot(covidPETS) 58 | acf(covidPETS) 59 | -------------------------------------------------------------------------------- /scripts/rmarkdown/widgets_DT_intro.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "DataTable (DT)" 3 | output: 4 | flexdashboard::flex_dashboard: 5 | orientation: columns 6 | horizontal_layout: fill 7 | theme: yeti 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | pacman::p_load( 12 | ## ETL 13 | data.table, dplyr, 14 | ## WIDGETS 15 | DT 16 | ) 17 | 18 | instagram_unifafire <- fread('https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/master/bases_tratadas/instagram_unifafire.csv') 19 | ``` 20 | Iris 21 | ================================ 22 | 23 | ```{r} 24 | iris %>% datatable( 25 | # Título 26 | caption = htmltools::tags$caption( 27 | # estilo do título usando css 28 | style = 'text-align: center; font-size: 18px; font-weight: bold;', 29 | 'Tabela 1: Base de Dados iris'), 30 | # nomes das colunas 31 | colnames = c('Tamanho da Sépala', 'Largura da Sépala', 'Tamanho da Pétala', 'Largura da Pétala', 'Espécie'), 32 | filter = "top", 33 | # extensões para serem acrescentadas 34 | extensions = c('Buttons', 'ColReorder', 'Responsive'), 35 | # as opções configuram efetivamente as extensões 36 | options = list( 37 | # 38 | dom = 'Blfrtip', 39 | # primeiro vamos configurar os botões, adicionando funcionalidades 40 | buttons = c('copy', 'csv', 'excel', 'pdf', 'print'), 41 | # permite ao usuário reordenar as colunas 42 | colReorder = TRUE, 43 | # controla quantas linhas serão mostradas por página 44 | pageLength = 50, 45 | # ativa o spinner (indicador de processamento) 46 | processing = TRUE 47 | ) 48 | ) %>% # podemos usar também formatações de estilo avançadas para as colunas 49 | formatStyle( 50 | 'Petal.Length', 51 | color = styleInterval(1.6, c('black', 'white')), 52 | background = styleColorBar(iris$Petal.Length, 'lightblue') 53 | ) 54 | ``` 55 | 56 | FAFIRE 57 | ================================ 58 | 59 | ### FAFIRE 60 | 61 | ```{r} 62 | instagram_unifafire %>% datatable( 63 | # Título 64 | caption = htmltools::tags$caption( 65 | # estilo do título usando css 66 | style = 'text-align: center; font-size: 18px; font-weight: bold;', 67 | 'Tabela 2: Base de Dados instagram fafire'), 68 | # extensões para serem acrescentadas 69 | extensions = c('Buttons', 'ColReorder', 'Responsive'), 70 | # as opções configuram efetivamente as extensões 71 | options = list( 72 | # 73 | dom = 'Blfrtip', 74 | # primeiro vamos configurar os botões, adicionando funcionalidades 75 | buttons = c('copy', 'csv', 'excel', 'pdf', 'print'), 76 | # permite ao usuário reordenar as colunas 77 | colReorder = TRUE, 78 | # controla quantas linhas serão mostradas por página 79 | pageLength = 50, 80 | # ativa o spinner (indicador de processamento) 81 | processing = TRUE, 82 | # controla as opções de busca 83 | searchHighlight = TRUE, 84 | search = list( 85 | "caseInsensitive" = TRUE, # sensível a maiúsculas 86 | "regex" = TRUE, # correspondência exata ou aproximada 87 | "smart" = TRUE, # ativar IA para a pesquisa 88 | "searchDelay" = 500, # tempo até iniciar a processar 89 | "searchCols" = c(0) # especifica colunas a serem pesquisadas 90 | ) 91 | ) 92 | ) 93 | ``` 94 | -------------------------------------------------------------------------------- /scripts/machine_learning/classificacao_com_cv_ENEM.R: -------------------------------------------------------------------------------- 1 | # carrega as bibliotecas 2 | pacman::p_load(ade4, arules, car, caret, corrplot, data.table, dplyr, e1071, forcats, funModeling, ggplot2, mlbench, mltools, randomForest, rattle, tidyverse) 3 | 4 | # leitura da base de dados 5 | ENEM_ESCOLA_2019 <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/etl_com_r/master/bases_tratadas/ENEM_ESCOLA_2019.csv', stringsAsFactors = T) # carregando a base já tratada para o ambiente do R 6 | 7 | # Dummies 8 | ENEM_ESCOLA_2019_D <- acm.disjonctif(as.data.frame(ENEM_ESCOLA_2019$tipo)) 9 | names(ENEM_ESCOLA_2019_D) <- c('EREM', 'ETE', 'Federal', 'Privada', 'Regular') 10 | 11 | ENEM_ESCOLA_2019 <- cbind(ENEM_ESCOLA_2019, ENEM_ESCOLA_2019_D) 12 | 13 | # Discretização 14 | ENEM_ESCOLA_2019$nota <- discretize(ENEM_ESCOLA_2019$nota, method = "frequency", breaks = 2, labels = c("baixa", "alta")) 15 | 16 | # Treino e Teste: Pré-processamento 17 | particaoENEM = createDataPartition(ENEM_ESCOLA_2019$nota, p=.7, list = F) # cria a partição 70-30 18 | treinoENEM = ENEM_ESCOLA_2019[particaoENEM, ] # treino 19 | testeENEM = ENEM_ESCOLA_2019[-particaoENEM, ] # - treino = teste 20 | 21 | # Validação Cruzada: Pré-processamento 22 | # Controle de treinamento 23 | train.control <- trainControl(method = "cv", number = 10, verboseIter = T) # controle de treino 24 | 25 | # Treinamentos 26 | ## Máquina de Vetor se Suporte (SVM) 27 | ENEM_SVM_CLASS <- train(nota ~ EREM + ETE + Federal + Privada + Regular + TDI_03 + MHA_03, data = treinoENEM, method = "svmLinear", trControl = train.control) 28 | ENEM_SVM_CLASS # sumário da máquina de vetor de suporte 29 | plot(varImp(ENEM_SVM_CLASS)) 30 | 31 | # criar a máquina de vetor de suporte 32 | svmENEMCLass = svm(nota ~ EREM + ETE + Federal + Privada + Regular + TDI_03 + MHA_03, data = treinoENEM, cost = 10, scale = F) 33 | svmENEMCLass 34 | plot(svmENEMCLass, treinoENEM, TDI_03 ~ MHA_03) 35 | 36 | ## Árvore de Decisão 37 | ENEM_RPART_CLASS <- train(nota ~ EREM + ETE + Federal + Privada + Regular + TDI_03 + MHA_03, data = treinoENEM, method = "rpart", trControl = train.control) 38 | 39 | summary(ENEM_RPART_CLASS) 40 | fancyRpartPlot(ENEM_RPART_CLASS$finalModel) # desenho da árvore 41 | plot(varImp(ENEM_RPART_CLASS)) # importância das variáveis 42 | 43 | # Bagging com Floresta Aleatória 44 | ENEM_RF_CLASS <- train(nota ~ EREM + ETE + Federal + Privada + Regular + TDI_03 + MHA_03, data = treinoENEM, method = "cforest", trControl = train.control) 45 | 46 | plot(ENEM_RF_CLASS) # evolução do modelo 47 | plot(varImp(ENEM_RF_CLASS)) # plot de importância 48 | 49 | # Boosting com Boosted Generalized Linear Model 50 | ENEM_ADA_CLASS <- train(nota ~ EREM + ETE + Federal + Privada + Regular + TDI_03 + MHA_03, data = treinoENEM, method = "glmboost", trControl = train.control) 51 | 52 | plot(ENEM_ADA_CLASS) # evolução do modelo 53 | print(ENEM_ADA_CLASS) # modelo 54 | summary(ENEM_ADA_CLASS) # sumário 55 | 56 | melhor_modelo <- resamples(list(SVM = ENEM_SVM_CLASS, RPART = ENEM_RPART_CLASS, RF = ENEM_RF_CLASS, ADABOOST = ENEM_ADA_CLASS)) 57 | melhor_modelo 58 | 59 | summary(melhor_modelo) 60 | 61 | predVals <- extractPrediction(list(SVM = ENEM_SVM_CLASS, RPART = ENEM_RPART_CLASS, RF = ENEM_RF_CLASS, ADABOOST = ENEM_ADA_CLASS), testX = testeENEM[, c(8, 12:17)], testY = testeENEM$nota) 62 | 63 | plotObsVsPred(predVals) 64 | -------------------------------------------------------------------------------- /scripts/textos/mineracao_texto_basica.R: -------------------------------------------------------------------------------- 1 | # PACOTES # 2 | pacman::p_load(quanteda, quanteda.textplots, quanteda.textstats, readtext, stopwords, textreuse, tidyverse, topicmodels, wesanderson) 3 | 4 | # LEITURA DOS TEXTOS # 5 | alepe_atas <- readtext('bases_tratadas/atas_ALEPE/*', docvarsfrom = 'filenames', dvsep = '_', docvarnames = c('ano', 'mes', 'dia')) 6 | 7 | # ANÁLISE DOS TEXTOS # 8 | ## CORPUS: COLEÇÃO DE DOCUMENTOS ## 9 | alepe_atas_corpus <- corpus(alepe_atas) # conversão da base para corpus 10 | 11 | ### ANÁLISE DO CORPUS ### 12 | summary(alepe_atas_corpus) # sumário do corpus 13 | 14 | kwic(alepe_atas_corpus, "Proj*", 3) # termos antecedentes e sucessores de uma palavra de interesse 15 | 16 | ## TOKEN: UNIDADES DE SENTIDO ## 17 | nomes_deputados <- c('joão', 'paulo', 'queiroz', 'josé', 'antonio', 'filho', 'moraes', 'diogo', 'lessa', 'romero', 'leitão', 'eriberto', 'medeiros', 'tony', 'cabral', 'gel', 'dias', 'romário', 'isaltino', 'nascimento', 'william', 'fernando', 'teresa', 'alberto', 'feitosa') 18 | 19 | palavras_repetidas <- c('nº', 'nºs', 'é', 'ata', 'reunião') 20 | 21 | alepe_atas_tokens <- quanteda::tokens( 22 | alepe_atas_corpus, 23 | what = 'word', # INDICA QUAL O GRÃO DO TOKEN 24 | remove_punct = TRUE, # REMOVE PONTUAÇÃO 25 | remove_symbols = TRUE, # REMOVE SÍMBOLOS 26 | remove_numbers = TRUE, # REMOVE NÚMEROS 27 | remove_separators = TRUE) %>% tokens_remove(pattern = c(stopwords('portuguese'), palavras_repetidas, nomes_deputados)) # REMOVE SEPARADORES E STOPWORDS DE PORTUGUÊS 28 | 29 | ### ANÁLISES DE FREQUÊNCIAS DE TOKENS ## 30 | 31 | alepe_atas_dfm <- dfm(alepe_atas_tokens) # CRIA UMA MATRIZ DE ORGANIZAÇÃO DOS TOKENS 32 | 33 | textstat_frequency(alepe_atas_dfm) # TOKENS MAIS FREQUENTES 34 | 35 | textplot_wordcloud(alepe_atas_dfm, max_words = 100) # NUVEM DE PALAVRAS DOS TOKENS MAIS FREQUENTES 36 | 37 | tokens_subset(alepe_atas_tokens, mes %in% c(8)) %>% dfm() %>% textplot_wordcloud(max_words = 100, comparison = T, color = 'BottleRocket1') ## NUVENS DE PALAVRAS COMPARATIVAS DE ACORDO COM ALGUM CRITÉRIO DE INTERESSE (NO CASO, ANO DA NORMA LEGAL) 38 | 39 | dfm_trim(alepe_atas_dfm, min_termfreq = 10, termfreq_type = 'rank') %>% textplot_network(edge_size = 0.5) # REDE DE LIGAÇÃO DOS TOKENS MAIS FREQUENTES 40 | 41 | LDA(convert(alepe_atas_dfm, to = "topicmodels"), k = 5) %>% get_terms((10)) # OBSERVA OS TÓPICOS PRESENTES NO TEXTO. OS TÓPICOS SÃO CONJUNTOS QUE REVELAM ESTRUTURAS SEMÂNTICAS 42 | 43 | ### REUSO DE TEXTO ### 44 | (alepe_atas_similar_cosine <- textstat_simil(alepe_atas_dfm, method = "cosine", margin = "documents")) # ANÁLISE DE REUSO DE TEXTOS, COM BASE NOS TOKENS E TÓPICOS, NAS DIFERENTES NORMATIVAS LEGAIS, USANDO O MÉTODO 'COSINE' 45 | 46 | alepe_atas_df_cosine <- as.data.frame(alepe_atas_similar_cosine) %>% dplyr::arrange(desc(cosine)) %>% dplyr::filter(cosine < 1) # TRANSFORMA A LISTA DE REUSO DE TEXTOS / SIMILARIDADES EM UMA TABELA DE DADOS 47 | 48 | (alepe_atas_similar_jaccard <- textstat_simil(alepe_atas_dfm, method = "jaccard", margin = "documents")) # ANÁLISE DE REUSO DE TEXTOS, COM BASE NOS TOKENS E TÓPICOS, NAS DIFERENTES NORMATIVAS LEGAIS, USANDO O MÉTODO 'JACCARD' 49 | 50 | alepe_atas_df_jaccard <- as.data.frame(alepe_atas_similar_jaccard) %>% dplyr::arrange(desc(jaccard)) %>% dplyr::filter(jaccard < 1) # TRANSFORMA A LISTA DE REUSO DE TEXTOS / SIMILARIDADES EM UMA TABELA DE DADOS 51 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # R para Ciência Política 2 | 3 | ## O que é? 4 | Materiais de diferentes cursos que usam a linguagem R para aplicar conhecimentos de Ciência de Dados às áreas de Ciência Política e Gestão Pública, ministrados pelo professor Hugo Medeiros, a partir da perspectiva das Humanidades Digitais. 5 | 6 | ## Temáticas 7 | * Introdução à programação; 8 | * Introdução ao R; 9 | * Extração, transformação e leitura (ETL); 10 | * Descoberta, estruturação, limpeza, enriquecimento e validação; 11 | * Valores ausentes, outliers e imputação 12 | * Avaliação de políticas públicas (APP); 13 | * Machine learning apliacado a políticas públicas; 14 | * DataViz; 15 | * Produtos e serviços de Dados. 16 | 17 | ## Vídeo aulas 18 | * https://www.youtube.com/channel/UCtg6tgjgrFTWkWKCFN22HOg 19 | 20 | ## Artigos 21 | * Six of one, half a dozen of the other? Analyzing the similarities in innovation policies across Brazilian states 22 | * Schooling inequality on standardized test scores and extended journey: an analysis of Pernambuco (Brazil) high school public system 23 | * “Won’t get fooled again”: statistical fault detection in COVID-19 Latin American data 24 | * “CONSTRUÇÃO DE INDICADORES SINTÉTICOS PARA TOMADA DE DECISÃO EM GOVERNO: UM TUTORIAL 25 | 26 | ## Turmas 27 | ### Programa de Pós-graduação em Ciência Política da Universidade Federal de Pernambuco (PPGCP/UFPE) 28 | * 2024-02 Políticas Públicas: Tópicos Avançados em Avaliação de Políticas Públicas (Mestrado e Doutorado - Eletiva) 29 | * 2023-02 Tópicos Especiais: Machine Learning para Ciência Política (Mestrado e Doutorado - Eletiva) 30 | * 2023-01 Análise de Dados (Mestrado - Obrigatória) 31 | * 2022-02 Estudos Avançados de Metodologia de Pesquisa (Doutorado - Obrigatória) 32 | * 2021-01 Tópicos Especiais de Metodologia: Eletiva de análise de dados (Mestrado e Doutorado - Eletiva) 33 | ### Programa de Pós-graduação Profissional em Políticas Públicas da Universidade Federal de Pernambuco (PPGPP/UFPE) 34 | * 2023-02 Tópicos Especiais de Metodologia (Mestrado - Obrigatória) 35 | * 2022-02 Tópicos Especiais de Metodologia (Mestrado - Obrigatória) 36 | ### Pós-graduação em BI e BA da Faculdade Frassinetti do Recife (FAFIRE) 37 | * 2024-01 Estatística Computacional com R, Aprendizagem de Máquina e Mineração de Dados, e Big Data 38 | * 2023-02 Estatística Computacional com R, Aprendizagem de Máquina e Mineração de Dados, e Big Data 39 | * 2021-02 Machine Learning e Tópicos Avançados em BI e BA 40 | * 2020-01 Machine Learning e Tópicos Avançados em BI e BA 41 | * 2019-01 Machine Learning e Tópicos Avançados em BI e BA -------------------------------------------------------------------------------- /bases_originais/breast-cancer.names: -------------------------------------------------------------------------------- 1 | Citation Request: 2 | This breast cancer domain was obtained from the University Medical Centre, 3 | Institute of Oncology, Ljubljana, Yugoslavia. Thanks go to M. Zwitter and 4 | M. Soklic for providing the data. Please include this citation if you plan 5 | to use this database. 6 | 7 | 1. Title: Breast cancer data (Michalski has used this) 8 | 9 | 2. Sources: 10 | -- Matjaz Zwitter & Milan Soklic (physicians) 11 | Institute of Oncology 12 | University Medical Center 13 | Ljubljana, Yugoslavia 14 | -- Donors: Ming Tan and Jeff Schlimmer (Jeffrey.Schlimmer@a.gp.cs.cmu.edu) 15 | -- Date: 11 July 1988 16 | 17 | 3. Past Usage: (Several: here are some) 18 | -- Michalski,R.S., Mozetic,I., Hong,J., & Lavrac,N. (1986). The 19 | Multi-Purpose Incremental Learning System AQ15 and its Testing 20 | Application to Three Medical Domains. In Proceedings of the 21 | Fifth National Conference on Artificial Intelligence, 1041-1045, 22 | Philadelphia, PA: Morgan Kaufmann. 23 | -- accuracy range: 66%-72% 24 | -- Clark,P. & Niblett,T. (1987). Induction in Noisy Domains. In 25 | Progress in Machine Learning (from the Proceedings of the 2nd 26 | European Working Session on Learning), 11-30, Bled, 27 | Yugoslavia: Sigma Press. 28 | -- 8 test results given: 65%-72% accuracy range 29 | -- Tan, M., & Eshelman, L. (1988). Using weighted networks to 30 | represent classification knowledge in noisy domains. Proceedings 31 | of the Fifth International Conference on Machine Learning, 121-134, 32 | Ann Arbor, MI. 33 | -- 4 systems tested: accuracy range was 68%-73.5% 34 | -- Cestnik,G., Konenenko,I, & Bratko,I. (1987). Assistant-86: A 35 | Knowledge-Elicitation Tool for Sophisticated Users. In I.Bratko 36 | & N.Lavrac (Eds.) Progress in Machine Learning, 31-45, Sigma Press. 37 | -- Assistant-86: 78% accuracy 38 | 39 | 4. Relevant Information: 40 | This is one of three domains provided by the Oncology Institute 41 | that has repeatedly appeared in the machine learning literature. 42 | (See also lymphography and primary-tumor.) 43 | 44 | This data set includes 201 instances of one class and 85 instances of 45 | another class. The instances are described by 9 attributes, some of 46 | which are linear and some are nominal. 47 | 48 | 5. Number of Instances: 286 49 | 50 | 6. Number of Attributes: 9 + the class attribute 51 | 52 | 7. Attribute Information: 53 | 1. Class: no-recurrence-events, recurrence-events 54 | 2. age: 10-19, 20-29, 30-39, 40-49, 50-59, 60-69, 70-79, 80-89, 90-99. 55 | 3. menopause: lt40, ge40, premeno. 56 | 4. tumor-size: 0-4, 5-9, 10-14, 15-19, 20-24, 25-29, 30-34, 35-39, 40-44, 57 | 45-49, 50-54, 55-59. 58 | 5. inv-nodes: 0-2, 3-5, 6-8, 9-11, 12-14, 15-17, 18-20, 21-23, 24-26, 59 | 27-29, 30-32, 33-35, 36-39. 60 | 6. node-caps: yes, no. 61 | 7. deg-malig: 1, 2, 3. 62 | 8. breast: left, right. 63 | 9. breast-quad: left-up, left-low, right-up, right-low, central. 64 | 10. irradiat: yes, no. 65 | 66 | 8. Missing Attribute Values: (denoted by "?") 67 | Attribute #: Number of instances with missing values: 68 | 6. 8 69 | 9. 1. 70 | 71 | 9. Class Distribution: 72 | 1. no-recurrence-events: 201 instances 73 | 2. recurrence-events: 85 instances -------------------------------------------------------------------------------- /scripts/analise/regressao_avancado - Copia.R: -------------------------------------------------------------------------------- 1 | ### CARREGANDO PACOTES ### 2 | pacman::p_load(ade4, car, caret, corrplot, dplyr, gvlma, jtools, lm.beta, lmtest, MASS, performance, sandwich, stargazer, sjPlot) 3 | 4 | # leitura da base de dados 5 | ENEM_ORIGINAL <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/master/bases_tratadas/ENEM_ESCOLA_2019.csv', stringsAsFactors = T, encoding = 'Latin-1') # carregando a base já tratada para o ambiente do R 6 | 7 | # filtrar escolas de interesse 8 | ENEM_ESCOLA <- ENEM_ORIGINAL %>% filter(tipo %in% c('Regular', 'EREM')) 9 | ENEM_ESCOLA <- droplevels(ENEM_ESCOLA) 10 | 11 | # criar dummies 12 | ENEM_ESCOLA <- fastDummies::dummy_cols(ENEM_ESCOLA) 13 | 14 | # tratamento para retirar as variáveis que não serão usadas e lançar o ID como nome da linha 15 | ENEM_ESCOLA <- ENEM_ESCOLA %>% dplyr::select(-c(ano, tipo, localizacao, ICG)) 16 | ENEM_ESCOLA$INSE <- scale(ENEM_ESCOLA$INSE) 17 | ENEM_ESCOLA$INSE2 <- ENEM_ESCOLA$INSE^2 18 | 19 | # criação dos três modelo iniciais, usando step 20 | regENEMBack <- step(lm(nota ~ . -id, data = ENEM_ESCOLA), direction = "backward") 21 | regENEMForw <- step(lm(nota ~ . -id, data = ENEM_ESCOLA), direction = "forward") 22 | regENEMBoth <- step(lm(nota ~ . -id, data = ENEM_ESCOLA), direction = "both") 23 | 24 | # comparação dos modelos usando a função stargazer 25 | stargazer(regENEMBack, regENEMForw, regENEMBoth, type="text", object.names = TRUE, title="Modelos ENEM", single.row=TRUE) 26 | 27 | # comapração dos modelos usando métricas auxiliares 28 | test_performance(regENEMBack, regENEMForw, regENEMBoth) # modelos back e both são iguais e superiores 29 | compare_performance(regENEMBack, regENEMForw, regENEMBoth, rank = TRUE, verbose = FALSE) # modelo forw possui performance inferior 30 | plot(compare_performance(regENEMBack, regENEMForw, regENEMBoth, rank = TRUE, verbose = FALSE)) 31 | 32 | # 33 | plot_summs(regENEMBack, regENEMForw, regENEMBoth, model.names = c("Backward", "Forward", "Both")) 34 | 35 | # 36 | check_model(regENEMBoth) 37 | shapiro.test(residuals(regENEMBoth)) 38 | bptest(regENEMBoth) 39 | check_heteroscedasticity(regENEMBoth) 40 | check_collinearity(regENEMBoth) 41 | check_outliers(regENEMBoth) 42 | 43 | # importância 44 | corrplot(cor(ENEM_ESCOLA)) 45 | varImp(regENEMBoth) 46 | 47 | summary(regENEMBoth) 48 | 49 | regENEMBoth2 <- step(lm(nota ~ INSE + INSE2 + TDI_EM + MHA_EM + ICG_N2 + ICG_N3 + ICG_N4, data = ENEM_ESCOLA), direction = "both") 50 | test_performance(regENEMBoth, regENEMBoth2) 51 | check_model(regENEMBoth2) 52 | 53 | summary(regENEMBoth2) 54 | 55 | regENEMBoth2 <- step(lm(nota ~ INSE + INSE2 + TDI_EM + ICG_N2 + ICG_N4, data = ENEM_ESCOLA), direction = "both") 56 | test_performance(regENEMBoth, regENEMBoth2) 57 | check_model(regENEMBoth2) 58 | 59 | summary(regENEMBoth2) 60 | 61 | # regressões teóricas 62 | avPlots(regENEMBoth2, ask=FALSE, onepage=TRUE, id.method="identify") 63 | influencePlot(regENEMBoth2, id.method="identify", main="Influence Plot", sub="Circle size is proportional to Cook’s distance") 64 | residualPlots(regENEMBoth2) 65 | 66 | ENEM_ESCOLA2 <- ENEM_ESCOLA %>% slice(-c(332, 424, 430, 460, 461)) 67 | 68 | regENEMBoth3 <- lm(nota ~ INSE + INSE2 + TDI_EM + ICG_N2 + ICG_N4, data = ENEM_ESCOLA2) 69 | check_model(regENEMBoth3) 70 | 71 | shapiro.test(residuals(regENEMBoth3)) 72 | bptest(regENEMBoth3) 73 | 74 | # regressões teóricas 75 | avPlots(regENEMBoth3, ask=FALSE, onepage=TRUE, id.method="identify") 76 | influencePlot(regENEMBoth3, id.method="identify", main="Influence Plot", sub="Circle size is proportional to Cook’s distance") 77 | -------------------------------------------------------------------------------- /scripts/app/its_energia.R: -------------------------------------------------------------------------------- 1 | #### pacotes ---- 2 | pacman::p_load(CausalImpact, janitor, readxl, strucchange, tidyverse) 3 | 4 | #### etl ---- 5 | energia_pe <- readxl::read_excel( 6 | 'bases_originais/consumo_energia_pe.xlsx' 7 | ) %>% clean_names() %>% 8 | mutate( 9 | indice = seq_along(ano) 10 | ) 11 | 12 | #### série interrompida ---- 13 | energia_bp <- breakpoints(energia_pe$rural_mwh ~ energia_pe$indice) # Detectar pontos de quebra 14 | 15 | summary(energia_bp) 16 | 17 | energia_q1 <- energia_bp$breakpoints[1] 18 | energia_q2 <- energia_bp$breakpoints[2] 19 | 20 | #### impacto ---- 21 | ##### quebra 1 ---- 22 | pre_energia_q1 <- c(1, energia_q1-1) 23 | pos_energia_q1 <- c(energia_q1, energia_q2-1) 24 | 25 | dados_q1 <- energia_pe %>% 26 | filter( 27 | indice < energia_q2 28 | ) %>% 29 | pull(rural_mwh) 30 | 31 | impact_energia_q1 <- CausalImpact(dados_q1, pre_energia_q1, pos_energia_q1) 32 | 33 | # Resumo dos resultados 34 | summary(impact_energia_q1) 35 | 36 | # Plotar os resultados 37 | plot(impact_energia_q1) 38 | 39 | ##### quebra 2 ---- 40 | pre_energia_q2 <- c( 41 | 1, 42 | energia_q2-energia_q1-1) 43 | 44 | pos_energia_q2 <- c( 45 | energia_q2-energia_q1, 46 | energia_pe %>% nrow()-energia_q1) 47 | 48 | dados_q2 <- energia_pe %>% 49 | filter( 50 | indice >= energia_q1+1 51 | ) %>% 52 | pull(rural_mwh) 53 | 54 | impact_energia_q2 <- CausalImpact(dados_q2, pre_energia_q2, pos_energia_q2) 55 | 56 | # Resumo dos resultados 57 | summary(impact_energia_q2) 58 | 59 | # Plotar os resultados 60 | plot(impact_energia_q2) 61 | 62 | #### gráfico customizado ---- 63 | energia_previsao <- fitted(energia_bp, breaks = length(energia_bp$breakpoints)) 64 | 65 | # Preparar os dados para o plot 66 | energia_previsao_df <- data.frame( 67 | tempo = energia_pe$ano, 68 | real = energia_pe$rural_mwh, 69 | previsto = energia_previsao 70 | ) 71 | 72 | # rótulos 73 | energia_labels <- data.frame( 74 | tempo = energia_pe$ano[energia_bp$breakpoints], 75 | label = energia_pe$ano[energia_bp$breakpoints], 76 | max_y = max(energia_pe$rural_mwh) + max(energia_pe$rural_mwh)*0.075, 77 | min_y = min(energia_pe$rural_mwh) 78 | ) 79 | 80 | # Plot com os resultados 81 | ggplot(energia_previsao_df, aes(x = tempo, y = real)) + 82 | geom_point( 83 | aes(color = "Consumo Rural"), 84 | alpha = 0.7) + 85 | geom_smooth( 86 | aes(y = previsto, color = "Tendência"), 87 | method = "loess", 88 | span = 0.2, 89 | se = TRUE, 90 | size = 1.2, 91 | fill = "gray70") + 92 | geom_vline( 93 | xintercept = energia_pe$ano[energia_bp$breakpoints], 94 | color = "grey", 95 | linetype = "dashed", 96 | size = 1, 97 | aes(linetype = "Quebras detectadas")) + 98 | geom_label( 99 | data = energia_labels, 100 | aes(x = tempo, y = max_y, label = label), 101 | fill = "grey", 102 | color = "black", 103 | size = 3, 104 | fontface = "bold", 105 | label.padding = unit(0.5, "lines"), 106 | label.r = unit(0.5, "lines"), 107 | label.size = 0) + # Rótulos das quebras 108 | scale_color_manual( 109 | values = c("Consumo Rural" = "blue", "Tendência" = "red", "Quebras detectadas" = 'grey'), 110 | name = NULL 111 | ) + 112 | labs( 113 | title = "Consumo Rural de Energia", 114 | subtitle = 'Quebras estruturais na série', 115 | x = NULL, 116 | y = "Mwh", 117 | color = NULL, 118 | linetype = NULL 119 | ) + 120 | theme_minimal() + 121 | theme( 122 | panel.grid = element_blank(), 123 | legend.position = "bottom", 124 | legend.box = "horizontal" 125 | ) 126 | -------------------------------------------------------------------------------- /scripts/app/series_interrompidas_energia.R: -------------------------------------------------------------------------------- 1 | #### pacotes ---- 2 | pacman::p_load(CausalImpact, janitor, readxl, strucchange, tidyverse) 3 | 4 | #### etl ---- 5 | energia_pe <- readxl::read_excel( 6 | 'bases_originais/consumo_energia_pe.xlsx' 7 | ) %>% clean_names() %>% 8 | mutate( 9 | indice = seq_along(ano) 10 | ) 11 | 12 | #### série interrompida ---- 13 | energia_bp <- breakpoints(energia_pe$rural_mwh ~ energia_pe$indice) # Detectar pontos de quebra 14 | summary(energia_bp) 15 | 16 | energia_q1 <- energia_bp$breakpoints[1] 17 | energia_q2 <- energia_bp$breakpoints[2] 18 | 19 | #### impacto ---- 20 | ##### quebra 1 ---- 21 | pre_energia_q1 <- c(1, energia_q1-1) 22 | pos_energia_q1 <- c(energia_q1, energia_q2-1) 23 | 24 | dados_q1 <- energia_pe %>% 25 | filter( 26 | indice < energia_q2 27 | ) %>% 28 | pull(rural_mwh) 29 | 30 | impact_energia_q1 <- CausalImpact(dados_q1, pre_energia_q1, pos_energia_q2) 31 | 32 | # Resumo dos resultados 33 | summary(impact_energia_q1) 34 | 35 | # Plotar os resultados 36 | plot(impact_energia_q1) 37 | 38 | ##### quebra 2 ---- 39 | pre_energia_q2 <- c( 40 | 1, 41 | energia_q2-energia_q1-1) 42 | 43 | pos_energia_q2 <- c( 44 | energia_q2-energia_q1, 45 | energia_pe %>% nrow()-energia_q1) 46 | 47 | dados_q2 <- energia_pe %>% 48 | filter( 49 | indice >= energia_q1+1 50 | ) %>% 51 | pull(rural_mwh) 52 | 53 | impact_energia_q2 <- CausalImpact(dados_q2, pre_energia_q2, pos_energia_q2) 54 | 55 | # Resumo dos resultados 56 | summary(impact_energia_q2) 57 | 58 | # Plotar os resultados 59 | plot(impact_energia_q2) 60 | 61 | #### gráfico customizado ---- 62 | energia_previsao <- fitted(energia_bp, breaks = length(energia_bp$breakpoints)) 63 | 64 | # Preparar os dados para o plot 65 | energia_previsao_df <- data.frame( 66 | tempo = energia_pe$ano, 67 | real = energia_pe$rural_mwh, 68 | previsto = energia_previsao 69 | ) 70 | 71 | # rótulos 72 | energia_labels <- data.frame( 73 | tempo = energia_pe$ano[energia_bp$breakpoints], 74 | label = energia_pe$ano[energia_bp$breakpoints], 75 | max_y = max(energia_pe$rural_mwh) + max(energia_pe$rural_mwh)*0.075, 76 | min_y = min(energia_pe$rural_mwh) 77 | ) 78 | 79 | # Plot com os resultados 80 | ggplot(energia_previsao_df, aes(x = tempo, y = real)) + 81 | geom_point( 82 | aes(color = "Consumo Rural"), 83 | alpha = 0.7) + 84 | geom_smooth( 85 | aes(y = previsto, color = "Tendência"), 86 | method = "loess", 87 | span = 0.2, 88 | se = TRUE, 89 | size = 1.2, 90 | fill = "gray70") + 91 | geom_vline( 92 | xintercept = energia_pe$ano[energia_bp$breakpoints], 93 | color = "grey", 94 | linetype = "dashed", 95 | size = 1, 96 | aes(linetype = "Quebras detectadas")) + 97 | geom_label( 98 | data = energia_labels, 99 | aes(x = tempo, y = max_y, label = label), 100 | fill = "grey", 101 | color = "black", 102 | size = 3, 103 | fontface = "bold", 104 | label.padding = unit(0.5, "lines"), 105 | label.r = unit(0.5, "lines"), 106 | label.size = 0) + # Rótulos das quebras 107 | scale_color_manual( 108 | values = c("Consumo Rural" = "blue", "Tendência" = "red", "Quebras detectadas" = 'grey'), 109 | name = NULL 110 | ) + 111 | labs( 112 | title = "Consumo Rural de Energia", 113 | subtitle = 'Quebras estruturais na série', 114 | x = NULL, 115 | y = "Mwh", 116 | color = NULL, 117 | linetype = NULL 118 | ) + 119 | theme_minimal() + 120 | theme( 121 | panel.grid = element_blank(), 122 | legend.position = "bottom", 123 | legend.box = "horizontal" 124 | ) 125 | -------------------------------------------------------------------------------- /scripts/machine_learning/ia_explicavel.R: -------------------------------------------------------------------------------- 1 | # carrega as bibliotecas 2 | pacman::p_load( 3 | caret, corrplot, data.table, dplyr, fastDummies, ggplot2, SmartEDA, tidyverse) 4 | 5 | # preparação 6 | 7 | particaoIris = createDataPartition(iris$Sepal.Length, p=.7, list = F) # cria a partição 70-30 8 | treinoIris = iris[particaoIris, ] # treino 9 | testeIris = iris[-particaoIris, ] # - treino = teste 10 | 11 | iris_formula <- Sepal.Length ~ . 12 | 13 | lista_modelos <- c('lm', 'glmnet', 'glmboost', 'rpart', 'cforest') 14 | 15 | total_cv <- 10 16 | 17 | train.control <- trainControl(method = "cv", number = total_cv, verboseIter = T) # controle de treino 18 | 19 | pacman::p_load(caretEnsemble, doParallel) 20 | 21 | registerDoParallel(cores = detectCores() - 1) 22 | 23 | # modelagem 24 | 25 | iris_modelos <- caretList( 26 | iris_formula, 27 | data = treinoIris, 28 | methodList = lista_modelos, 29 | metric = "RMSE", 30 | trControl = train.control, 31 | tuneLength = 5) 32 | 33 | pacman::p_load(DALEX, iml, pdp) 34 | 35 | # importância 36 | 37 | idepe_varImp <- varImp(iris_modelos$cforest) 38 | 39 | idepe_varImp_df <- as.data.frame(as.matrix(idepe_varImp$importance)) 40 | 41 | idepe_varImp_df <- idepe_varImp_df %>% mutate( 42 | variável = c('Sepal Width ', 'Petal Length ', 'Petal Width', 'Versicolor?', 'Virgínica?') 43 | ) 44 | 45 | grafico_varImp <- ggplot(data=idepe_varImp_df, aes(x=reorder(variável, -Overall), y=Overall)) + geom_bar(stat="identity", fill='#007095') + theme_minimal() + 46 | coord_flip() + 47 | labs( 48 | title = ~ underline("Importância das variáveis usadas no modelo"), 49 | subtitle = "Iris", 50 | caption = 'Modelo: Floresta Aleatória', 51 | x = '', 52 | y = 'Importância Relativa') + theme( 53 | plot.title = element_text(face = 'bold', lineheight = 1, size = 16, color = "#007095"), 54 | plot.subtitle = element_text(face = 'italic', size = 12, color = "#007095") , 55 | plot.caption = element_text(size = 10, color = "#007095") , 56 | strip.text = element_text(size = 10, color = "white") , 57 | axis.title.x = element_text(hjust=0, color = "#007095"), 58 | axis.text.x = element_text(face = 'bold', colour = '#5bc0de', size = 12, angle = 75, vjust = .5), 59 | axis.title.y = element_text(hjust=0, color = "#007095"), 60 | axis.text.y = element_text(face = 'bold', colour = '#5bc0de', size = 12), 61 | legend.position="bottom", 62 | legend.box = "horizontal", 63 | legend.background = element_rect(fill="#dee2e6", colour ="white") 64 | ) 65 | 66 | grafico_varImp 67 | 68 | # perfil parcial 69 | 70 | treinoIris_x <- dplyr::select(treinoIris, -Sepal.Length) 71 | testeIris_x <- dplyr::select(testeIris, -Sepal.Length) 72 | 73 | explainer_rf <- DALEX::explain(model = iris_modelos$cforest, data = testeIris_x, y = testeIris$Sepal.Length, label = "Random Forest") 74 | 75 | pdp_rf_species <- model_profile(explainer = explainer_rf, variables = "Petal.Length", groups = "Species") 76 | 77 | grafico_pdp <- plot(pdp_rf_species, geom = "profiles") + 78 | labs( 79 | title = ~ underline("Perfis de dependência parcial para PETAL LENGTH e SPECIES"), 80 | subtitle = "Iris", 81 | caption = 'Modelo: Florestas Aleatórias', 82 | tag = '', 83 | x = 'Petal Length', 84 | y = 'Sepal Length', 85 | colour = "Species") + 86 | scale_colour_manual( 87 | values = c('#f68d7c', '#8ecda6', 'blue'), 88 | name = "Species") + 89 | theme( 90 | plot.title = element_text(face = 'bold', lineheight = 1, size = 16, color = "#007095"), 91 | plot.subtitle = element_text(face = 'italic', size = 12, color = "#007095") , 92 | plot.caption = element_text(size = 10, color = "#007095") , 93 | strip.text = element_text(size = 10, color = "white") , 94 | axis.title.x = element_text(hjust=0, color = "#007095"), 95 | axis.text.x = element_text(face = 'bold', colour = '#5bc0de', size = 12), 96 | axis.title.y = element_text(hjust=0, color = "#007095"), 97 | axis.text.y = element_text(face = 'bold', colour = '#5bc0de', size = 12), 98 | legend.position="bottom", 99 | legend.box = "horizontal", 100 | legend.background = element_rect(fill="#dee2e6", colour ="white") 101 | ) 102 | 103 | grafico_pdp 104 | -------------------------------------------------------------------------------- /bases_tratadas/regras_enem.csv: -------------------------------------------------------------------------------- 1 | "";"lhs";"rhs";"support";"confidence";"coverage";"lift";"count" 2 | "71";"{localizacao=Urbana,TDI_EM=[25.6,65.3],MHA_EM=[3.8,5.4)}";"{tipo=Regular}";0,214;0,961;0,223;3,71;124 3 | "43";"{TDI_EM=[25.6,65.3],MHA_EM=[3.8,5.4)}";"{tipo=Regular}";0,218;0,955;0,228;3,685;126 4 | "46";"{localizacao=Urbana,MHA_EM=[3.8,5.4)}";"{tipo=Regular}";0,252;0,785;0,321;3,03;146 5 | "5";"{tipo=Regular}";"{MHA_EM=[3.8,5.4)}";0,259;1;0,259;3,016;150 6 | "6";"{MHA_EM=[3.8,5.4)}";"{tipo=Regular}";0,259;0,781;0,332;3,016;150 7 | "48";"{tipo=Regular,localizacao=Urbana}";"{TDI_EM=[25.6,65.3]}";0,214;0,849;0,252;2,522;124 8 | "49";"{localizacao=Urbana,TDI_EM=[25.6,65.3]}";"{tipo=Regular}";0,214;0,649;0,33;2,506;124 9 | "7";"{tipo=Regular}";"{TDI_EM=[25.6,65.3]}";0,218;0,84;0,259;2,494;126 10 | "8";"{TDI_EM=[25.6,65.3]}";"{tipo=Regular}";0,218;0,646;0,337;2,494;126 11 | "36";"{tipo=EREM,MHA_EM=[9.5,10.5]}";"{ICG=N2}";0,206;0,559;0,368;2,469;119 12 | "35";"{tipo=EREM,ICG=N2}";"{MHA_EM=[9.5,10.5]}";0,206;0,967;0,212;2,214;119 13 | "2";"{ICG=N2}";"{MHA_EM=[9.5,10.5]}";0,212;0,939;0,226;2,149;123 14 | "53";"{localizacao=Urbana,MHA_EM=[3.8,5.4)}";"{TDI_EM=[25.6,65.3]}";0,223;0,694;0,321;2,059;129 15 | "16";"{MHA_EM=[3.8,5.4)}";"{TDI_EM=[25.6,65.3]}";0,228;0,688;0,332;2,041;132 16 | "17";"{TDI_EM=[25.6,65.3]}";"{MHA_EM=[3.8,5.4)}";0,228;0,677;0,337;2,041;132 17 | "57";"{TDI_EM=[13.3,25.6),MHA_EM=[9.5,10.5]}";"{tipo=EREM}";0,2;0,983;0,204;1,784;116 18 | "34";"{ICG=N2,MHA_EM=[9.5,10.5]}";"{tipo=EREM}";0,206;0,967;0,212;1,756;119 19 | "3";"{ICG=N2}";"{tipo=EREM}";0,212;0,939;0,226;1,704;123 20 | "59";"{tipo=EREM,MHA_EM=[9.5,10.5]}";"{TDI_EM=[13.3,25.6)}";0,2;0,545;0,368;1,651;116 21 | "61";"{localizacao=Urbana,TDI_EM=[13.3,25.6)}";"{tipo=EREM}";0,283;0,896;0,316;1,627;164 22 | "22";"{TDI_EM=[13.3,25.6)}";"{tipo=EREM}";0,29;0,88;0,33;1,596;168 23 | "23";"{tipo=EREM}";"{TDI_EM=[13.3,25.6)}";0,29;0,527;0,551;1,596;168 24 | "58";"{tipo=EREM,TDI_EM=[13.3,25.6)}";"{MHA_EM=[9.5,10.5]}";0,2;0,69;0,29;1,58;116 25 | "66";"{localizacao=Urbana,MHA_EM=[9.5,10.5]}";"{tipo=EREM}";0,356;0,848;0,42;1,539;206 26 | "29";"{MHA_EM=[9.5,10.5]}";"{tipo=EREM}";0,368;0,842;0,437;1,528;213 27 | "30";"{tipo=EREM}";"{MHA_EM=[9.5,10.5]}";0,368;0,668;0,551;1,528;213 28 | "21";"{TDI_EM=[13.3,25.6)}";"{MHA_EM=[9.5,10.5]}";0,204;0,618;0,33;1,414;118 29 | "51";"{localizacao=Urbana,INSE=[3.54,4.26)}";"{tipo=EREM}";0,207;0,719;0,288;1,304;120 30 | "10";"{INSE=[3.54,4.26)}";"{tipo=EREM}";0,211;0,713;0,295;1,295;122 31 | "56";"{localizacao=Urbana,REP_EM=[2.7,5)}";"{tipo=EREM}";0,207;0,635;0,326;1,152;120 32 | "19";"{REP_EM=[2.7,5)}";"{tipo=EREM}";0,209;0,634;0,33;1,15;121 33 | "64";"{localizacao=Urbana,ICG=N4}";"{tipo=EREM}";0,231;0,623;0,371;1,131;134 34 | "27";"{ICG=N4}";"{tipo=EREM}";0,237;0,617;0,383;1,12;137 35 | "1";"{MHA_EM=[5.4,9.5)}";"{localizacao=Urbana}";0,23;0,993;0,231;1,023;133 36 | "55";"{tipo=EREM,REP_EM=[2.7,5)}";"{localizacao=Urbana}";0,207;0,992;0,209;1,022;120 37 | "20";"{REP_EM=[2.7,5)}";"{localizacao=Urbana}";0,326;0,99;0,33;1,019;189 38 | "47";"{tipo=Regular,TDI_EM=[25.6,65.3]}";"{localizacao=Urbana}";0,214;0,984;0,218;1,014;124 39 | "50";"{tipo=EREM,INSE=[3.54,4.26)}";"{localizacao=Urbana}";0,207;0,984;0,211;1,013;120 40 | "26";"{TDI_EM=[25.6,65.3]}";"{localizacao=Urbana}";0,33;0,979;0,337;1,009;191 41 | "32";"{tipo=EREM}";"{localizacao=Urbana}";0,539;0,978;0,551;1,008;312 42 | "33";"{localizacao=Urbana}";"{tipo=EREM}";0,539;0,555;0,971;1,008;312 43 | "11";"{INSE=[3.54,4.26)}";"{localizacao=Urbana}";0,288;0,977;0,295;1,006;167 44 | "14";"{TDI_EM=[0,13.3)}";"{localizacao=Urbana}";0,325;0,974;0,333;1,004;188 45 | "9";"{tipo=Regular}";"{localizacao=Urbana}";0,252;0,973;0,259;1,003;146 46 | "15";"{REP_EM=[0,2.7)}";"{localizacao=Urbana}";0,32;0,974;0,328;1,003;185 47 | "13";"{INSE=[4.26,4.55)}";"{localizacao=Urbana}";0,292;0,971;0,301;1,001;169 48 | "4";"{ICG=N2}";"{localizacao=Urbana}";0,219;0,969;0,226;0,999;127 49 | "18";"{MHA_EM=[3.8,5.4)}";"{localizacao=Urbana}";0,321;0,969;0,332;0,998;186 50 | "28";"{ICG=N4}";"{localizacao=Urbana}";0,371;0,968;0,383;0,998;215 51 | "31";"{MHA_EM=[9.5,10.5]}";"{localizacao=Urbana}";0,42;0,96;0,437;0,99;243 52 | "24";"{TDI_EM=[13.3,25.6)}";"{localizacao=Urbana}";0,316;0,958;0,33;0,987;183 53 | "12";"{INSE=[4.55,6.35]}";"{localizacao=Urbana}";0,287;0,954;0,301;0,983;166 54 | "25";"{REP_EM=[5,33.2]}";"{localizacao=Urbana}";0,325;0,949;0,342;0,978;188 55 | -------------------------------------------------------------------------------- /scripts/app/script_alan_its.R: -------------------------------------------------------------------------------- 1 | 2 | # Pacotes 3 | pacman::p_load( 4 | AICcmodavg, 5 | nlme, 6 | readxl, 7 | tidyverse) 8 | 9 | # Dados 10 | df <- read_excel("bases_originais/alan_dados EFB.xlsx") 11 | 12 | # modelos 13 | names(df) 14 | 15 | m1 <- lm(taxa_paulista ~ tempo + nivel + trend, data = df) 16 | summary(m1) 17 | 18 | m2 <- lm(taxa_cariacica ~ tempo + nivel + trend, data = df) 19 | summary(m2) 20 | 21 | m3 <- lm(taxa_sao_jose ~ tempo + nivel + trend, data = df) 22 | summary(m3) 23 | 24 | m4 <- lm(taxa_goiania ~ tempo + nivel + trend, data = df) 25 | summary(m4) 26 | 27 | m5 <- lm(taxa_ananindeua ~ tempo + nivel + trend, data = df) 28 | summary(m5) 29 | 30 | ## GLS 31 | m1_gls <- gls(taxa_paulista ~ tempo + nivel + trend, data = df, method="ML") 32 | summary(m1_gls) 33 | 34 | # Graficos 35 | 36 | plot(df$ano, df$taxa_paulista, 37 | ylab = "Taxa de homicídios", 38 | xlab = "") 39 | abline(v = 2019, lty = "dotted", col = "red") 40 | 41 | lines(df$ano[1:23], fitted(m1)[1:23], col="red",lwd=2) 42 | 43 | lines(df$ano[24:27], fitted(m1)[24:27], col="red",lwd=2) 44 | 45 | df <- df %>% mutate( 46 | m1_pred = predictSE.gls (m1, df, se.fit=T)$fit, 47 | m1_se = predictSE.gls (m1, df, se.fit=T)$se 48 | ) 49 | 50 | ggplot(df,aes(ano, taxa_paulista))+ 51 | geom_ribbon(aes(ymin = m1_pred - (1.96*m1_se), 52 | ymax = m1_pred + (1.96*m1_se)), fill = "lightblue", alpha = .4)+ 53 | geom_line(aes(ano,m1_pred),color="black",lty=1)+ 54 | geom_point(alpha=0.3) + 55 | labs(x = "", 56 | y = "Taxa de homicidios") + 57 | theme_bw() + 58 | geom_vline(xintercept=2019, linetype="dashed", 59 | color = "red", size=2, alpha = .5) 60 | 61 | 62 | # https://rpubs.com/chrissyhroberts/1006858 63 | 64 | m1 <- lm(taxa_paulista ~ tempo + nivel + trend, data = df) 65 | summary(m1) 66 | 67 | mod.1 = taxa_paulista ~ tempo + nivel + trend 68 | 69 | fx = function(pval,qval){summary(gls(mod.1, data = df, 70 | correlation= corARMA(p=pval,q=qval, form = ~ tempo),method="ML"))$AIC} 71 | 72 | p = summary(gls(mod.1, data = df,method="ML"))$AIC 73 | message(str_c ("AIC Uncorrelated model = ",p)) 74 | 75 | autocorrel = expand.grid(pval = 0:2, qval = 0:2) 76 | 77 | for(i in 2:nrow(autocorrel)){p[i] = try(summary(gls(mod.1, data = df, correlation= corARMA(p=autocorrel$pval[i],q=autocorrel$qval[i], form = ~ tempo),method="ML"))$AIC)} 78 | 79 | autocorrel<- autocorrel %>% 80 | mutate(AIC = as.numeric(p)) %>% 81 | arrange(AIC) 82 | 83 | 84 | autocorrel 85 | 86 | # https://rpubs.com/chrissyhroberts/1006858 87 | 88 | 89 | # Residuos 90 | library(performance) 91 | 92 | check_model(m1) 93 | check_model(m2) 94 | check_model(m3) 95 | check_model(m4) 96 | check_model(m5) 97 | 98 | 99 | ### 100 | 101 | ##ggplot for Interrupted time series analysis 102 | ggplot(data = exercise)+ 103 | geom_line(aes(x=time,y=factual_accident_number, 104 | col="orange")) + 105 | geom_line(aes(x=time,y=counterfact_accident_number, 106 | col="blue")) + 107 | geom_vline(xintercept = 28, 108 | col ="red", 109 | linetype = "twodash")+ 110 | geom_segment(aes(x = 38, y = 600, xend = 38, yend = 737 ), 111 | col = "cadetblue4")+ 112 | annotate(geom = "label", 113 | x = 29, y = 900, 114 | label = "Intervention begin", 115 | col = "red")+ 116 | annotate(geom = "label", 117 | x = 40, y = 700, 118 | label = "Intervention impact", 119 | col = "cadetblue4", 120 | size = 2.5)+ 121 | xlab(label = "Time point") + 122 | ylab(label = "Number of accidents") + 123 | labs(title = "Relationship between number of accidents and time", 124 | color = "Intervention")+ 125 | scale_color_discrete(name = "Intervention", 126 | labels = c("without policy (counterfactual)","with policy"))+ 127 | theme_bw()+ 128 | theme(legend.position = c(0.2,0.85))+ 129 | geom_smooth(method = lm,aes(x = time, y=counterfact_accident_number), 130 | size = 1, se = FALSE)+ 131 | geom_smooth(method = lm,aes(x = time,y=factual_accident_number), 132 | size = 1, se = FALSE, color = "red") 133 | -------------------------------------------------------------------------------- /scripts/analise/aed_instagram_fafire.R: -------------------------------------------------------------------------------- 1 | #### PREPARAÇÃO #### 2 | ### PACOTES ### 3 | pacman::p_load( 4 | # ETL 5 | data.table, dplyr, lubridate, tidyr, 6 | # Gráficos 7 | GGally, ggcorrplot, ggplot2, gt, gtExtras, gtsummary, plotly, 8 | # Renderização 9 | kableExtra 10 | ) 11 | 12 | ### ETL ### 13 | instagram_unifafire <- fread('https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/master/bases_tratadas/instagram_unifafire.csv') 14 | 15 | instagram_unifafire %>% str() 16 | 17 | # mudar o tipo de dado das colunas mes e turno para fator 18 | instagram_unifafire <- instagram_unifafire %>% 19 | mutate_at( 20 | c('mes', 'turno'), 21 | as.factor) 22 | 23 | # mudar o tipo de dado da coluna "Data" para date 24 | instagram_unifafire <- instagram_unifafire %>% 25 | mutate_at( 26 | c('Data'), 27 | mdy) 28 | 29 | # converter mes para 30 | instagram_unifafire <- instagram_unifafire %>% 31 | mutate( 32 | mes = month(Data, label = TRUE) 33 | ) 34 | 35 | ### AED ### 36 | ## AED NUMÉRICA ## 37 | # tabela com sumário dos dados 38 | instagram_unifafire %>% 39 | select(Curtidas, Comentários, Visualizações, mes, turno) %>% 40 | tbl_summary() # cria o sumário 41 | 42 | ## AED MISTA ## 43 | # cria tabela com gráficos e sumários 44 | instagram_unifafire %>% 45 | select(Curtidas, Comentários, Visualizações, mes, turno) %>% gt_plt_summary() %>% #função para gerar a tabela 46 | cols_label( # customizações 47 | name = "Variável", # troca o nome da coluna 1 48 | value = "Gráfico", # troca o nome da coluna 2 49 | type = "", # remove o tipo 50 | n_missing = "Valores Ausentes", # troca o nome da coluna 3 51 | Mean = "Média", # troca o nome da coluna 4 52 | Median = "Mediana", # troca o nome da coluna 5 53 | SD = "Desvio" # troca o nome da coluna 6 54 | ) %>% 55 | tab_header( 56 | title = "Posts no Instagram da UniFAFIRE", # troca o tículo 57 | subtitle = "https://www.instagram.com/unifafire/" # troca o subtítulo 58 | ) 59 | 60 | ## AED GRÁFICA ## 61 | ## Gráficos que resumem os dados # 62 | # BOX PLOT # 63 | # gráfico para visualizar a separação dos dados, inclusive por categoria 64 | # x deve ser um fator, y uma métrica e cor o fator usado em x 65 | bp_curtidas_turno <- instagram_unifafire %>% 66 | ggplot(aes(x=mes, y=Curtidas, color=mes)) + 67 | geom_boxplot() 68 | 69 | bp_curtidas_turno %>% ggplotly() # torna o gráfico interativo 70 | 71 | # HISTOGRAMA # 72 | # gráfico de frequência, inclusive por categoria 73 | # x deve ser numérico e color deve ser um fator 74 | # podemos colocar a cor da linha com fill e a posição 75 | hist_curtidas_turno <- instagram_unifafire %>% 76 | ggplot(aes(x=Curtidas, color=turno)) + 77 | geom_histogram(fill="white", position="identity") 78 | hist_curtidas_turno %>% ggplotly() # torna o gráfico interativo 79 | 80 | # DENSIDADE 81 | # gráfico de frequência suavizada, inclusive por categoria 82 | # x deve ser numério e color deve ser um fator 83 | dens_curtidas_turno <- instagram_unifafire %>% 84 | ggplot(aes(x=Curtidas, color=turno)) + 85 | geom_density() 86 | dens_curtidas_turno %>% ggplotly() # torna o gráfico interativo 87 | 88 | # BARRAS 89 | # gráfico que apresenta os totais de uma categoria 90 | # x deve ser uma categoria, weight deve ser numério e fill deve ser a mesma categoria de x 91 | barras_curtidas_mes <- instagram_unifafire %>% 92 | ggplot(aes(turno)) + 93 | geom_bar(aes(weight = Curtidas, fill = turno)) + coord_flip() 94 | barras_curtidas_mes %>% ggplotly() # torna o gráfico interativo 95 | 96 | # SÉRIE TEMPORAL 97 | # gráfico que apresenta um número ao longo do tempo 98 | # X deve ser date e y deve ser numérico, color deve ser uma categoria 99 | st_curtidas_data <- instagram_unifafire %>% 100 | ggplot(aes(x = Data, y = Curtidas)) + 101 | geom_line(aes(color = turno)) 102 | st_curtidas_data %>% ggplotly() # torna o gráfico interativo 103 | 104 | # DISPERSÃO 105 | # a primeira versão associa duas variáveis 106 | # x e y devem ser numéricos 107 | sct_curtidas_comentarios <- instagram_unifafire %>% 108 | ggplot(aes(x=Curtidas, y=Comentários)) + 109 | geom_point() + # cria os pontos 110 | geom_smooth() # cria a curva de associação 111 | 112 | sct_curtidas_comentarios %>% ggplotly() # torna o gráfico interativo 113 | 114 | # a segunda versão associa três variáveis, com a terceria indicando o tamanho da circunferência dos pontos 115 | bolha_curtidas_comentarios <- instagram_unifafire %>% 116 | ggplot(aes(x=Curtidas, y=Comentários)) + 117 | geom_point(aes(size=Visualizações)) + # tamanho dos pontos 118 | geom_smooth() # cria a curva de associação 119 | bolha_curtidas_comentarios %>% ggplotly() # torna o gráfico dinâmico 120 | -------------------------------------------------------------------------------- /scripts/machine_learning/regressao_com_cv_ENEM.R: -------------------------------------------------------------------------------- 1 | # carrega as bibliotecas 2 | pacman::p_load(ade4, car, caret, corrplot, data.table, doParallel, dplyr, fastDummies, forcats, ggplot2, mlbench, mltools, randomForest, rattle, tidyverse) 3 | 4 | # leitura da base de dados 5 | ENEM_ESCOLA_2019 <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/etl_com_r/master/bases_tratadas/ENEM_ESCOLA_2019.csv', stringsAsFactors = T) # carregando a base já tratada para o ambiente do R 6 | 7 | ENEM_ESCOLA_2019 <- ENEM_ESCOLA_2019 %>% dummy_cols() 8 | 9 | names(ENEM_ESCOLA_2019)[17:28] <- c( 10 | 'EREM', 'ETE', 'Federal', 'Privada', 'Regular', 'Rural', 'Urbana', 'ICG2', 'ICG3', 'ICG4', 'ICG5', 'ICG6' 11 | ) 12 | 13 | corrplot(cor(ENEM_ESCOLA_2019[ , c(6:28)])) # correlação entre as variáveis 14 | 15 | # Treino e Teste: Pré-processamento 16 | particaoENEM = createDataPartition(ENEM_ESCOLA_2019$nota, p=.7, list = F) # cria a partição 70-30 17 | treinoENEM = ENEM_ESCOLA_2019[particaoENEM, ] # treino 18 | testeENEM = ENEM_ESCOLA_2019[-particaoENEM, ] # - treino = teste 19 | 20 | # Validação Cruzada: Pré-processamento 21 | # Controle de treinamento 22 | train.control <- trainControl(method = "cv", number = 100, verboseIter = T) # controle de treino 23 | 24 | ENEM_formula <- nota ~ TDI_03 + MHA_03 + REP_EM + EREM + ETE + Federal + Privada + Regular + Rural + Urbana 25 | 26 | registerDoParallel(cores = detectCores() - 1) 27 | 28 | # Treinamentos 29 | ## Regressão Linear penalizada 30 | ENEM_LM <- train( 31 | ENEM_formula, 32 | data = treinoENEM, 33 | method = "glmnet", 34 | trControl = train.control, tuneLength = 20) 35 | 36 | plot(ENEM_LM) 37 | summary(ENEM_LM) # sumário do modelo linear 38 | plot(varImp(ENEM_LM)) 39 | 40 | coeficientes <- coef(ENEM_LM$finalModel, ENEM_LM$bestTune$lambda) 41 | 42 | ## Árvore de Decisão 43 | ENEM_RPART <- train( 44 | ENEM_formula, 45 | data = treinoENEM, 46 | method = "rpart", 47 | trControl = train.control, tuneLength = 20) 48 | 49 | plot(ENEM_RPART) 50 | summary(ENEM_RPART) 51 | fancyRpartPlot(ENEM_RPART$finalModel) # desenho da árvore 52 | plot(varImp(ENEM_RPART)) # importância das variáveis 53 | 54 | # Bagging com Floresta Aleatória 55 | ENEM_RF <- train( 56 | ENEM_formula, 57 | data = treinoENEM, 58 | method = "cforest", 59 | trControl = train.control, tuneLength = 20) 60 | 61 | plot(ENEM_RF) # evolução do modelo 62 | plot(varImp(ENEM_RF)) # plot de importância 63 | 64 | # Boosting com Boosted Generalized Linear Model 65 | ENEM_GLMB <- train( 66 | ENEM_formula, 67 | data = treinoENEM, 68 | method = "glmboost", 69 | trControl = train.control, tuneLength = 20) 70 | 71 | plot(ENEM_GLMB) # evolução do modelo 72 | print(ENEM_GLMB) # modelo 73 | summary(ENEM_GLMB) # sumário 74 | 75 | melhor_modelo <- resamples(list(LM = ENEM_LM, RPART = ENEM_RPART, RF = ENEM_RF, GLMBOOST = ENEM_GLMB)) 76 | melhor_modelo 77 | 78 | summary(melhor_modelo) 79 | 80 | predVals <- extractPrediction(ENEM_RF, testX = testeENEM[ , -7]) 81 | 82 | pred_modelos <- data.frame( 83 | obs = testeENEM$nota, 84 | rf = predict(ENEM_RF, testeENEM) 85 | ) %>% mutate (rf_res = obs - rf) 86 | 87 | ggplot(pred_modelos, aes(obs, rf)) + 88 | geom_point() + geom_smooth() 89 | 90 | ggplot(pred_modelos, aes(rf, rf_res)) + 91 | geom_point() + geom_hline(yintercept = 0, color = "red") 92 | 93 | #################### 94 | pacman::p_load(caretEnsemble, doParallel) 95 | 96 | registerDoParallel(cores = detectCores() - 1) 97 | 98 | lista_modelos <- c('glmnet', 'rpart', 'cforest', 'glmboost') 99 | 100 | total_cv <- 100 101 | 102 | train.control <- trainControl(method = "cv", number = total_cv, verboseIter = T) # controle de treino 103 | 104 | ENEM_MELHOR_MODELO <- train( 105 | ENEM_formula, 106 | data = treinoENEM, 107 | methodList = lista_modelos, 108 | metric = "RMSE", 109 | trControl = train.control) 110 | 111 | ENEM_MELHOR_MODELO 112 | 113 | ENEM_MODELOS <- caretList( 114 | ENEM_formula, 115 | data = treinoENEM, 116 | methodList = lista_modelos, 117 | metric = "RMSE", 118 | trControl = train.control, 119 | tuneLength = 10) 120 | 121 | ENEM_MODELOS 122 | 123 | lista_resultados <- lapply( 124 | lista_modelos, 125 | function(x) {ENEM_MODELOS[[x]]$resample}) 126 | 127 | df_resultados <- do.call("bind_rows", lista_resultados) 128 | 129 | df_resultados <- df_resultados %>% mutate( 130 | Modelo = lapply(lista_modelos, function(x) {rep(x, total_cv)}) %>% unlist()) 131 | 132 | grafico_resultados <- df_resultados %>% 133 | select(RMSE, Modelo) %>% 134 | ggplot(aes(Modelo, RMSE, fill = Modelo, color = Modelo)) + 135 | geom_boxplot(show.legend = FALSE, alpha = 0.3) + 136 | theme_minimal() + 137 | coord_flip() 138 | plotly::ggplotly(grafico_resultados) 139 | 140 | df_resultados %>% 141 | select(RMSE, Modelo) %>% 142 | group_by(Modelo) %>% 143 | summarise_each(funs(min, max, median, mean, sd, n()), RMSE) %>% 144 | arrange(-mean) %>% 145 | mutate_if(is.numeric, function(x) {round(x, 3)}) %>% 146 | knitr::kable() 147 | 148 | df_resultados %>% 149 | select(Rsquared, Modelo) %>% 150 | group_by(Modelo) %>% 151 | summarise_each(funs(min, max, median, mean, sd, n()), Rsquared) %>% 152 | arrange(-mean) %>% 153 | mutate_if(is.numeric, function(x) {round(x, 3)}) %>% 154 | knitr::kable() 155 | -------------------------------------------------------------------------------- /scripts/rmarkdown/municipios_economia.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Municípios de Pernambuco" 3 | output: 4 | flexdashboard::flex_dashboard: 5 | orientation: rows 6 | # vertical_layout: scroll 7 | theme: lumen 8 | runtime: shiny 9 | --- 10 | 11 | ```{r setup, include=FALSE} 12 | knitr::opts_chunk$set(echo = TRUE) 13 | 14 | pacman::p_load(caret, corrplot, dplyr, DT, flexdashboard, lubridate, plotly, shiny, zoo) # carregar pacotes 15 | 16 | source('https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/master/scripts/rmarkdown/municipios_processamento.R') 17 | 18 | # mun_pe <- read.csv2('../../bases_tratadas/clusters_municipios_pe.csv') 19 | 20 | ``` 21 | 22 | Painel de Indicadores {data-icon="fa-chart-line" data-orientation=rows} 23 | ===================================== 24 | 25 | Controles {.sidebar} 26 | ------------------------------------- 27 | 28 | ```{r controle1, echo=FALSE, warning=FALSE, message=FALSE} 29 | 30 | radioButtons(inputId = 'radioA1', 'Selecione a RD', c('PERNAMBUCO', unique(levels(mun_pe$rd))), inline = F) 31 | 32 | checkboxGroupInput(inputId = 'radioA2', 'Selecione os Indicadores', names(mun_pe)[-c(1:3,7:9,15)], selected = c('pib', 'pop', 'vab', 'icms', 'ipi', 'ipva', 'salario_medio', 'pop_ocu_per')) 33 | ``` 34 | 35 | Row 36 | ------------------------------------- 37 | 38 | ### Distribuição dos indicadores 39 | 40 | ```{r hist, echo=FALSE, warning=FALSE, message=FALSE} 41 | renderPlot({ 42 | 43 | if(input$radioA1 == "PERNAMBUCO") { 44 | 45 | m <- mun_pe %>% select(input$radioA2) 46 | 47 | plot_num(m) 48 | 49 | } 50 | 51 | else { 52 | 53 | m <- mun_pe %>% filter(rd == input$radioA1) %>% select(input$radioA2) ## dinâmica 54 | 55 | plot_num(m) 56 | 57 | } 58 | 59 | }) 60 | ``` 61 | 62 | ### Relacionamento entre os indicadores 63 | 64 | ```{r cor, echo=FALSE, warning=FALSE, message=FALSE} 65 | renderPlot({ 66 | 67 | if(input$radioA1 == "PERNAMBUCO") { 68 | 69 | m <- mun_pe %>% select(input$radioA2) 70 | 71 | corrplot(cor(m)) 72 | 73 | } 74 | 75 | else { 76 | 77 | m <- mun_pe %>% filter(rd == input$radioA1) %>% select(input$radioA2) ## dinâmica 78 | 79 | corrplot(cor(m)) 80 | 81 | } 82 | 83 | }) 84 | ``` 85 | 86 | Agrupamento {data-icon="fa-object-group" data-orientation=rows} 87 | ===================================== 88 | 89 | Inputs {.sidebar} 90 | ----------------------------------------------------------------------- 91 | 92 | ```{r controle2, echo=FALSE, warning=FALSE, message=FALSE} 93 | 94 | radioButtons(inputId = 'radioB1', 'Selecione a RD', c('METROPOLITANA', unique(levels(mun_pe$rd))), inline = F) 95 | 96 | radioButtons(inputId = 'radioB2', 'Escolha o Total de Grupos', 1:6, inline = T, selected = 2) 97 | 98 | radioButtons(inputId = 'radioX1', 'Selecione os Indicadores', names(mun_pe)[-c(1:3,7:9,15)], inline = F, selected = "pib") 99 | 100 | radioButtons(inputId = 'radioY1', 'Selecione os Indicadores', names(mun_pe)[-c(1:3,7:9,15)], inline = F) 101 | ``` 102 | 103 | Row 104 | ------------------------------------- 105 | 106 | ### Agrupamento 107 | 108 | ```{r cluster, echo=FALSE, warning=FALSE, message=FALSE} 109 | renderPlotly({ 110 | 111 | if(input$radioB1 == "PERNAMBUCO") { 112 | 113 | cls <- kmeans(x = mun_pe [, c(4:6, 10:14)], centers = 12) 114 | 115 | mun_pe$cluster <- as.factor(cls$cluster) 116 | 117 | x_axis <- input$radioX1 118 | y_axis <- input$radioY1 119 | 120 | ggplot(mun_pe, aes_string(x = x_axis, y = y_axis, color = "cluster")) + 121 | geom_point(size = 4, 122 | stroke = 3) + 123 | theme_light() 124 | 125 | } 126 | 127 | else { 128 | 129 | m <- mun_pe %>% filter(rd == input$radioB1) ## dinâmica 130 | 131 | cls <- kmeans(x = m [, c(4:6, 10:14)], centers = input$radioB2) ## dinâmica 132 | 133 | m$cluster <- as.factor(cls$cluster) 134 | 135 | x_axis <- input$radioX1 136 | y_axis <- input$radioY1 137 | 138 | ggplot(m, aes_string(x = x_axis, y = y_axis, color = 'cluster')) + 139 | geom_point(size = 4, 140 | stroke = 3) + 141 | theme_light() 142 | 143 | } 144 | 145 | }) 146 | ``` 147 | 148 | Predição {data-icon="fa-diagnoses" data-orientation=rows} 149 | ===================================== 150 | 151 | Controles {.sidebar} 152 | ------------------------------------- 153 | 154 | ```{r controle3, echo=FALSE, warning=FALSE, message=FALSE} 155 | numericInput('numC1', 'PIB', min(mun_pe$pib), step = 100000) 156 | 157 | numericInput('numC2', 'Salário Médio', min(mun_pe$salario_medio), step = 0.1) 158 | ``` 159 | 160 | What-if? 161 | 162 | O que acontece com a popução ocupada se o pib ou salário médio de um município forem modificados? 163 | 164 | Row 165 | ------------------------------------- 166 | 167 | ### Impacto dos Indicadores 168 | 169 | ```{r pred1, echo=FALSE, warning=FALSE, message=FALSE} 170 | train.control <- trainControl(method = "cv", number = 10) 171 | 172 | mun_LM <- train(pop_ocu_per ~ pib + salario_medio, data = mun_pe, method = "lm", trControl = train.control) 173 | 174 | summary(mun_LM) 175 | ``` 176 | 177 | ### Predição da População Ocupada 178 | 179 | ```{r pred2, echo=FALSE, warning=FALSE, message=FALSE} 180 | 181 | renderPrint({ 182 | 183 | predict(mun_LM, data.frame(pib = input$numC1, salario_medio = input$numC2)) 184 | 185 | }) 186 | ``` 187 | 188 | Metadados {data-icon="fa-info" data-orientation=rows} 189 | ===================================== 190 | 191 | Row 192 | ------------------------------------- 193 | 194 | ### Qualidade dos dados 195 | 196 | ```{r quali, echo=FALSE, warning=FALSE, message=FALSE} 197 | 198 | # knitr::kable(status(mun_pe)) 199 | 200 | ``` 201 | 202 | Veja abaixo a tabela com as informações detalhadas dos indicadores
`r knitr::kable(mun_pe_meta) # inline` -------------------------------------------------------------------------------- /scripts/analise/regressao_avancado.R: -------------------------------------------------------------------------------- 1 | ##### PREPARAÇÃO ##### 2 | ### CARREGANDO PACOTES ### 3 | pacman::p_load(ade4, car, caret, corrplot, dplyr, EnvStats, gvlma, jtools, lm.beta, lmtest, MASS, Metrics, performance, sandwich, simpleboot, SmartEDA, sjPlot, stargazer) 4 | 5 | ### ETL ### 6 | # leitura da base de dados 7 | idepeOriginal <- read.csv2('https://raw.githubusercontent.com/hugoavmedeiros/ciencia_politica_com_r/master/bases_tratadas/idepe_escolas_2019.csv', stringsAsFactors = T, encoding = 'UTF-8') # carregando a base já tratada para o ambiente do R 8 | 9 | # explorar dados 10 | ExpData(data=idepeOriginal, type=2) 11 | # remover casos ausentes 12 | idepeOriginal <- idepeOriginal[complete.cases(idepeOriginal), ] 13 | 14 | # criar dummies 15 | idepeTratada <- idepeOriginal %>% filter(tp_escola != 'TECNICA') 16 | idepeTratada <- droplevels(idepeTratada) 17 | idepeTratada <- fastDummies::dummy_cols(idepeTratada) 18 | idepeTratada <- idepeTratada %>% dplyr::select(-c(tp_escola, tp_localizacao, p_em, nota_lp, nota_mt, idepe)) 19 | colnames(idepeTratada)[13:17] <- c('Integral', 'Regular', "SemiIntegral", 'Rural', "Urbana") 20 | 21 | ##### MODELAGEM ##### 22 | ### criação dos três modelo iniciais, usando step ### 23 | regIdepeBack <- step(lm(nota_saep ~ . -cod_escola, data = idepeTratada), direction = "backward") 24 | regIdepeForw <- step(lm(nota_saep ~ . -cod_escola, data = idepeTratada), direction = "forward") 25 | regIdepeBoth <- step(lm(nota_saep ~ . -cod_escola, data = idepeTratada), direction = "both") 26 | 27 | ### comparação dos modelos ### 28 | # Sumários 29 | stargazer(regIdepeBack, regIdepeForw, regIdepeBoth, type="text", object.names = TRUE, title="Modelos IDEPE", single.row=TRUE) 30 | plot_summs(regIdepeBack, regIdepeForw, regIdepeBoth, model.names = c("Backward", "Forward", "Both")) 31 | # Performance 32 | test_performance(regIdepeBack, regIdepeForw, regIdepeBoth) 33 | compare_performance(regIdepeBack, regIdepeForw, regIdepeBoth, rank = TRUE, verbose = FALSE) 34 | plot(compare_performance(regIdepeBack, regIdepeForw, regIdepeBoth, rank = TRUE, verbose = FALSE)) 35 | 36 | ### Diagnóstico ### 37 | # checagem geral # 38 | check_model(regIdepeBoth) 39 | # testes unitários # 40 | shapiro.test(residuals(regIdepeBoth)) 41 | check_heteroscedasticity(regIdepeBoth) 42 | check_collinearity(regIdepeBoth) 43 | # outliers # 44 | check_outliers(regIdepeBoth) 45 | influencePlot(regIdepeBoth, id.method="identify", main="Observações Influentes", sub="Círculo proporcional à distância de Cook") 46 | residualPlots(regIdepeBoth) 47 | 48 | ### Remodelagem 1 ### 49 | idepeTratada$qt_mat_bas_r <- sqrt(idepeTratada$qt_mat_bas) 50 | idepeTratada <- idepeTratada %>% dplyr::select(-c(qt_mat_bas, tdi_em)) 51 | 52 | regIdepeBoth2 <- step(lm(nota_saep ~ . -cod_escola, data = idepeTratada), direction = "both") 53 | summary(regIdepeBoth2) 54 | 55 | par(ask = FALSE) 56 | check_model(regIdepeBoth2) 57 | residualPlots(regIdepeBoth2) 58 | 59 | ###### Correções ##### 60 | ### Multicolinearidade ### 61 | # Seleção de variáveis por importância 62 | par(mfrow = c(1, 1)) 63 | corrplot(cor(idepeTratada)) 64 | varImp(regIdepeBoth2) 65 | 66 | ### Remodelagem 2 ### 67 | regIdepeBoth3 <- step(lm(nota_saep ~ tx_mat_med_int + tx_mat_bas_fem + tx_mat_bas_branca + Integral + Rural + qt_mat_bas_r, data = idepeTratada), direction = "both") 68 | summary(regIdepeBoth3) 69 | 70 | par(ask = FALSE) 71 | check_model(regIdepeBoth3) 72 | residualPlots(regIdepeBoth3) 73 | 74 | ### Ausência de normalidade nos resíduos ###### 75 | # Remoção de outliers # 76 | cooksdIdepe <- cooks.distance(regIdepeBoth3) 77 | obsInfluentes <- cooksdIdepe[cooksdIdepe > 4*mean(cooksdIdepe, na.rm=T)] 78 | 79 | idepeTratada %>% slice(c(as.integer(names(obsInfluentes)))) 80 | 81 | idepeTratada2 <- idepeTratada %>% slice(-c(as.integer(names(obsInfluentes)))) 82 | 83 | regIdepeBoth4 <- step(lm(nota_saep ~ tx_mat_med_int + tx_mat_bas_fem + tx_mat_bas_branca + Integral + Rural + qt_mat_bas_r, data = idepeTratada2), direction = "both") 84 | summary(regIdepeBoth4) 85 | check_model(regIdepeBoth4) 86 | 87 | # Transformação Box-Cox# 88 | idepeBoxCox <- EnvStats::boxcox(regIdepeBoth3, optimize = T) 89 | 90 | par(mfrow=c(1,2), ask = FALSE) 91 | qqnorm(resid(regIdepeBoth3)) 92 | qqline(resid(regIdepeBoth3)) 93 | plot(idepeBoxCox, plot.type = "Q-Q Plots", main = 'Normal Q-Q Plot') 94 | par(mfrow=c(1,1), ask = FALSE) 95 | 96 | lambda <- idepeBoxCox$lambda 97 | lambda 98 | 99 | regIdepeBoxCox <- step(lm((nota_saep^lambda-1)/lambda ~ tx_mat_med_int + tx_mat_bas_fem + tx_mat_bas_branca + Integral + Rural + qt_mat_bas_r, data = idepeTratada2), direction = "both") 100 | 101 | regIdepeBoxCox2 <- step(lm((nota_saep^lambda)~ tx_mat_med_int + tx_mat_bas_fem + tx_mat_bas_branca + Integral + Rural + qt_mat_bas_r, data = idepeTratada2), direction = "both") 102 | 103 | summary(regIdepeBoxCox) 104 | check_model(regIdepeBoxCox) 105 | 106 | par(mfrow=c(2,2), ask = FALSE) 107 | plot(regIdepeBoth3, which=2, col=c("red"), main = 'Regressão original') 108 | plot(regIdepeBoxCox, which=2, col=c("red"), main = 'Regressão Box Cox 1') 109 | plot(regIdepeBoxCox2, which=2, col=c("red"), main = 'Regressão Box Cox 2') 110 | plot(idepeBoxCox, plot.type = "Q-Q Plots", main = 'Box Cox EnvStats') 111 | par(mfrow=c(1,1), ask = FALSE) 112 | 113 | # Bootstraping # 114 | regIdepeBoot <- Boot(regIdepeBoth3, R=199) 115 | summary(regIdepeBoot, high.moments=TRUE) 116 | 117 | ############## EXTRAS ##################### 118 | # predição 119 | rmse(idepeTratada$nota_saep, predict(regIdepeBoth)) 120 | predicaoIdepe <- data.frame(predicao = predict(regIdepeBoth), reais = idepeTratada$idepe) 121 | ggplot(predicaoIdepe, aes(x = predicao, y = reais)) + geom_point() + geom_abline(intercept = 0, slope = 1, color = "red", size = 2) 122 | 123 | ### Heterocedasticidade ### 124 | # Estimativas robustas 125 | regIdepeBoth2$robse <- vcovHC(regIdepeBoth3, type = "HC1") 126 | coeftest(regIdepeBoth3, regIdepeBoth3$robse) -------------------------------------------------------------------------------- /bases_tratadas/breast_cancer.csv: -------------------------------------------------------------------------------- 1 | idade;tumor_tamanho;breast 2 | 20-29;35a39;right 3 | 30-39;10a14;right 4 | 30-39;10a14;left 5 | 30-39;5a9;left 6 | 30-39;0a4;right 7 | 30-39;0a4;right 8 | 30-39;15a19;left 9 | 30-39;15a19;right 10 | 30-39;15a19;left 11 | 30-39;15a19;right 12 | 30-39;15a19;left 13 | 30-39;20a24;left 14 | 30-39;20a24;right 15 | 30-39;20a24;left 16 | 30-39;20a24;right 17 | 30-39;20a24;left 18 | 30-39;20a24;left 19 | 30-39;25a29;right 20 | 30-39;25a29;left 21 | 30-39;25a29;left 22 | 30-39;25a29;right 23 | 30-39;25a29;left 24 | 30-39;25a29;left 25 | 30-39;30a34;left 26 | 30-39;30a34;left 27 | 30-39;30a34;right 28 | 30-39;30a34;right 29 | 30-39;30a34;right 30 | 30-39;30a34;right 31 | 30-39;30a34;left 32 | 30-39;35a39;left 33 | 30-39;35a39;left 34 | 30-39;35a39;left 35 | 30-39;40a44;right 36 | 30-39;40a44;right 37 | 30-39;40a44;left 38 | 30-39;40a44;left 39 | 40-49;10a14;left 40 | 40-49;10a14;left 41 | 40-49;10a14;right 42 | 40-49;10a14;right 43 | 40-49;10a14;right 44 | 40-49;10a14;right 45 | 40-49;10a14;right 46 | 40-49;10a14;left 47 | 40-49;5a9;left 48 | 40-49;0a4;right 49 | 40-49;0a4;left 50 | 40-49;15a19;left 51 | 40-49;15a19;right 52 | 40-49;15a19;left 53 | 40-49;15a19;left 54 | 40-49;15a19;right 55 | 40-49;20a24;right 56 | 40-49;20a24;left 57 | 40-49;20a24;right 58 | 40-49;20a24;right 59 | 40-49;20a24;right 60 | 40-49;20a24;left 61 | 40-49;20a24;left 62 | 40-49;20a24;left 63 | 40-49;20a24;left 64 | 40-49;20a24;left 65 | 40-49;20a24;right 66 | 40-49;20a24;left 67 | 40-49;20a24;right 68 | 40-49;20a24;right 69 | 40-49;20a24;right 70 | 40-49;20a24;right 71 | 40-49;20a24;left 72 | 40-49;20a24;right 73 | 40-49;20a24;right 74 | 40-49;20a24;right 75 | 40-49;20a24;left 76 | 40-49;25a29;left 77 | 40-49;25a29;right 78 | 40-49;25a29;left 79 | 40-49;25a29;right 80 | 40-49;25a29;right 81 | 40-49;25a29;right 82 | 40-49;25a29;left 83 | 40-49;25a29;right 84 | 40-49;25a29;left 85 | 40-49;25a29;right 86 | 40-49;25a29;left 87 | 40-49;25a29;left 88 | 40-49;25a29;right 89 | 40-49;25a29;right 90 | 40-49;25a29;left 91 | 40-49;25a29;left 92 | 40-49;25a29;left 93 | 40-49;25a29;right 94 | 40-49;30a34;left 95 | 40-49;30a34;left 96 | 40-49;30a34;right 97 | 40-49;30a34;left 98 | 40-49;30a34;right 99 | 40-49;30a34;right 100 | 40-49;30a34;left 101 | 40-49;30a34;left 102 | 40-49;30a34;right 103 | 40-49;30a34;left 104 | 40-49;30a34;right 105 | 40-49;30a34;right 106 | 40-49;30a34;left 107 | 40-49;30a34;right 108 | 40-49;30a34;left 109 | 40-49;30a34;right 110 | 40-49;30a34;right 111 | 40-49;30a34;left 112 | 40-49;30a34;left 113 | 40-49;30a34;left 114 | 40-49;35a39;right 115 | 40-49;35a39;right 116 | 40-49;35a39;right 117 | 40-49;35a39;left 118 | 40-49;35a39;right 119 | 40-49;35a39;right 120 | 40-49;35a39;right 121 | 40-49;40a44;right 122 | 40-49;40a44;right 123 | 40-49;40a44;right 124 | 40-49;40a44;right 125 | 40-49;40a44;left 126 | 40-49;45a49;left 127 | 40-49;50a54;left 128 | 40-49;50a54;right 129 | 50-59;10a14;left 130 | 50-59;10a14;right 131 | 50-59;10a14;left 132 | 50-59;10a14;left 133 | 50-59;10a14;left 134 | 50-59;10a14;right 135 | 50-59;10a14;left 136 | 50-59;10a14;right 137 | 50-59;10a14;right 138 | 50-59;5a9;right 139 | 50-59;0a4;left 140 | 50-59;0a4;right 141 | 50-59;0a4;left 142 | 50-59;15a19;right 143 | 50-59;15a19;right 144 | 50-59;15a19;left 145 | 50-59;15a19;left 146 | 50-59;15a19;right 147 | 50-59;15a19;right 148 | 50-59;15a19;right 149 | 50-59;15a19;right 150 | 50-59;15a19;left 151 | 50-59;15a19;left 152 | 50-59;20a24;left 153 | 50-59;20a24;right 154 | 50-59;20a24;left 155 | 50-59;20a24;right 156 | 50-59;20a24;left 157 | 50-59;20a24;right 158 | 50-59;20a24;left 159 | 50-59;20a24;right 160 | 50-59;20a24;right 161 | 50-59;20a24;right 162 | 50-59;20a24;left 163 | 50-59;20a24;right 164 | 50-59;20a24;left 165 | 50-59;20a24;left 166 | 50-59;25a29;left 167 | 50-59;25a29;left 168 | 50-59;25a29;left 169 | 50-59;25a29;right 170 | 50-59;25a29;left 171 | 50-59;25a29;right 172 | 50-59;25a29;right 173 | 50-59;25a29;left 174 | 50-59;25a29;left 175 | 50-59;25a29;right 176 | 50-59;25a29;right 177 | 50-59;25a29;left 178 | 50-59;25a29;right 179 | 50-59;25a29;left 180 | 50-59;25a29;left 181 | 50-59;25a29;left 182 | 50-59;25a29;left 183 | 50-59;25a29;right 184 | 50-59;25a29;left 185 | 50-59;25a29;left 186 | 50-59;25a29;right 187 | 50-59;30a34;left 188 | 50-59;30a34;right 189 | 50-59;30a34;left 190 | 50-59;30a34;right 191 | 50-59;30a34;right 192 | 50-59;30a34;left 193 | 50-59;30a34;right 194 | 50-59;30a34;left 195 | 50-59;30a34;right 196 | 50-59;30a34;left 197 | 50-59;30a34;left 198 | 50-59;30a34;left 199 | 50-59;30a34;left 200 | 50-59;30a34;left 201 | 50-59;30a34;right 202 | 50-59;30a34;left 203 | 50-59;30a34;left 204 | 50-59;30a34;right 205 | 50-59;30a34;left 206 | 50-59;30a34;left 207 | 50-59;35a39;right 208 | 50-59;35a39;left 209 | 50-59;35a39;left 210 | 50-59;35a39;left 211 | 50-59;35a39;left 212 | 50-59;35a39;left 213 | 50-59;35a39;right 214 | 50-59;40a44;left 215 | 50-59;40a44;left 216 | 50-59;40a44;right 217 | 50-59;40a44;left 218 | 50-59;40a44;left 219 | 50-59;40a44;left 220 | 50-59;40a44;left 221 | 50-59;40a44;left 222 | 50-59;50a54;right 223 | 50-59;50a54;right 224 | 50-59;50a54;right 225 | 60-69;10a14;left 226 | 60-69;10a14;left 227 | 60-69;10a14;left 228 | 60-69;10a14;right 229 | 60-69;10a14;left 230 | 60-69;10a14;right 231 | 60-69;10a14;left 232 | 60-69;10a14;left 233 | 60-69;5a9;left 234 | 60-69;15a19;right 235 | 60-69;15a19;left 236 | 60-69;15a19;left 237 | 60-69;15a19;right 238 | 60-69;15a19;right 239 | 60-69;15a19;right 240 | 60-69;15a19;left 241 | 60-69;15a19;right 242 | 60-69;15a19;left 243 | 60-69;20a24;left 244 | 60-69;20a24;left 245 | 60-69;20a24;right 246 | 60-69;20a24;left 247 | 60-69;20a24;right 248 | 60-69;20a24;left 249 | 60-69;20a24;left 250 | 60-69;20a24;right 251 | 60-69;25a29;right 252 | 60-69;25a29;left 253 | 60-69;25a29;right 254 | 60-69;25a29;right 255 | 60-69;25a29;right 256 | 60-69;25a29;right 257 | 60-69;25a29;left 258 | 60-69;25a29;right 259 | 60-69;25a29;left 260 | 60-69;30a34;left 261 | 60-69;30a34;left 262 | 60-69;30a34;left 263 | 60-69;30a34;left 264 | 60-69;30a34;left 265 | 60-69;30a34;right 266 | 60-69;30a34;left 267 | 60-69;30a34;left 268 | 60-69;30a34;right 269 | 60-69;30a34;right 270 | 60-69;30a34;right 271 | 60-69;30a34;right 272 | 60-69;30a34;left 273 | 60-69;35a39;left 274 | 60-69;40a44;right 275 | 60-69;40a44;right 276 | 60-69;40a44;right 277 | 60-69;45a49;left 278 | 60-69;45a49;right 279 | 60-69;50a54;left 280 | 60-69;50a54;right 281 | 60-69;50a54;right 282 | 70-79;10a14;left 283 | 70-79;0a4;left 284 | 70-79;15a19;left 285 | 70-79;20a24;left 286 | 70-79;40a44;right 287 | 70-79;40a44;right 288 | --------------------------------------------------------------------------------