Impacto de Políticas de Tecnologia em Sala de Aula sobre a Resiliência Acadêmica: Análise dos Dados PISA 2022 - América Latina com Análises por País
Análise Técnica - PISA 2022
2025-08-22
1 Resumo Executivo
Este relatório analisa o impacto de políticas de uso de tecnologia em sala de aula sobre a resiliência acadêmica de estudantes da América Latina, utilizando dados do PISA 2022. A resiliência acadêmica é definida como o desempenho no quarto quartil superior em três domínios: matemática, leitura e ciências. Através de modelos de regressão logística, investigamos como seis políticas específicas de tecnologia educacional influenciam a probabilidade de um estudante ser academicamente resiliente, com análises detalhadas por país para identificar padrões específicos e diferenças contextuais.
Principais Achados: - Variações significativas na resiliência acadêmica entre países da América Latina - Diferentes padrões de implementação de políticas tecnológicas por país - Efeitos heterogêneos das políticas de tecnologia dependendo do contexto nacional - Necessidade de abordagens adaptadas ao contexto específico de cada país
2 Introdução e Objetivos
2.1 Contexto
A integração de tecnologias digitais no ambiente educacional tem sido um tema central nas políticas educacionais contemporâneas. Com a crescente presença de dispositivos móveis e acesso à internet nas escolas, surge a necessidade de compreender como diferentes políticas de regulamentação tecnológica impactam o desempenho acadêmico dos estudantes, considerando as especificidades contextuais de cada país.
2.2 Objetivos
Objetivo Principal: Analisar o impacto de políticas de tecnologia em sala de aula sobre a resiliência acadêmica em matemática, leitura e ciências, com foco nas diferenças entre países.
Objetivos Específicos:
- Caracterizar a distribuição de resiliência acadêmica nos países da América Latina
- Examinar as correlações entre diferentes políticas tecnológicas por país
- Desenvolver modelos preditivos para cada domínio de resiliência considerando diferenças por país
- Identificar políticas mais efetivas para promover resiliência acadêmica em diferentes contextos nacionais
- Comparar padrões de implementação de políticas tecnológicas entre países
- Fornecer recomendações específicas por país
3 Metodologia
3.1 Fonte de Dados
Os dados utilizados provêm do Programme for International Student Assessment (PISA) 2022, focando nos países da América Latina. O PISA é uma avaliação internacional que mede o desempenho de estudantes de 15 anos em matemática, leitura e ciências.
3.2 Variáveis do Estudo
3.2.1 Variáveis Dependentes (Resiliência Acadêmica)
- resil_math: Resiliência em matemática (quarto quartil superior)
- resil_read: Resiliência em leitura (quarto quartil
superior)
- resil_scie: Resiliência em ciências (quarto quartil superior)
3.2.2 Variáveis Independentes (Políticas de Tecnologia)
Todas as variáveis seguem escala Likert: 1=Discordo totalmente, 2=Discordo, 3=Concordo, 4=Concordo totalmente
- IC179Q01JA: Proibir uso de celular em sala de aula
- IC179Q02JA: Proibir uso de notebook/tablet próprio em sala
- IC179Q03JA: Alunos colaboram com professores para definir regras de tecnologia
- IC179Q04JA: Implementar filtros contra redes sociais
- IC179Q05JA: Implementar filtros contra jogos online
- IC179Q06JA: Professores monitoram atividades dos alunos no laptop
3.2.3 Variável de Estratificação
- CNT: País (variável categórica para análises estratificadas)
4 Carregamento e Preparação dos Dados
# Carregamento de bibliotecas necessárias
library(haven) # Para ler arquivos SPSS
library(dplyr) # Manipulação de dados
library(ggplot2) # Visualizações
library(corrplot) # Matriz de correlação
library(plotly) # Gráficos interativos
library(knitr) # Tabelas
library(kableExtra) # Formatação de tabelas
library(broom) # Resultados de modelos
library(pROC) # Curvas ROC
library(VIM) # Visualização de dados faltantes
library(RColorBrewer) # Paletas de cores
library(gridExtra) # Arranjo de gráficos
library(car) # Testes estatísticos
library(tidyr) # Manipulação de dados
library(reshape2) # Reestruturação de dados
library(viridis) # Paletas de cores
library(pheatmap) # Heatmaps avançados
library(countrycode) # Códigos de países# Funções auxiliares para tratamento robusto de modelos de regressão logística
# Função robusta para calcular intervalos de confiança
calculate_robust_confint <- function(model, method = "profile") {
tryCatch({
# Tentar método de perfil primeiro
if(method == "profile") {
ci <- confint(model)
return(ci)
} else {
# Método Wald como alternativa
ci <- confint.default(model)
return(ci)
}
}, error = function(e) {
cat("AVISO: Erro no cálculo de intervalos de confiança:", e$message, "\n")
cat("Tentando método alternativo...\n")
# Fallback para método Wald
tryCatch({
ci <- confint.default(model)
cat("Intervalos de confiança calculados usando método Wald.\n")
return(ci)
}, error = function(e2) {
cat("ERRO: Também falhou com método Wald:", e2$message, "\n")
cat("Calculando intervalos manualmente usando erros padrão...\n")
# Cálculo manual usando erros padrão
coefs <- coef(model)
se <- sqrt(diag(vcov(model)))
# Intervalo de confiança de 95% (1.96 * SE)
ci_lower <- coefs - 1.96 * se
ci_upper <- coefs + 1.96 * se
ci <- cbind(ci_lower, ci_upper)
colnames(ci) <- c("2.5 %", "97.5 %")
cat("Intervalos calculados manualmente usando erros padrão.\n")
return(ci)
})
})
}
# Verificar convergência do modelo
check_model_convergence <- function(model) {
if(model$converged) {
cat("Modelo convergiu com sucesso.\n")
return(TRUE)
} else {
cat("AVISO: Modelo não convergiu adequadamente.\n")
return(FALSE)
}
}
# Função para calcular odds ratios de forma robusta
calculate_robust_or <- function(model, model_name = "modelo") {
cat("Verificando convergência do", model_name, "...\n")
converged <- check_model_convergence(model)
# Calcular intervalos de confiança com tratamento robusto
cat("Calculando intervalos de confiança para", model_name, "...\n")
ci <- calculate_robust_confint(model, method = "profile")
# Verificar se há problemas nos coeficientes
coef_model <- coef(model)
if(any(is.na(coef_model)) || any(is.infinite(coef_model))) {
cat("AVISO: Coeficientes problemáticos detectados no", model_name, ".\n")
# Substituir valores problemáticos
coef_model[is.na(coef_model) | is.infinite(coef_model)] <- 0
}
# Verificar se há problemas nos intervalos de confiança
if(any(is.na(ci)) || any(is.infinite(ci))) {
cat("AVISO: Intervalos de confiança problemáticos detectados.\n")
# Aplicar correções
ci[is.na(ci) | is.infinite(ci)] <- 0
}
# Combinar coeficientes e intervalos
or_result <- exp(cbind(coef_model, ci))
colnames(or_result) <- c("Odds Ratio", "IC 2.5%", "IC 97.5%")
return(or_result)
}
cat("Funções auxiliares carregadas com sucesso.\n")## Funções auxiliares carregadas com sucesso.# Função auxiliar robusta para kable com verificação de compatibilidade
safe_kable <- function(data, col_names = NULL, caption = "", align = "c", digits = NULL, ...) {
cat("Executando safe_kable...\n")
cat("Dimensões dos dados:", dim(data), "\n")
cat("Nomes das colunas:", paste(colnames(data), collapse = ", "), "\n")
# Se col_names foi especificado, verificar compatibilidade
if(!is.null(col_names)) {
cat("Col.names especificados:", length(col_names), "\n")
if(ncol(data) == length(col_names)) {
cat("Estrutura compatível. Usando col.names especificados.\n")
if(is.null(digits)) {
return(kable(data, col.names = col_names, caption = caption, align = align, ...))
} else {
return(kable(data, col.names = col_names, caption = caption, align = align, digits = digits, ...))
}
} else {
cat("AVISO: Incompatibilidade detectada!\n")
cat("Colunas nos dados:", ncol(data), "\n")
cat("Col.names especificados:", length(col_names), "\n")
cat("Usando nomes de colunas automáticos...\n")
# Fallback para nomes automáticos
caption_auto <- paste(caption, "(nomes automáticos)")
if(is.null(digits)) {
return(kable(data, caption = caption_auto, align = align, ...))
} else {
return(kable(data, caption = caption_auto, align = align, digits = digits, ...))
}
}
} else {
# Se col_names não foi especificado, usar kable normal
cat("Usando kable com nomes automáticos.\n")
if(is.null(digits)) {
return(kable(data, caption = caption, align = align, ...))
} else {
return(kable(data, caption = caption, align = align, digits = digits, ...))
}
}
}
cat("Função safe_kable carregada com sucesso.\n")## Função safe_kable carregada com sucesso.# Função auxiliar para add_header_above com verificação automática
safe_add_header_above <- function(kable_obj, header_spec, table_data = NULL) {
cat("Executando safe_add_header_above...\n")
# Calcular número total de colunas esperado pelo header_spec
expected_cols <- sum(header_spec)
cat("Colunas esperadas pelo header_spec:", expected_cols, "\n")
# Se table_data foi fornecido, verificar compatibilidade
if(!is.null(table_data)) {
actual_cols <- ncol(table_data)
cat("Colunas reais na tabela:", actual_cols, "\n")
if(actual_cols != expected_cols) {
cat("AVISO: Incompatibilidade detectada!\n")
cat("Ajustando header_spec automaticamente...\n")
# Estratégia de ajuste: distribuir as colunas proporcionalmente
if(actual_cols < expected_cols) {
# Reduzir proporcionalmente
ratio <- actual_cols / expected_cols
adjusted_header <- round(header_spec * ratio)
# Garantir que a soma seja exata
diff <- actual_cols - sum(adjusted_header)
if(diff != 0) {
# Ajustar o último elemento
adjusted_header[length(adjusted_header)] <- adjusted_header[length(adjusted_header)] + diff
}
cat("Header ajustado:", paste(names(header_spec), "=", adjusted_header, collapse = ", "), "\n")
header_spec <- adjusted_header
names(header_spec) <- names(header_spec)
} else if(actual_cols > expected_cols) {
# Aumentar o último elemento para acomodar colunas extras
header_spec[length(header_spec)] <- header_spec[length(header_spec)] + (actual_cols - expected_cols)
cat("Header ajustado:", paste(names(header_spec), "=", header_spec, collapse = ", "), "\n")
}
}
}
# Tentar aplicar add_header_above
tryCatch({
result <- kable_obj %>% add_header_above(header_spec)
cat("add_header_above aplicado com sucesso.\n")
return(result)
}, error = function(e) {
cat("ERRO no add_header_above:", e$message, "\n")
cat("Retornando tabela sem cabeçalho adicional.\n")
return(kable_obj)
})
}
cat("Função safe_add_header_above carregada com sucesso.\n")## Função safe_add_header_above carregada com sucesso.# Tentativa de carregamento dos dados reais
data_path <- "../2-base-de-analise/PISA2022_LATAM_resiliencia.sav"
if (!file.exists(data_path)) {
stop("Arquivo de dados não encontrado. Verifique o caminho: ", data_path)
}
# Carregamento dos dados reais
pisa_data <- read_sav(data_path)
cat("Dados PISA 2022 carregados com sucesso!\n")## Dados PISA 2022 carregados com sucesso!## Dimensões: 19143 261## tibble [19,143 × 261] (S3: tbl_df/tbl/data.frame)
## $ CNT : chr+lbl [1:19143] ARG, ARG, ARG, ARG, ARG, ARG, ARG, ARG, ARG, ARG, AR...
## ..@ label : chr "Country code 3-character"
## ..@ format.spss : chr "A3"
## ..@ display_width: int 3
## ..@ labels : Named chr [1:81] "MDA" "THA" "BRA" "FRA" ...
## .. ..- attr(*, "names")= chr [1:81] "Republic of Moldova" "Thailand" "Brazil" "France" ...
## $ CNTRYID : dbl+lbl [1:19143] 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, ...
## ..@ label : chr "Country Identifier"
## ..@ format.spss: chr "F3.0"
## ..@ labels : Named num [1:81] 8 31 32 36 40 56 76 96 100 116 ...
## .. ..- attr(*, "names")= chr [1:81] "Albania" "Baku (Azerbaijan)" "Argentina" "Australia" ...
## $ CNTSTUID : num [1:19143] 3200005 3200009 3200010 3200015 3200016 ...
## ..- attr(*, "label")= chr "Intl. Student ID"
## ..- attr(*, "format.spss")= chr "F8.0"
## $ CNTSCHID : num [1:19143] 3200458 3200223 3200033 3200095 3200023 ...
## ..- attr(*, "label")= chr "Intl. School ID"
## ..- attr(*, "format.spss")= chr "F8.0"
## $ SUBNATIO : chr+lbl [1:19143] 0320000, 0320000, 0320000, 0320100, 0320000, 0320100...
## ..@ label : chr "Adjudicated sub-region code 7-digit code (3-digit country code + region ID + stratum ID)"
## ..@ format.spss : chr "A7"
## ..@ display_width: int 7
## ..@ labels : Named chr [1:92] "1000000" "3000000" "4000000" "6000000" ...
## .. ..- attr(*, "names")= chr [1:92] "Bulgaria" "Greece" "Jordan" "Paraguay" ...
## $ REGION : dbl+lbl [1:19143] 3200, 3200, 3200, 3200, 3200, 3200, 3200, 3200, 3200...
## ..@ label : chr "REGION"
## ..@ format.spss: chr "F5.0"
## ..@ labels : Named num [1:145] 800 3100 3200 3600 4000 ...
## .. ..- attr(*, "names")= chr [1:145] "Albania" "Baku (Azerbaijan)" "Argentina" "Australia" ...
## $ ST004D01T : dbl+lbl [1:19143] 1, 1, 1, 1, 1, 1, 1, 2, 2, 1, 1, 2, 1, 2, 2, 2, 2, 2...
## ..@ label : chr "Student (Standardized) Gender"
## ..@ format.spss: chr "F1.0"
## ..@ labels : Named num [1:6] 1 2 5 7 8 9
## .. ..- attr(*, "names")= chr [1:6] "Female" "Male" "Valid Skip" "Not Applicable" ...
## $ IMMIG : dbl+lbl [1:19143] 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, ...
## ..@ label : chr "Index on immigrant background (OECD definition)"
## ..@ format.spss: chr "F1.0"
## ..@ labels : Named num [1:7] 1 2 3 5 7 8 9
## .. ..- attr(*, "names")= chr [1:7] "Native student" "Second-Generation student" "First-Generation student" "Valid Skip" ...
## $ LANGN : dbl+lbl [1:19143] 156, 156, 999, 156, 156, 892, 156, 156, 156, 156, 15...
## ..@ label : chr "Language spoken at home"
## ..@ format.spss: chr "F3.0"
## ..@ labels : Named num [1:264] 105 108 112 113 118 121 130 133 137 140 ...
## .. ..- attr(*, "names")= chr [1:264] "Kurdish" "Tagalog" "Waray" "Indonesian" ...
## $ REPEAT : dbl+lbl [1:19143] 0, 0, 0, 0, 0, NA, 0, 0, NA, 0, 1, 0, 0, ...
## ..@ label : chr "Grade repetition"
## ..@ format.spss: chr "F1.0"
## ..@ labels : Named num [1:6] 0 1 5 7 8 9
## .. ..- attr(*, "names")= chr [1:6] "Never repeated" "Repeated at lease once" "Valid Skip" "Not Applicable" ...
## $ STRATUM : chr+lbl [1:19143] ARG03, ARG17, ARG03, ARG01, ARG03, ARG01, ARG03, ARG...
## ..@ label : chr "Stratum ID 5-character (cnt + original stratum ID)"
## ..@ format.spss : chr "A5"
## ..@ display_width: int 5
## ..@ labels : Named chr [1:1317] "MDA10" "THA10" "BRA10" "FRA10" ...
## .. ..- attr(*, "names")= chr [1:1317] "MDA - stratum 10: Russian / Big city / ISCED2" "THA - stratum 10: DLCA/ISCED3 only" "BRA - stratum 10: Sul / Public State" "FRA - stratum 10: Guadeloupe Guyane Martinique / Lycée agricole / Large school" ...
## $ W_FSTUWT : num [1:19143] 101.3 98.1 133.4 14.6 89 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT WEIGHT"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT1 : num [1:19143] 50.7 154.6 71.4 22 127.3 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 1"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT2 : num [1:19143] 50.66 146.65 184.65 7.32 46.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 2"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT3 : num [1:19143] 151.99 49.26 184.66 7.32 133.44 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 3"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT4 : num [1:19143] 152 154.6 190.1 22 44.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 4"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT5 : num [1:19143] 50.7 155.9 67.6 22 133.4 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 5"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT6 : num [1:19143] 50.66 154.65 203.3 7.32 44.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 6"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT7 : num [1:19143] 151.99 146.6 67.65 7.32 133.44 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 7"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT8 : num [1:19143] 151.99 46.21 197.02 7.32 127.32 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 8"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT9 : num [1:19143] 151.99 48.87 67.78 7.32 127.32 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 9"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT10 : num [1:19143] 152 147.7 71.4 22 127.3 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 10"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT11 : num [1:19143] 50.66 46.57 73.51 7.32 44.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 11"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT12 : num [1:19143] 152 48.9 71.3 22 46.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 12"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT13 : num [1:19143] 50.66 155.76 197.04 7.32 133.44 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 13"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT14 : num [1:19143] 152 147.7 184.5 22 44.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 14"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT15 : num [1:19143] 50.7 46.2 65.7 22 46.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 15"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT16 : num [1:19143] 50.7 46.2 202.9 22 133.4 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 16"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT17 : num [1:19143] 50.7 46.5 190.3 22 127.3 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 17"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT18 : num [1:19143] 50.66 49.2 65.67 7.32 44.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 18"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT19 : num [1:19143] 151.99 147.69 73.64 7.32 46.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 19"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT20 : num [1:19143] 152 49.2 203.2 22 46.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 20"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT21 : num [1:19143] 151.99 154.61 190.03 7.32 127.32 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 21"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT22 : num [1:19143] 152 146.6 73.5 22 46.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 22"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT23 : num [1:19143] 50.7 49.3 73.5 22 133.4 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 23"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT24 : num [1:19143] 50.66 154.62 71.38 7.32 44.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 24"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT25 : num [1:19143] 151.99 155.87 197.12 7.32 133.44 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 25"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT26 : num [1:19143] 152 154.7 65.7 22 44.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 26"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT27 : num [1:19143] 50.7 146.6 197.1 22 133.4 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 27"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT28 : num [1:19143] 50.7 46.2 67.8 22 127.3 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 28"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT29 : num [1:19143] 50.7 48.9 197 22 127.3 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 29"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT30 : num [1:19143] 50.66 147.67 190.07 7.32 127.32 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 30"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT31 : num [1:19143] 152 46.6 184.6 22 44.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 31"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT32 : num [1:19143] 50.66 48.88 190.39 7.32 46.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 32"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT33 : num [1:19143] 152 155.8 67.8 22 133.4 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 33"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT34 : num [1:19143] 50.66 147.7 73.59 7.32 44.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 34"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT35 : num [1:19143] 151.99 46.23 202.88 7.32 46.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 35"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT36 : num [1:19143] 151.99 46.24 65.7 7.32 133.44 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 36"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT37 : num [1:19143] 151.99 46.53 71.34 7.32 127.32 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 37"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT38 : num [1:19143] 152 49.2 203.3 22 44.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 38"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT39 : num [1:19143] 50.7 147.7 184.5 22 46.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 39"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT40 : num [1:19143] 50.66 49.23 65.67 7.32 46.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 40"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT41 : num [1:19143] 152 46.6 190 22 46.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 41"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT42 : num [1:19143] 151.99 49.19 73.51 7.32 127.32 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 42"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT43 : num [1:19143] 50.66 146.58 73.5 7.32 44.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 43"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT44 : num [1:19143] 50.7 46.6 71.4 22 133.4 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 44"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT45 : num [1:19143] 152 46.2 197.1 22 44.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 45"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT46 : num [1:19143] 151.99 46.56 65.68 7.32 133.44 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 46"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT47 : num [1:19143] 50.66 49.23 197.15 7.32 44.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 47"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT48 : num [1:19143] 50.66 155.91 67.78 7.32 46.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 48"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT49 : num [1:19143] 50.66 147.69 197.02 7.32 46.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 49"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT50 : num [1:19143] 50.7 48.9 190.1 22 46.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 50"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT51 : num [1:19143] 151.99 154.64 184.65 7.32 133.44 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 51"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT52 : num [1:19143] 50.7 147.6 190.4 22 127.3 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 52"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT53 : num [1:19143] 151.99 46.23 67.77 7.32 44.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 53"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT54 : num [1:19143] 50.7 48.9 73.6 22 133.4 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 54"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT55 : num [1:19143] 152 156 203 22 127 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 55"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT56 : num [1:19143] 152 155.7 65.7 22 44.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 56"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT57 : num [1:19143] 152 154.7 71.3 22 46.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 57"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT58 : num [1:19143] 151.99 146.63 203.35 7.32 133.44 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 58"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT59 : num [1:19143] 50.66 48.87 184.55 7.32 127.32 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 59"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT60 : num [1:19143] 50.7 146.6 65.7 22 127.3 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 60"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT61 : num [1:19143] 50.66 46.61 71.38 7.32 46.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 61"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT62 : num [1:19143] 50.7 49.2 184.6 22 127.3 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 62"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT63 : num [1:19143] 152 146.6 184.7 22 44.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 63"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT64 : num [1:19143] 151.99 46.59 190.07 7.32 133.44 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 64"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT65 : num [1:19143] 50.66 46.22 67.63 7.32 44.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 65"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT66 : num [1:19143] 50.7 46.6 203.3 22 133.4 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 66"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT67 : num [1:19143] 152 49.2 67.7 22 44.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 67"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT68 : num [1:19143] 152 155.9 197 22 46.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 68"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT69 : num [1:19143] 152 147.7 67.8 22 46.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 69"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT70 : num [1:19143] 151.99 48.87 71.38 7.32 46.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 70"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT71 : num [1:19143] 50.7 154.6 73.5 22 133.4 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 71"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT72 : num [1:19143] 151.99 147.57 71.34 7.32 127.32 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 72"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT73 : num [1:19143] 50.7 46.2 197 22 44.5 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 73"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT74 : num [1:19143] 151.99 48.87 184.54 7.32 133.44 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 74"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT75 : num [1:19143] 50.66 155.77 65.71 7.32 127.32 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 75"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT76 : num [1:19143] 50.66 155.7 202.92 7.32 44.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 76"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT77 : num [1:19143] 50.66 154.69 190.34 7.32 46.48 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 77"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT78 : num [1:19143] 50.7 146.6 65.7 22 133.4 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 78"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT79 : num [1:19143] 152 48.9 73.6 22 127.3 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 79"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ W_FSTURWT80 : num [1:19143] 151.99 146.6 203.21 7.32 127.32 ...
## ..- attr(*, "label")= chr "FINAL TRIMMED NONRESPONSE ADJUSTED STUDENT REPLICATE BRR-FAY WEIGHTS 80"
## ..- attr(*, "format.spss")= chr "F8.5"
## $ PV1MATH : num [1:19143] 393 388 313 486 327 ...
## ..- attr(*, "label")= chr "Plausible Value 1 in Mathematics"
## ..- attr(*, "format.spss")= chr "F8.3"
## $ PV2MATH : num [1:19143] 376 373 320 407 297 ...
## ..- attr(*, "label")= chr "Plausible Value 2 in Mathematics"
## ..- attr(*, "format.spss")= chr "F8.3"
## $ PV3MATH : num [1:19143] 405 320 350 436 332 ...
## ..- attr(*, "label")= chr "Plausible Value 3 in Mathematics"
## ..- attr(*, "format.spss")= chr "F8.3"
## $ PV4MATH : num [1:19143] 455 345 274 476 338 ...
## ..- attr(*, "label")= chr "Plausible Value 4 in Mathematics"
## ..- attr(*, "format.spss")= chr "F8.3"
## $ PV5MATH : num [1:19143] 403 383 300 328 315 ...
## ..- attr(*, "label")= chr "Plausible Value 5 in Mathematics"
## ..- attr(*, "format.spss")= chr "F8.3"
## $ PV6MATH : num [1:19143] 464 347 316 452 327 ...
## ..- attr(*, "label")= chr "Plausible Value 6 in Mathematics"
## ..- attr(*, "format.spss")= chr "F8.3"
## $ PV7MATH : num [1:19143] 428 405 371 442 289 ...
## ..- attr(*, "label")= chr "Plausible Value 7 in Mathematics"
## ..- attr(*, "format.spss")= chr "F8.3"
## [list output truncated]# Criação de variáveis binárias de resiliência definidas como score igual a 4
pisa_data <- pisa_data %>%
mutate(
# Criar nome do país baseado no código CNT
country_name = case_when(
CNT == "ARG" ~ "Argentina",
CNT == "BRA" ~ "Brasil",
CNT == "CHL" ~ "Chile",
CNT == "COL" ~ "Colombia",
CNT == "CRI" ~ "Costa Rica",
CNT == "MEX" ~ "México",
CNT == "PAN" ~ "Panamá",
CNT == "PER" ~ "Peru",
CNT == "URY" ~ "Uruguay",
TRUE ~ as.character(CNT)
)
)
# Criação de labels descritivos para as variáveis
policy_names <- c(
"IC179Q01JA" = "Proibir celular em sala",
"IC179Q02JA" = "Proibir notebook/tablet próprio",
"IC179Q03JA" = "Colaboração aluno-professor",
"IC179Q04JA" = "Filtros contra redes sociais",
"IC179Q05JA" = "Filtros contra jogos online",
"IC179Q06JA" = "Monitoramento pelo professor"
)
# Resumo geral das variáveis de resiliência
resilience_summary <- pisa_data %>%
summarise(
`Matemática (%)` = round(mean(resil_math, na.rm = TRUE) * 100, 1),
`Leitura (%)` = round(mean(resil_read, na.rm = TRUE) * 100, 1),
`Ciências (%)` = round(mean(resil_scie, na.rm = TRUE) * 100, 1),
`N Total` = n()
)
safe_kable(resilience_summary,
caption = "Proporção Geral de Estudantes Resilientes por Domínio") %>%
kable_styling(bootstrap_options = c("striped", "hover"))## Executando safe_kable...
## Dimensões dos dados: 1 4
## Nomes das colunas: Matemática (%), Leitura (%), Ciências (%), N Total
## Usando kable com nomes automáticos.| Matemática (%) | Leitura (%) | Ciências (%) | N Total |
|---|---|---|---|
| 9 | 9.1 | 9.2 | 19143 |
5 Análise Exploratória Geral
5.1 Distribuição das Variáveis de Resiliência
# Gráfico de distribuição das variáveis de resiliência
resilience_long <- pisa_data %>%
select(resil_math, resil_read, resil_scie) %>%
tidyr::pivot_longer(everything(), names_to = "domain", values_to = "resilient") %>%
mutate(
domain = case_when(
domain == "resil_math" ~ "Matemática",
domain == "resil_read" ~ "Leitura",
domain == "resil_scie" ~ "Ciências"
)
)
p1 <- ggplot(resilience_long, aes(x = factor(resilient), fill = domain)) +
geom_bar(position = "dodge", alpha = 0.8) +
facet_wrap(~domain) +
scale_fill_brewer(type = "qual", palette = "Set2") +
labs(
title = "Distribuição Geral de Resiliência Acadêmica por Domínio",
x = "Resiliente (0 = Não, 1 = Sim)",
y = "Número de Estudantes",
fill = "Domínio"
) +
theme_minimal() +
theme(
plot.title = element_text(size = 14, face = "bold"),
strip.text = element_text(size = 12, face = "bold"),
legend.position = "none"
)
print(p1)
5.2 Distribuição das Políticas de Tecnologia
# Preparação dos dados para visualização
policy_data <- pisa_data %>%
select(IC179Q01JA:IC179Q06JA) %>%
tidyr::pivot_longer(everything(), names_to = "policy", values_to = "response") %>%
mutate(
policy_name = policy_names[policy],
response_label = case_when(
response == 1 ~ "Discordo totalmente",
response == 2 ~ "Discordo",
response == 3 ~ "Concordo",
response == 4 ~ "Concordo totalmente"
),
response_label = factor(response_label, levels = c(
"Discordo totalmente", "Discordo", "Concordo", "Concordo totalmente"
))
)
# Gráfico de barras empilhadas
p2 <- ggplot(policy_data, aes(x = policy_name, fill = response_label)) +
geom_bar(position = "fill", alpha = 0.8) +
scale_fill_brewer(type = "div", palette = "RdYlBu", direction = -1) +
coord_flip() +
labs(
title = "Distribuição Geral das Respostas às Políticas de Tecnologia",
x = "Políticas de Tecnologia",
y = "Proporção de Respostas",
fill = "Nível de Concordância"
) +
theme_minimal() +
theme(
plot.title = element_text(size = 14, face = "bold"),
axis.text.y = element_text(size = 10),
legend.position = "bottom"
) +
guides(fill = guide_legend(nrow = 2))
print(p2)
6 Análise Exploratória por País
6.1 Distribuição de Resiliência por País
# Análise detalhada de resiliência por país
country_resilience <- pisa_data %>%
group_by(CNT, country_name) %>%
summarise(
n = n(),
math_resilient = round(mean(resil_math, na.rm = TRUE) * 100, 1),
read_resilient = round(mean(resil_read, na.rm = TRUE) * 100, 1),
scie_resilient = round(mean(resil_scie, na.rm = TRUE) * 100, 1),
math_mean = round(mean(resil_math, na.rm = TRUE), 1),
read_mean = round(mean(resil_read, na.rm = TRUE), 1),
scie_mean = round(mean(resil_scie, na.rm = TRUE), 1),
.groups = "drop"
) %>%
arrange(desc(math_resilient))
# Criar tabela com verificação robusta usando safe_add_header_above
table_data <- country_resilience %>% select(-CNT)
result_table <- safe_kable(table_data,
col_names = c("País", "N", "Mat (%)", "Lei (%)", "Ciê (%)",
"Mat (Média)", "Lei (Média)", "Ciê (Média)"),
caption = "Resiliência e Desempenho Médio por País") %>%
kable_styling(bootstrap_options = c("striped", "hover")) %>%
safe_add_header_above(c(" " = 2, "% Resilientes" = 3, "Escores Médios" = 3), table_data)## Executando safe_add_header_above...
## Colunas esperadas pelo header_spec: 8
## Colunas reais na tabela: 8
## Executando safe_kable...
## Dimensões dos dados: 11 8
## Nomes das colunas: country_name, n, math_resilient, read_resilient, scie_resilient, math_mean, read_mean, scie_mean
## Col.names especificados: 8
## Estrutura compatível. Usando col.names especificados.
## add_header_above aplicado com sucesso.| País | N | Mat (%) | Lei (%) | Ciê (%) | Mat (Média) | Lei (Média) | Ciê (Média) |
|---|---|---|---|---|---|---|---|
| DOM | 1684 | 11.4 | 10.6 | 11.3 | 0.1 | 0.1 | 0.1 |
| México | 1568 | 11.2 | 9.8 | 10.3 | 0.1 | 0.1 | 0.1 |
| PRY | 1256 | 11.2 | 11.9 | 10.7 | 0.1 | 0.1 | 0.1 |
| GTM | 1295 | 10.3 | 8.6 | 10.1 | 0.1 | 0.1 | 0.1 |
| Uruguay | 1627 | 10.1 | 11.2 | 10.8 | 0.1 | 0.1 | 0.1 |
| Brasil | 2584 | 8.8 | 10.3 | 9.2 | 0.1 | 0.1 | 0.1 |
| Chile | 1546 | 8.1 | 8.9 | 7.8 | 0.1 | 0.1 | 0.1 |
| Argentina | 2930 | 7.8 | 8.5 | 9.1 | 0.1 | 0.1 | 0.1 |
| Colombia | 1865 | 7.8 | 7.0 | 8.2 | 0.1 | 0.1 | 0.1 |
| Panamá | 1057 | 7.1 | 7.9 | 7.6 | 0.1 | 0.1 | 0.1 |
| Peru | 1731 | 6.5 | 5.9 | 6.4 | 0.1 | 0.1 | 0.1 |
# Gráfico comparativo de resiliência por país
country_long <- country_resilience %>%
tidyr::pivot_longer(cols = c(math_resilient, read_resilient, scie_resilient),
names_to = "domain", values_to = "percentage") %>%
mutate(
domain = case_when(
domain == "math_resilient" ~ "Matemática",
domain == "read_resilient" ~ "Leitura",
domain == "scie_resilient" ~ "Ciências"
)
)
p3 <- ggplot(country_long, aes(x = reorder(country_name, percentage),
y = percentage, fill = domain)) +
geom_col(position = "dodge", alpha = 0.8) +
coord_flip() +
scale_fill_brewer(type = "qual", palette = "Set1") +
labs(
title = "Proporção de Estudantes Resilientes por País e Domínio",
x = "País",
y = "Porcentagem de Estudantes Resilientes",
fill = "Domínio"
) +
theme_minimal() +
theme(
plot.title = element_text(size = 14, face = "bold"),
legend.position = "bottom"
)
print(p3)
6.2 Distribuição das Políticas de Tecnologia por País
# Análise das políticas por país
country_policies <- pisa_data %>%
group_by(CNT, country_name) %>%
summarise(
across(IC179Q01JA:IC179Q06JA, ~ round(mean(.x, na.rm = TRUE), 2)),
.groups = "drop"
)
# Renomear colunas para melhor visualização
country_policies_display <- country_policies %>%
select(-CNT) %>%
rename(
"Proibir celular" = IC179Q01JA,
"Proibir notebook" = IC179Q02JA,
"Colaboração" = IC179Q03JA,
"Filtros sociais" = IC179Q04JA,
"Filtros jogos" = IC179Q05JA,
"Monitoramento" = IC179Q06JA
)
safe_kable(country_policies_display,
caption = "Médias das Políticas de Tecnologia por País (Escala 1-4)",
digits = 2) %>%
kable_styling(bootstrap_options = c("striped", "hover"))## Executando safe_kable...
## Dimensões dos dados: 11 7
## Nomes das colunas: country_name, Proibir celular, Proibir notebook, Colaboração, Filtros sociais, Filtros jogos, Monitoramento
## Usando kable com nomes automáticos.| country_name | Proibir celular | Proibir notebook | Colaboração | Filtros sociais | Filtros jogos | Monitoramento |
|---|---|---|---|---|---|---|
| Argentina | 1.94 | 2.16 | 2.62 | 2.25 | 2.35 | 2.53 |
| Brasil | 1.98 | 2.14 | 2.63 | 2.20 | 2.30 | 2.32 |
| Chile | 1.84 | 2.07 | 2.74 | 2.12 | 2.20 | 2.18 |
| Colombia | NaN | NaN | NaN | NaN | NaN | NaN |
| DOM | 2.09 | 2.10 | 2.55 | 2.19 | 2.26 | 2.42 |
| GTM | NaN | NaN | NaN | NaN | NaN | NaN |
| México | NaN | NaN | NaN | NaN | NaN | NaN |
| Panamá | 2.19 | 2.19 | 2.74 | 2.39 | 2.38 | 2.36 |
| Peru | NaN | NaN | NaN | NaN | NaN | NaN |
| PRY | NaN | NaN | NaN | NaN | NaN | NaN |
| Uruguay | 1.98 | 2.01 | 2.66 | 2.27 | 2.32 | 2.32 |
# Heatmap das políticas por país
policy_matrix <- as.matrix(country_policies[, 3:8])
rownames(policy_matrix) <- country_policies$country_name
colnames(policy_matrix) <- c("Proibir\ncelular", "Proibir\nnotebook", "Colaboração",
"Filtros\nsociais", "Filtros\njogos", "Monitoramento")
# Verificações de segurança para evitar erros no pheatmap
cat("Verificando integridade da matriz para pheatmap...\n")## Verificando integridade da matriz para pheatmap...## Dimensões da matriz: 11 6## Valores NA: 30## Valores NaN: 30## Valores Inf: 0# Tratar valores problemáticos se existirem
if(any(is.na(policy_matrix)) || any(is.nan(policy_matrix)) || any(is.infinite(policy_matrix))) {
cat("AVISO: Valores problemáticos detectados na matriz. Aplicando correções...\n")
# Substituir NA, NaN e Inf pela média da coluna
for(j in 1:ncol(policy_matrix)) {
col_values <- policy_matrix[, j]
valid_values <- col_values[is.finite(col_values)]
if(length(valid_values) > 0) {
col_mean <- mean(valid_values)
policy_matrix[!is.finite(col_values), j] <- col_mean
} else {
# Se não há valores válidos, usar valor padrão
policy_matrix[, j] <- 2.5 # Valor médio da escala 1-4
}
}
cat("Correções aplicadas. Valores problemáticos após correção:\n")
cat("Valores NA:", sum(is.na(policy_matrix)), "\n")
cat("Valores NaN:", sum(is.nan(policy_matrix)), "\n")
cat("Valores Inf:", sum(is.infinite(policy_matrix)), "\n")
}## AVISO: Valores problemáticos detectados na matriz. Aplicando correções...
## Correções aplicadas. Valores problemáticos após correção:
## Valores NA: 0
## Valores NaN: 0
## Valores Inf: 0# Verificar se há variância suficiente para clustering
min_var <- 1e-10 # Variância mínima aceitável
for(j in 1:ncol(policy_matrix)) {
col_var <- var(policy_matrix[, j], na.rm = TRUE)
if(is.na(col_var) || col_var < min_var) {
cat("AVISO: Variância muito baixa na coluna", j, ". Adicionando pequena variação...\n")
# Adicionar pequena variação aleatória para evitar variância zero
policy_matrix[, j] <- policy_matrix[, j] + rnorm(nrow(policy_matrix), 0, 0.01)
}
}
# Tentar criar o heatmap com tratamento de erro
tryCatch({
pheatmap(policy_matrix,
main = "Heatmap: Políticas de Tecnologia por País",
color = colorRampPalette(c("red", "white", "blue"))(50),
scale = "none",
cluster_rows = TRUE,
cluster_cols = TRUE,
display_numbers = TRUE,
number_format = "%.2f",
fontsize = 10,
fontsize_number = 8)
}, error = function(e) {
cat("ERRO no pheatmap:", e$message, "\n")
cat("Tentando versão simplificada sem clustering...\n")
# Versão de fallback sem clustering
tryCatch({
pheatmap(policy_matrix,
main = "Heatmap: Políticas de Tecnologia por País (sem clustering)",
color = colorRampPalette(c("red", "white", "blue"))(50),
scale = "none",
cluster_rows = FALSE,
cluster_cols = FALSE,
display_numbers = TRUE,
number_format = "%.2f",
fontsize = 10,
fontsize_number = 8)
}, error = function(e2) {
cat("ERRO também na versão simplificada:", e2$message, "\n")
cat("Criando heatmap alternativo com ggplot2...\n")
# Alternativa com ggplot2
library(reshape2)
policy_melted <- melt(policy_matrix)
colnames(policy_melted) <- c("País", "Política", "Valor")
p_heatmap <- ggplot(policy_melted, aes(x = Política, y = País, fill = Valor)) +
geom_tile() +
scale_fill_gradient2(low = "red", mid = "white", high = "blue", midpoint = 2.5) +
geom_text(aes(label = round(Valor, 2)), size = 3) +
labs(title = "Heatmap: Políticas de Tecnologia por País (ggplot2)",
x = "Políticas", y = "Países", fill = "Valor") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
print(p_heatmap)
})
})
6.3 Tabelas Descritivas Estratificadas por País
# Estatísticas descritivas detalhadas por país
descriptive_stats <- pisa_data %>%
group_by(CNT, country_name) %>%
summarise(
n = n(),
# Resiliência
math_resilient_pct = round(mean(resil_math, na.rm = TRUE) * 100, 1),
read_resilient_pct = round(mean(resil_read, na.rm = TRUE) * 100, 1),
scie_resilient_pct = round(mean(resil_scie, na.rm = TRUE) * 100, 1),
# Escores médios
math_mean = round(mean(resil_math, na.rm = TRUE), 1),
read_mean = round(mean(resil_read, na.rm = TRUE), 1),
scie_mean = round(mean(resil_scie, na.rm = TRUE), 1),
# Desvios padrão
math_sd = round(sd(resil_math, na.rm = TRUE), 1),
read_sd = round(sd(resil_read, na.rm = TRUE), 1),
scie_sd = round(sd(resil_scie, na.rm = TRUE), 1),
.groups = "drop"
)
# Criar tabela com verificação robusta usando safe_add_header_above
desc_table_data <- descriptive_stats %>% select(-CNT)
desc_result_table <- safe_kable(desc_table_data,
col_names = c("País", "N", "Mat %", "Lei %", "Ciê %",
"Mat M", "Lei M", "Ciê M", "Mat DP", "Lei DP", "Ciê DP"),
caption = "Estatísticas Descritivas Completas por País") %>%
kable_styling(bootstrap_options = c("striped", "hover")) %>%
safe_add_header_above(c(" " = 2, "% Resilientes" = 3, "Médias" = 3, "Desvios Padrão" = 3), desc_table_data)## Executando safe_add_header_above...
## Colunas esperadas pelo header_spec: 11
## Colunas reais na tabela: 11
## Executando safe_kable...
## Dimensões dos dados: 11 11
## Nomes das colunas: country_name, n, math_resilient_pct, read_resilient_pct, scie_resilient_pct, math_mean, read_mean, scie_mean, math_sd, read_sd, scie_sd
## Col.names especificados: 11
## Estrutura compatível. Usando col.names especificados.
## add_header_above aplicado com sucesso.| País | N | Mat % | Lei % | Ciê % | Mat M | Lei M | Ciê M | Mat DP | Lei DP | Ciê DP |
|---|---|---|---|---|---|---|---|---|---|---|
| Argentina | 2930 | 7.8 | 8.5 | 9.1 | 0.1 | 0.1 | 0.1 | 0.3 | 0.3 | 0.3 |
| Brasil | 2584 | 8.8 | 10.3 | 9.2 | 0.1 | 0.1 | 0.1 | 0.3 | 0.3 | 0.3 |
| Chile | 1546 | 8.1 | 8.9 | 7.8 | 0.1 | 0.1 | 0.1 | 0.3 | 0.3 | 0.3 |
| Colombia | 1865 | 7.8 | 7.0 | 8.2 | 0.1 | 0.1 | 0.1 | 0.3 | 0.3 | 0.3 |
| DOM | 1684 | 11.4 | 10.6 | 11.3 | 0.1 | 0.1 | 0.1 | 0.3 | 0.3 | 0.3 |
| GTM | 1295 | 10.3 | 8.6 | 10.1 | 0.1 | 0.1 | 0.1 | 0.3 | 0.3 | 0.3 |
| México | 1568 | 11.2 | 9.8 | 10.3 | 0.1 | 0.1 | 0.1 | 0.3 | 0.3 | 0.3 |
| Panamá | 1057 | 7.1 | 7.9 | 7.6 | 0.1 | 0.1 | 0.1 | 0.3 | 0.3 | 0.3 |
| Peru | 1731 | 6.5 | 5.9 | 6.4 | 0.1 | 0.1 | 0.1 | 0.2 | 0.2 | 0.2 |
| PRY | 1256 | 11.2 | 11.9 | 10.7 | 0.1 | 0.1 | 0.1 | 0.3 | 0.3 | 0.3 |
| Uruguay | 1627 | 10.1 | 11.2 | 10.8 | 0.1 | 0.1 | 0.1 | 0.3 | 0.3 | 0.3 |
# Ranking de países por domínio
ranking_math <- country_resilience %>%
select(country_name, math_resilient) %>%
arrange(desc(math_resilient)) %>%
mutate(rank = row_number())
ranking_read <- country_resilience %>%
select(country_name, read_resilient) %>%
arrange(desc(read_resilient)) %>%
mutate(rank = row_number())
ranking_scie <- country_resilience %>%
select(country_name, scie_resilient) %>%
arrange(desc(scie_resilient)) %>%
mutate(rank = row_number())
# Combinar rankings
rankings_combined <- ranking_math %>%
rename(math_rank = rank) %>%
left_join(ranking_read %>% select(country_name, rank) %>% rename(read_rank = rank),
by = "country_name") %>%
left_join(ranking_scie %>% select(country_name, rank) %>% rename(scie_rank = rank),
by = "country_name") %>%
select(country_name, math_rank, read_rank, scie_rank)
safe_kable(rankings_combined,
col_names = c("País", "Matemática", "Leitura", "Ciências"),
caption = "Ranking de Países por Domínio de Resiliência") %>%
kable_styling(bootstrap_options = c("striped", "hover"))## Executando safe_kable...
## Dimensões dos dados: 11 4
## Nomes das colunas: country_name, math_rank, read_rank, scie_rank
## Col.names especificados: 4
## Estrutura compatível. Usando col.names especificados.| País | Matemática | Leitura | Ciências |
|---|---|---|---|
| DOM | 1 | 3 | 1 |
| México | 2 | 5 | 4 |
| PRY | 3 | 1 | 3 |
| GTM | 4 | 7 | 5 |
| Uruguay | 5 | 2 | 2 |
| Brasil | 6 | 4 | 6 |
| Chile | 7 | 6 | 9 |
| Argentina | 8 | 8 | 7 |
| Colombia | 9 | 10 | 8 |
| Panamá | 10 | 9 | 10 |
| Peru | 11 | 11 | 11 |
7 Visualizações Avançadas por País
7.1 Gráficos de Barras Comparativos
# Gráfico de barras agrupadas para comparação entre países
p4 <- ggplot(country_long, aes(x = country_name, y = percentage, fill = domain)) +
geom_col(position = "dodge", alpha = 0.8) +
scale_fill_brewer(type = "qual", palette = "Dark2") +
labs(
title = "Comparação de Resiliência Acadêmica entre Países",
subtitle = "Porcentagem de estudantes no quartil superior por domínio",
x = "País",
y = "Porcentagem de Estudantes Resilientes",
fill = "Domínio"
) +
theme_minimal() +
theme(
plot.title = element_text(size = 14, face = "bold"),
plot.subtitle = element_text(size = 12),
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "bottom"
) +
geom_text(aes(label = paste0(percentage, "%")),
position = position_dodge(width = 0.9),
vjust = -0.5, size = 3)
print(p4)
# Gráfico de diferenças em relação à média regional
regional_means <- country_long %>%
group_by(domain) %>%
summarise(regional_mean = mean(percentage), .groups = "drop")
country_differences <- country_long %>%
left_join(regional_means, by = "domain") %>%
mutate(difference = percentage - regional_mean)
p5 <- ggplot(country_differences, aes(x = reorder(country_name, difference),
y = difference, fill = domain)) +
geom_col(position = "dodge", alpha = 0.8) +
geom_hline(yintercept = 0, linetype = "dashed", color = "black") +
scale_fill_brewer(type = "qual", palette = "Set3") +
coord_flip() +
labs(
title = "Diferenças em Relação à Média Regional",
subtitle = "Pontos percentuais acima/abaixo da média da América Latina",
x = "País",
y = "Diferença da Média Regional (pontos percentuais)",
fill = "Domínio"
) +
theme_minimal() +
theme(
plot.title = element_text(size = 14, face = "bold"),
plot.subtitle = element_text(size = 12),
legend.position = "bottom"
)
print(p5)
7.2 Gráficos de Correlação por País
# Função para calcular correlações por país com tratamento robusto de erros
calc_country_correlations <- function(country_code) {
country_data <- pisa_data %>% filter(CNT == country_code)
if(nrow(country_data) < 50) return(NULL) # Mínimo de observações
policy_vars <- c("IC179Q01JA", "IC179Q02JA", "IC179Q03JA",
"IC179Q04JA", "IC179Q05JA", "IC179Q06JA")
resilience_vars <- c("resil_math", "resil_read", "resil_scie")
# Verificar se as variáveis existem e têm dados válidos
all_vars <- c(policy_vars, resilience_vars)
available_vars <- all_vars[all_vars %in% colnames(country_data)]
if(length(available_vars) < length(all_vars)) {
cat("AVISO: Algumas variáveis não estão disponíveis para", country_code, "\n")
return(NULL)
}
# Selecionar apenas dados válidos
data_subset <- country_data[, available_vars]
# Remover linhas com todos os valores NA
data_subset <- data_subset[rowSums(is.na(data_subset)) < ncol(data_subset), ]
if(nrow(data_subset) < 30) {
cat("AVISO: Dados insuficientes após limpeza para", country_code, "\n")
return(NULL)
}
# Verificar variância das variáveis
for(var in available_vars) {
var_data <- data_subset[[var]]
valid_data <- var_data[!is.na(var_data)]
if(length(unique(valid_data)) < 2) {
cat("AVISO: Variável", var, "tem variância zero para", country_code, "\n")
return(NULL)
}
}
# Calcular correlações com tratamento de erro
tryCatch({
cor_matrix <- cor(data_subset, use = "complete.obs")
# Verificar se a matriz de correlação é válida
if(any(is.na(cor_matrix)) || any(is.nan(cor_matrix)) || any(is.infinite(cor_matrix))) {
cat("AVISO: Matriz de correlação contém valores inválidos para", country_code, "\n")
return(NULL)
}
# Extrair correlações entre políticas e resiliência
policy_resilience_cor <- cor_matrix[policy_vars, resilience_vars]
return(policy_resilience_cor)
}, error = function(e) {
cat("ERRO ao calcular correlações para", country_code, ":", e$message, "\n")
return(NULL)
})
}
# Calcular correlações para países com dados suficientes
countries_with_data <- pisa_data %>%
count(CNT, country_name) %>%
filter(n >= 200) %>% # Mínimo de 200 observações
pull(CNT)
# Lista para armazenar correlações
country_correlations <- list()
for(country in countries_with_data) {
cor_result <- calc_country_correlations(country)
if(!is.null(cor_result)) {
country_name <- pisa_data %>% filter(CNT == country) %>% pull(country_name) %>% first()
country_correlations[[country_name]] <- cor_result
}
}## AVISO: Variável IC179Q01JA tem variância zero para COL
## AVISO: Variável IC179Q01JA tem variância zero para GTM
## AVISO: Variável IC179Q01JA tem variância zero para MEX
## AVISO: Variável IC179Q01JA tem variância zero para PER
## AVISO: Variável IC179Q01JA tem variância zero para PRY# Visualizar correlações para países selecionados com tratamento de erro
if(length(country_correlations) >= 1) {
cat("Países com correlações calculadas:", length(country_correlations), "\n")
# Tentar criar gráficos de correlação
tryCatch({
n_plots <- min(4, length(country_correlations))
par(mfrow = c(2, 2))
for(i in 1:n_plots) {
country_name <- names(country_correlations)[i]
cor_data <- country_correlations[[i]]
# Verificar se cor_data é válido
if(is.null(cor_data) || !is.matrix(cor_data)) {
cat("AVISO: Dados de correlação inválidos para", country_name, "\n")
next
}
# Verificar se há valores problemáticos
if(any(is.na(cor_data)) || any(is.nan(cor_data)) || any(is.infinite(cor_data))) {
cat("AVISO: Valores problemáticos na matriz de correlação para", country_name, "\n")
# Substituir valores problemáticos por 0
cor_data[!is.finite(cor_data)] <- 0
}
# Renomear linhas e colunas
rownames(cor_data) <- c("Proibir celular", "Proibir notebook", "Colaboração",
"Filtros sociais", "Filtros jogos", "Monitoramento")
colnames(cor_data) <- c("Matemática", "Leitura", "Ciências")
# Tentar criar o corrplot
tryCatch({
corrplot(cor_data,
method = "color",
tl.cex = 0.7,
tl.col = "black",
addCoef.col = "black",
number.cex = 0.6,
title = paste("Correlações -", country_name),
mar = c(0,0,2,0))
}, error = function(e) {
cat("ERRO ao criar corrplot para", country_name, ":", e$message, "\n")
# Criar um plot simples alternativo
plot(1, type="n", main=paste("Correlações -", country_name, "(erro)"),
xlab="", ylab="", axes=FALSE)
text(1, 1, "Erro na visualização", cex=1.2)
})
}
par(mfrow = c(1, 1))
}, error = function(e) {
cat("ERRO geral na visualização de correlações:", e$message, "\n")
par(mfrow = c(1, 1))
})
} else {
cat("Nenhuma correlação por país foi calculada com sucesso.\n")
}## Países com correlações calculadas: 6
8 Análise de Correlações Geral
# Matriz de correlação entre políticas de tecnologia com tratamento robusto
policy_vars <- c("IC179Q01JA", "IC179Q02JA", "IC179Q03JA",
"IC179Q04JA", "IC179Q05JA", "IC179Q06JA")
# Verificar se as variáveis existem nos dados
available_policy_vars <- policy_vars[policy_vars %in% colnames(pisa_data)]
if(length(available_policy_vars) < length(policy_vars)) {
cat("AVISO: Algumas variáveis de política não estão disponíveis\n")
cat("Disponíveis:", paste(available_policy_vars, collapse = ", "), "\n")
}
# Calcular correlações com tratamento de erro
tryCatch({
correlation_matrix <- cor(pisa_data[available_policy_vars], use = "complete.obs")
# Verificar se a matriz é válida
if(any(is.na(correlation_matrix)) || any(is.nan(correlation_matrix)) || any(is.infinite(correlation_matrix))) {
cat("AVISO: Matriz de correlação contém valores inválidos. Aplicando correções...\n")
correlation_matrix[!is.finite(correlation_matrix)] <- 0
diag(correlation_matrix) <- 1 # Diagonal deve ser 1
}
# Aplicar nomes apenas para variáveis disponíveis
available_names <- policy_names[available_policy_vars]
rownames(correlation_matrix) <- available_names
colnames(correlation_matrix) <- available_names
# Visualização da matriz de correlação com tratamento de erro
tryCatch({
corrplot(correlation_matrix,
method = "color",
type = "upper",
order = "original", # Mudado de "hclust" para "original" para evitar problemas
tl.cex = 0.8,
tl.col = "black",
tl.srt = 45,
addCoef.col = "black",
number.cex = 0.7,
title = "Matriz de Correlação Geral - Políticas de Tecnologia",
mar = c(0,0,2,0))
}, error = function(e) {
cat("ERRO no corrplot geral:", e$message, "\n")
cat("Criando visualização alternativa com ggplot2...\n")
# Alternativa com ggplot2
library(reshape2)
cor_melted_alt <- melt(correlation_matrix)
p_cor_alt <- ggplot(cor_melted_alt, aes(x = Var1, y = Var2, fill = value)) +
geom_tile() +
scale_fill_gradient2(low = "red", mid = "white", high = "blue", midpoint = 0) +
geom_text(aes(label = round(value, 2)), size = 3) +
labs(title = "Matriz de Correlação - Políticas de Tecnologia (ggplot2)",
x = "", y = "", fill = "Correlação") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
print(p_cor_alt)
})
}, error = function(e) {
cat("ERRO ao calcular correlações gerais:", e$message, "\n")
})
# Correlação entre políticas e resiliência com tratamento robusto
resilience_vars <- c("resil_math", "resil_read", "resil_scie")
# Verificar se as variáveis de resiliência existem
available_resilience_vars <- resilience_vars[resilience_vars %in% colnames(pisa_data)]
if(length(available_resilience_vars) < length(resilience_vars)) {
cat("AVISO: Algumas variáveis de resiliência não estão disponíveis\n")
cat("Disponíveis:", paste(available_resilience_vars, collapse = ", "), "\n")
}
# Usar apenas variáveis disponíveis
all_vars <- c(available_policy_vars, available_resilience_vars)
# Cálculo das correlações com tratamento de erro
tryCatch({
# Verificar se há dados suficientes
data_subset <- pisa_data[, all_vars]
complete_cases <- complete.cases(data_subset)
if(sum(complete_cases) < 100) {
cat("AVISO: Poucos casos completos para correlação:", sum(complete_cases), "\n")
}
cor_with_resilience <- cor(data_subset, use = "complete.obs")
# Verificar se a matriz é válida
if(any(is.na(cor_with_resilience)) || any(is.nan(cor_with_resilience)) || any(is.infinite(cor_with_resilience))) {
cat("AVISO: Matriz de correlação com resiliência contém valores inválidos\n")
cor_with_resilience[!is.finite(cor_with_resilience)] <- 0
diag(cor_with_resilience) <- 1
}
# Extrair apenas correlações entre políticas e resiliência
policy_resilience_cor <- cor_with_resilience[available_policy_vars, available_resilience_vars]
# Aplicar nomes descritivos
rownames(policy_resilience_cor) <- policy_names[available_policy_vars]
colnames(policy_resilience_cor) <- c("Matemática", "Leitura", "Ciências")[1:length(available_resilience_vars)]
# Criar tabela de correlações com primeira coluna para políticas
cor_table <- data.frame(
Política = policy_names[available_policy_vars],
policy_resilience_cor,
stringsAsFactors = FALSE
)
rownames(cor_table) <- NULL # Remover row.names problemáticos
# Tabela de correlações com verificação robusta
tryCatch({
cor_display <- cor_table %>%
select(-1) %>%
mutate(across(where(is.numeric), ~ round(.x, 3)))
safe_kable(cor_display,
caption = "Correlações Gerais entre Políticas de Tecnologia e Resiliência Acadêmica") %>%
kable_styling(bootstrap_options = c("striped", "hover"))
}, error = function(e) {
cat("ERRO na tabela de correlações:", e$message, "\n")
cat("Usando tabela simplificada...\n")
safe_kable(cor_table,
caption = "Correlações Gerais entre Políticas de Tecnologia e Resiliência Acadêmica (simplificada)") %>%
kable_styling(bootstrap_options = c("striped", "hover"))
})
# Heatmap das correlações com tratamento de erro
tryCatch({
library(reshape2)
cor_melted <- melt(policy_resilience_cor)
# Verificar se há dados para o heatmap
if(nrow(cor_melted) == 0) {
cat("AVISO: Nenhum dado disponível para o heatmap de correlações\n")
} else {
# Determinar limites apropriados para a escala
cor_range <- range(cor_melted$value, na.rm = TRUE)
max_abs <- max(abs(cor_range))
p6 <- ggplot(cor_melted, aes(Var2, Var1, fill = value)) +
geom_tile(alpha = 0.8) +
scale_fill_gradient2(low = "red", high = "blue", mid = "white",
midpoint = 0, limit = c(-max_abs, max_abs)) +
geom_text(aes(label = round(value, 3)), size = 3) +
labs(
title = "Heatmap Geral: Correlações entre Políticas e Resiliência",
x = "Domínio de Resiliência",
y = "Políticas de Tecnologia",
fill = "Correlação"
) +
theme_minimal() +
theme(
plot.title = element_text(size = 14, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1),
axis.text.y = element_text(size = 10)
)
print(p6)
}
}, error = function(e) {
cat("ERRO ao criar heatmap de correlações:", e$message, "\n")
})
}, error = function(e) {
cat("ERRO ao calcular correlações com resiliência:", e$message, "\n")
})## Executando safe_kable...
## Dimensões dos dados: 6 3
## Nomes das colunas: Matemática, Leitura, Ciências
## Usando kable com nomes automáticos.
9 Modelos de Regressão Logística Gerais
9.1 Modelo 1: Resiliência em Matemática
# Modelo de regressão logística para matemática
model_math <- glm(resil_math ~ IC179Q01JA + IC179Q02JA + IC179Q03JA +
IC179Q04JA + IC179Q05JA + IC179Q06JA,
data = pisa_data, family = binomial)
# Resumo do modelo
summary(model_math)##
## Call:
## glm(formula = resil_math ~ IC179Q01JA + IC179Q02JA + IC179Q03JA +
## IC179Q04JA + IC179Q05JA + IC179Q06JA, family = binomial,
## data = pisa_data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.578150 0.160331 -16.080 < 2e-16 ***
## IC179Q01JA -0.317022 0.062483 -5.074 3.9e-07 ***
## IC179Q02JA -0.207401 0.060919 -3.405 0.000663 ***
## IC179Q03JA 0.505814 0.049831 10.151 < 2e-16 ***
## IC179Q04JA -0.011573 0.060681 -0.191 0.848746
## IC179Q05JA 0.122805 0.060108 2.043 0.041046 *
## IC179Q06JA -0.001072 0.051570 -0.021 0.983413
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4494.6 on 5943 degrees of freedom
## Residual deviance: 4314.2 on 5937 degrees of freedom
## (13199 observations deleted due to missingness)
## AIC: 4328.2
##
## Number of Fisher Scoring iterations: 5# Função robusta para calcular intervalos de confiança
calculate_robust_confint <- function(model, method = "profile") {
tryCatch({
# Tentar método de perfil primeiro
if(method == "profile") {
ci <- confint(model)
return(ci)
} else {
# Método Wald como alternativa
ci <- confint.default(model)
return(ci)
}
}, error = function(e) {
cat("AVISO: Erro no cálculo de intervalos de confiança:", e$message, "\n")
cat("Tentando método alternativo...\n")
# Fallback para método Wald
tryCatch({
ci <- confint.default(model)
cat("Intervalos de confiança calculados usando método Wald.\n")
return(ci)
}, error = function(e2) {
cat("ERRO: Também falhou com método Wald:", e2$message, "\n")
cat("Calculando intervalos manualmente usando erros padrão...\n")
# Cálculo manual usando erros padrão
coefs <- coef(model)
se <- sqrt(diag(vcov(model)))
# Intervalo de confiança de 95% (1.96 * SE)
ci_lower <- coefs - 1.96 * se
ci_upper <- coefs + 1.96 * se
ci <- cbind(ci_lower, ci_upper)
colnames(ci) <- c("2.5 %", "97.5 %")
cat("Intervalos calculados manualmente usando erros padrão.\n")
return(ci)
})
})
}
# Verificar convergência do modelo
check_model_convergence <- function(model) {
if(model$converged) {
cat("Modelo convergiu com sucesso.\n")
return(TRUE)
} else {
cat("AVISO: Modelo não convergiu adequadamente.\n")
return(FALSE)
}
}
# Odds ratios e intervalos de confiança com tratamento robusto
or_math <- calculate_robust_or(model_math, "modelo de matemática")## Verificando convergência do modelo de matemática ...
## Modelo convergiu com sucesso.
## Calculando intervalos de confiança para modelo de matemática ...# Verificação de segurança para kable
if(nrow(or_math) > 1) {
or_math_display <- or_math[-1,, drop = FALSE] # Remover intercepto com drop=FALSE
# Verificar se há dados válidos
if(nrow(or_math_display) > 0 && ncol(or_math_display) > 0) {
# Adicionar nomes das linhas como primeira coluna para evitar problemas
or_math_table <- data.frame(
Política = rownames(or_math_display),
or_math_display,
stringsAsFactors = FALSE
)
rownames(or_math_table) <- NULL # Remover row.names problemáticos
tryCatch({
or_math_display_final <- or_math_table %>%
select(-1) %>%
mutate(across(where(is.numeric), ~ round(.x, 3)))
safe_kable(or_math_display_final,
caption = "Odds Ratios - Modelo Geral de Resiliência em Matemática") %>%
kable_styling(bootstrap_options = c("striped", "hover"))
}, error = function(e) {
cat("ERRO na tabela de odds ratios matemática:", e$message, "\n")
safe_kable(or_math_table,
caption = "Odds Ratios - Modelo Geral de Resiliência em Matemática (simplificada)") %>%
kable_styling(bootstrap_options = c("striped", "hover"))
})
} else {
cat("AVISO: Dados insuficientes para exibir tabela de odds ratios de matemática.\n")
}
} else {
cat("AVISO: Modelo de matemática não possui coeficientes suficientes.\n")
}## Executando safe_kable...
## Dimensões dos dados: 6 3
## Nomes das colunas: Odds.Ratio, IC.2.5., IC.97.5.
## Usando kable com nomes automáticos.| Odds.Ratio | IC.2.5. | IC.97.5. |
|---|---|---|
| 0.728 | 0.644 | 0.823 |
| 0.813 | 0.721 | 0.915 |
| 1.658 | 1.505 | 1.830 |
| 0.988 | 0.878 | 1.113 |
| 1.131 | 1.005 | 1.272 |
| 0.999 | 0.903 | 1.105 |
# Métricas de qualidade do modelo
math_metrics <- data.frame(
AIC = AIC(model_math),
`Pseudo R²` = 1 - (model_math$deviance / model_math$null.deviance),
`Log-Likelihood` = logLik(model_math)[1]
)
safe_kable(math_metrics %>%
mutate(across(where(is.numeric), ~ round(.x, 4))),
caption = "Métricas de Qualidade - Modelo Geral Matemática") %>%
kable_styling(bootstrap_options = c("striped", "hover"))## Executando safe_kable...
## Dimensões dos dados: 1 3
## Nomes das colunas: AIC, Pseudo.R., Log.Likelihood
## Usando kable com nomes automáticos.| AIC | Pseudo.R. | Log.Likelihood |
|---|---|---|
| 4328.208 | 0.0401 | -2157.104 |
9.2 Modelo 2: Resiliência em Leitura
# Modelo de regressão logística para leitura
model_read <- glm(resil_read ~ IC179Q01JA + IC179Q02JA + IC179Q03JA +
IC179Q04JA + IC179Q05JA + IC179Q06JA,
data = pisa_data, family = binomial)
# Resumo do modelo
summary(model_read)##
## Call:
## glm(formula = resil_read ~ IC179Q01JA + IC179Q02JA + IC179Q03JA +
## IC179Q04JA + IC179Q05JA + IC179Q06JA, family = binomial,
## data = pisa_data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.54540 0.15828 -16.082 < 2e-16 ***
## IC179Q01JA -0.33301 0.06114 -5.447 5.12e-08 ***
## IC179Q02JA -0.18768 0.05915 -3.173 0.00151 **
## IC179Q03JA 0.57833 0.04892 11.823 < 2e-16 ***
## IC179Q04JA -0.15406 0.05944 -2.592 0.00955 **
## IC179Q05JA 0.22271 0.05821 3.826 0.00013 ***
## IC179Q06JA -0.04143 0.05028 -0.824 0.40996
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4688.5 on 5943 degrees of freedom
## Residual deviance: 4449.7 on 5937 degrees of freedom
## (13199 observations deleted due to missingness)
## AIC: 4463.7
##
## Number of Fisher Scoring iterations: 5# Odds ratios e intervalos de confiança com tratamento robusto
or_read <- calculate_robust_or(model_read, "modelo de leitura")## Verificando convergência do modelo de leitura ...
## Modelo convergiu com sucesso.
## Calculando intervalos de confiança para modelo de leitura ...# Verificação de segurança para kable
if(nrow(or_read) > 1) {
or_read_display <- or_read[-1,, drop = FALSE] # Remover intercepto com drop=FALSE
# Verificar se há dados válidos
if(nrow(or_read_display) > 0 && ncol(or_read_display) > 0) {
# Adicionar nomes das linhas como primeira coluna para evitar problemas
or_read_table <- data.frame(
Política = rownames(or_read_display),
or_read_display,
stringsAsFactors = FALSE
)
rownames(or_read_table) <- NULL # Remover row.names problemáticos
tryCatch({
or_read_display_final <- or_read_table %>%
select(-1) %>%
mutate(across(where(is.numeric), ~ round(.x, 3)))
safe_kable(or_read_display_final,
caption = "Odds Ratios - Modelo Geral de Resiliência em Leitura") %>%
kable_styling(bootstrap_options = c("striped", "hover"))
}, error = function(e) {
cat("ERRO na tabela de odds ratios leitura:", e$message, "\n")
safe_kable(or_read_table,
caption = "Odds Ratios - Modelo Geral de Resiliência em Leitura (simplificada)") %>%
kable_styling(bootstrap_options = c("striped", "hover"))
})
} else {
cat("AVISO: Dados insuficientes para exibir tabela de odds ratios de leitura.\n")
}
} else {
cat("AVISO: Modelo de leitura não possui coeficientes suficientes.\n")
}## Executando safe_kable...
## Dimensões dos dados: 6 3
## Nomes das colunas: Odds.Ratio, IC.2.5., IC.97.5.
## Usando kable com nomes automáticos.| Odds.Ratio | IC.2.5. | IC.97.5. |
|---|---|---|
| 0.717 | 0.635 | 0.808 |
| 0.829 | 0.738 | 0.930 |
| 1.783 | 1.621 | 1.964 |
| 0.857 | 0.763 | 0.963 |
| 1.249 | 1.115 | 1.400 |
| 0.959 | 0.869 | 1.059 |
# Métricas de qualidade do modelo
read_metrics <- data.frame(
AIC = AIC(model_read),
`Pseudo R²` = 1 - (model_read$deviance / model_read$null.deviance),
`Log-Likelihood` = logLik(model_read)[1]
)
safe_kable(read_metrics %>%
mutate(across(where(is.numeric), ~ round(.x, 4))),
caption = "Métricas de Qualidade - Modelo Geral Leitura") %>%
kable_styling(bootstrap_options = c("striped", "hover"))## Executando safe_kable...
## Dimensões dos dados: 1 3
## Nomes das colunas: AIC, Pseudo.R., Log.Likelihood
## Usando kable com nomes automáticos.| AIC | Pseudo.R. | Log.Likelihood |
|---|---|---|
| 4463.728 | 0.0509 | -2224.864 |
9.3 Modelo 3: Resiliência em Ciências
# Modelo de regressão logística para ciências
model_scie <- glm(resil_scie ~ IC179Q01JA + IC179Q02JA + IC179Q03JA +
IC179Q04JA + IC179Q05JA + IC179Q06JA,
data = pisa_data, family = binomial)
# Resumo do modelo
summary(model_scie)##
## Call:
## glm(formula = resil_scie ~ IC179Q01JA + IC179Q02JA + IC179Q03JA +
## IC179Q04JA + IC179Q05JA + IC179Q06JA, family = binomial,
## data = pisa_data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.392486 0.155958 -15.341 < 2e-16 ***
## IC179Q01JA -0.312016 0.061744 -5.053 4.34e-07 ***
## IC179Q02JA -0.224097 0.060158 -3.725 0.000195 ***
## IC179Q03JA 0.524665 0.048613 10.793 < 2e-16 ***
## IC179Q04JA -0.009643 0.059899 -0.161 0.872107
## IC179Q05JA 0.071373 0.059294 1.204 0.228699
## IC179Q06JA -0.022331 0.050737 -0.440 0.659844
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4621.0 on 5943 degrees of freedom
## Residual deviance: 4425.5 on 5937 degrees of freedom
## (13199 observations deleted due to missingness)
## AIC: 4439.5
##
## Number of Fisher Scoring iterations: 5# Odds ratios e intervalos de confiança com tratamento robusto
or_scie <- calculate_robust_or(model_scie, "modelo de ciências")## Verificando convergência do modelo de ciências ...
## Modelo convergiu com sucesso.
## Calculando intervalos de confiança para modelo de ciências ...# Verificação de segurança para kable
if(nrow(or_scie) > 1) {
or_scie_display <- or_scie[-1,, drop = FALSE] # Remover intercepto com drop=FALSE
# Verificar se há dados válidos
if(nrow(or_scie_display) > 0 && ncol(or_scie_display) > 0) {
# Adicionar nomes das linhas como primeira coluna para evitar problemas
or_scie_table <- data.frame(
Política = rownames(or_scie_display),
or_scie_display,
stringsAsFactors = FALSE
)
rownames(or_scie_table) <- NULL # Remover row.names problemáticos
tryCatch({
or_scie_display_final <- or_scie_table %>%
select(-1) %>%
mutate(across(where(is.numeric), ~ round(.x, 3)))
safe_kable(or_scie_display_final,
caption = "Odds Ratios - Modelo Geral de Resiliência em Ciências") %>%
kable_styling(bootstrap_options = c("striped", "hover"))
}, error = function(e) {
cat("ERRO na tabela de odds ratios ciências:", e$message, "\n")
safe_kable(or_scie_table,
caption = "Odds Ratios - Modelo Geral de Resiliência em Ciências (simplificada)") %>%
kable_styling(bootstrap_options = c("striped", "hover"))
})
} else {
cat("AVISO: Dados insuficientes para exibir tabela de odds ratios de ciências.\n")
}
} else {
cat("AVISO: Modelo de ciências não possui coeficientes suficientes.\n")
}## Executando safe_kable...
## Dimensões dos dados: 6 3
## Nomes das colunas: Odds.Ratio, IC.2.5., IC.97.5.
## Usando kable com nomes automáticos.| Odds.Ratio | IC.2.5. | IC.97.5. |
|---|---|---|
| 0.732 | 0.648 | 0.826 |
| 0.799 | 0.710 | 0.899 |
| 1.690 | 1.537 | 1.860 |
| 0.990 | 0.881 | 1.114 |
| 1.074 | 0.956 | 1.206 |
| 0.978 | 0.885 | 1.080 |
# Métricas de qualidade do modelo
scie_metrics <- data.frame(
AIC = AIC(model_scie),
`Pseudo R²` = 1 - (model_scie$deviance / model_scie$null.deviance),
`Log-Likelihood` = logLik(model_scie)[1]
)
safe_kable(scie_metrics %>%
mutate(across(where(is.numeric), ~ round(.x, 4))),
caption = "Métricas de Qualidade - Modelo Geral Ciências") %>%
kable_styling(bootstrap_options = c("striped", "hover"))## Executando safe_kable...
## Dimensões dos dados: 1 3
## Nomes das colunas: AIC, Pseudo.R., Log.Likelihood
## Usando kable com nomes automáticos.| AIC | Pseudo.R. | Log.Likelihood |
|---|---|---|
| 4439.517 | 0.0423 | -2212.759 |
10 Modelos de Regressão Logística com Interações por País
10.1 Modelos com Termos de Interação País × Políticas
# Modelo com interações para Matemática
model_math_country <- glm(resil_math ~ (IC179Q01JA + IC179Q02JA + IC179Q03JA +
IC179Q04JA + IC179Q05JA + IC179Q06JA) * CNT,
data = pisa_data, family = binomial)
# Modelo com interações para Leitura
model_read_country <- glm(resil_read ~ (IC179Q01JA + IC179Q02JA + IC179Q03JA +
IC179Q04JA + IC179Q05JA + IC179Q06JA) * CNT,
data = pisa_data, family = binomial)
# Modelo com interações para Ciências
model_scie_country <- glm(resil_scie ~ (IC179Q01JA + IC179Q02JA + IC179Q03JA +
IC179Q04JA + IC179Q05JA + IC179Q06JA) * CNT,
data = pisa_data, family = binomial)
# Comparação dos modelos com e sem interações
model_comparison_interaction <- data.frame(
Domínio = c("Matemática", "Leitura", "Ciências"),
`AIC Simples` = c(AIC(model_math), AIC(model_read), AIC(model_scie)),
`AIC Interação` = c(AIC(model_math_country), AIC(model_read_country), AIC(model_scie_country)),
`Pseudo R² Simples` = c(
1 - (model_math$deviance / model_math$null.deviance),
1 - (model_read$deviance / model_read$null.deviance),
1 - (model_scie$deviance / model_scie$null.deviance)
),
`Pseudo R² Interação` = c(
1 - (model_math_country$deviance / model_math_country$null.deviance),
1 - (model_read_country$deviance / model_read_country$null.deviance),
1 - (model_scie_country$deviance / model_scie_country$null.deviance)
)
)
# Criar tabela com verificação robusta usando safe_add_header_above
model_comp_data <- model_comparison_interaction %>%
mutate(across(where(is.numeric), ~ round(.x, 4)))
model_comp_table <- safe_kable(model_comp_data,
caption = "Comparação: Modelos Simples vs. Modelos com Interação por País") %>%
kable_styling(bootstrap_options = c("striped", "hover")) %>%
safe_add_header_above(c(" " = 1, "AIC" = 2, "Pseudo R²" = 2), model_comp_data)## Executando safe_add_header_above...
## Colunas esperadas pelo header_spec: 5
## Colunas reais na tabela: 5
## Executando safe_kable...
## Dimensões dos dados: 3 5
## Nomes das colunas: Domínio, AIC.Simples, AIC.Interação, Pseudo.R..Simples, Pseudo.R..Interação
## Usando kable com nomes automáticos.
## add_header_above aplicado com sucesso.| Domínio | AIC.Simples | AIC.Interação | Pseudo.R..Simples | Pseudo.R..Interação |
|---|---|---|---|---|
| Matemática | 4328.208 | 4337.327 | 0.0401 | 0.0537 |
| Leitura | 4463.728 | 4476.313 | 0.0509 | 0.0632 |
| Ciências | 4439.517 | 4442.794 | 0.0423 | 0.0567 |
# Teste de significância das interações
anova_math <- anova(model_math, model_math_country, test = "Chisq")
anova_read <- anova(model_read, model_read_country, test = "Chisq")
anova_scie <- anova(model_scie, model_scie_country, test = "Chisq")
interaction_tests <- data.frame(
Domínio = c("Matemática", "Leitura", "Ciências"),
`Chi-quadrado` = c(anova_math$Deviance[2], anova_read$Deviance[2], anova_scie$Deviance[2]),
`p-valor` = c(anova_math$`Pr(>Chi)`[2], anova_read$`Pr(>Chi)`[2], anova_scie$`Pr(>Chi)`[2])
)
safe_kable(interaction_tests %>%
mutate(across(where(is.numeric), ~ round(.x, 4))),
caption = "Testes de Significância das Interações País × Políticas") %>%
kable_styling(bootstrap_options = c("striped", "hover"))## Executando safe_kable...
## Dimensões dos dados: 3 3
## Nomes das colunas: Domínio, Chi.quadrado, p.valor
## Usando kable com nomes automáticos.| Domínio | Chi.quadrado | p.valor |
|---|---|---|
| Matemática | 60.8811 | 0.0043 |
| Leitura | 57.4153 | 0.0098 |
| Ciências | 66.7230 | 0.0010 |
10.2 Modelos Estratificados por País (Países Selecionados)
# Função para ajustar modelos por país com tratamento robusto
fit_country_models <- function(country_code, min_obs = 300) {
country_data <- pisa_data %>% filter(CNT == country_code)
country_name <- country_data$country_name[1]
if(nrow(country_data) < min_obs) {
cat("AVISO: Dados insuficientes para", country_name, "(", nrow(country_data), "observações)\n")
return(NULL)
}
cat("Ajustando modelos para", country_name, "com", nrow(country_data), "observações...\n")
# Verificar variabilidade nas variáveis dependentes
math_var <- var(country_data$resil_math, na.rm = TRUE)
read_var <- var(country_data$resil_read, na.rm = TRUE)
scie_var <- var(country_data$resil_scie, na.rm = TRUE)
if(is.na(math_var) || math_var < 1e-10) {
cat("AVISO: Variância muito baixa em matemática para", country_name, "\n")
}
if(is.na(read_var) || read_var < 1e-10) {
cat("AVISO: Variância muito baixa em leitura para", country_name, "\n")
}
if(is.na(scie_var) || scie_var < 1e-10) {
cat("AVISO: Variância muito baixa em ciências para", country_name, "\n")
}
# Verificar se há variação suficiente nas variáveis preditoras
policy_vars <- c("IC179Q01JA", "IC179Q02JA", "IC179Q03JA",
"IC179Q04JA", "IC179Q05JA", "IC179Q06JA")
for(var in policy_vars) {
if(var %in% colnames(country_data)) {
var_unique <- length(unique(country_data[[var]][!is.na(country_data[[var]])]))
if(var_unique < 2) {
cat("AVISO: Variável", var, "tem pouca variação para", country_name, "\n")
}
}
}
# Modelos para cada domínio com tratamento robusto
model_math <- tryCatch({
model <- glm(resil_math ~ IC179Q01JA + IC179Q02JA + IC179Q03JA +
IC179Q04JA + IC179Q05JA + IC179Q06JA,
data = country_data, family = binomial,
control = glm.control(maxit = 100, epsilon = 1e-8))
# Verificar convergência
if(!model$converged) {
cat("AVISO: Modelo de matemática não convergiu para", country_name, "\n")
}
# Verificar separação perfeita
fitted_probs <- fitted(model)
if(any(fitted_probs %in% c(0, 1))) {
cat("AVISO: Possível separação perfeita no modelo de matemática para", country_name, "\n")
}
return(model)
}, error = function(e) {
cat("ERRO no modelo de matemática para", country_name, ":", e$message, "\n")
return(NULL)
})
model_read <- tryCatch({
model <- glm(resil_read ~ IC179Q01JA + IC179Q02JA + IC179Q03JA +
IC179Q04JA + IC179Q05JA + IC179Q06JA,
data = country_data, family = binomial,
control = glm.control(maxit = 100, epsilon = 1e-8))
# Verificar convergência
if(!model$converged) {
cat("AVISO: Modelo de leitura não convergiu para", country_name, "\n")
}
# Verificar separação perfeita
fitted_probs <- fitted(model)
if(any(fitted_probs %in% c(0, 1))) {
cat("AVISO: Possível separação perfeita no modelo de leitura para", country_name, "\n")
}
return(model)
}, error = function(e) {
cat("ERRO no modelo de leitura para", country_name, ":", e$message, "\n")
return(NULL)
})
model_scie <- tryCatch({
model <- glm(resil_scie ~ IC179Q01JA + IC179Q02JA + IC179Q03JA +
IC179Q04JA + IC179Q05JA + IC179Q06JA,
data = country_data, family = binomial,
control = glm.control(maxit = 100, epsilon = 1e-8))
# Verificar convergência
if(!model$converged) {
cat("AVISO: Modelo de ciências não convergiu para", country_name, "\n")
}
# Verificar separação perfeita
fitted_probs <- fitted(model)
if(any(fitted_probs %in% c(0, 1))) {
cat("AVISO: Possível separação perfeita no modelo de ciências para", country_name, "\n")
}
return(model)
}, error = function(e) {
cat("ERRO no modelo de ciências para", country_name, ":", e$message, "\n")
return(NULL)
})
return(list(math = model_math, read = model_read, scie = model_scie))
}
# Ajustar modelos para países com dados suficientes
countries_for_models <- pisa_data %>%
count(CNT, country_name) %>%
filter(n >= 300) %>%
arrange(desc(n))
country_models <- list()
for(i in 1:min(4, nrow(countries_for_models))) {
country_code <- countries_for_models$CNT[i]
country_name <- countries_for_models$country_name[i]
models <- fit_country_models(country_code)
if(!is.null(models)) {
country_models[[country_name]] <- models
}
}## Ajustando modelos para Argentina com 2930 observações...
## Ajustando modelos para Brasil com 2584 observações...
## Ajustando modelos para Colombia com 1865 observações...
## AVISO: Variável IC179Q01JA tem pouca variação para Colombia
## AVISO: Variável IC179Q02JA tem pouca variação para Colombia
## AVISO: Variável IC179Q03JA tem pouca variação para Colombia
## AVISO: Variável IC179Q04JA tem pouca variação para Colombia
## AVISO: Variável IC179Q05JA tem pouca variação para Colombia
## AVISO: Variável IC179Q06JA tem pouca variação para Colombia
## ERRO no modelo de matemática para Colombia : Argument mu must be a nonempty numeric vector
## ERRO no modelo de leitura para Colombia : Argument mu must be a nonempty numeric vector
## ERRO no modelo de ciências para Colombia : Argument mu must be a nonempty numeric vector
## Ajustando modelos para Peru com 1731 observações...
## AVISO: Variável IC179Q01JA tem pouca variação para Peru
## AVISO: Variável IC179Q02JA tem pouca variação para Peru
## AVISO: Variável IC179Q03JA tem pouca variação para Peru
## AVISO: Variável IC179Q04JA tem pouca variação para Peru
## AVISO: Variável IC179Q05JA tem pouca variação para Peru
## AVISO: Variável IC179Q06JA tem pouca variação para Peru
## ERRO no modelo de matemática para Peru : Argument mu must be a nonempty numeric vector
## ERRO no modelo de leitura para Peru : Argument mu must be a nonempty numeric vector
## ERRO no modelo de ciências para Peru : Argument mu must be a nonempty numeric vector# Extrair odds ratios significativos para comparação com tratamento robusto
extract_significant_or <- function(model, alpha = 0.05) {
if(is.null(model)) return(NULL)
tryCatch({
summary_model <- summary(model)
coeffs <- summary_model$coefficients
# Verificar se há coeficientes válidos
if(nrow(coeffs) <= 1) {
cat("AVISO: Modelo não tem coeficientes suficientes.\n")
return(NULL)
}
# Verificar se há valores problemáticos nos coeficientes
if(any(is.na(coeffs)) || any(is.infinite(coeffs))) {
cat("AVISO: Coeficientes contêm valores problemáticos.\n")
# Substituir valores problemáticos
coeffs[is.na(coeffs) | is.infinite(coeffs)] <- 0
}
# Identificar coeficientes significativos
p_values <- coeffs[, 4]
significant <- p_values < alpha
significant <- significant[-1] # Remover intercepto
if(any(significant, na.rm = TRUE)) {
# Calcular odds ratios
coef_values <- coeffs[-1, 1] # Remover intercepto
or_values <- exp(coef_values)
# Verificar se há valores problemáticos nos OR
if(any(is.na(or_values)) || any(is.infinite(or_values))) {
cat("AVISO: Odds ratios contêm valores problemáticos.\n")
# Substituir valores problemáticos por 1 (OR neutro)
or_values[is.na(or_values) | is.infinite(or_values)] <- 1
}
# Selecionar apenas os significativos
or_significant <- or_values[significant]
p_significant <- p_values[-1][significant] # Remover intercepto
# Obter nomes das políticas
coef_names <- names(coef_values)[significant]
policy_names_sig <- policy_names[coef_names]
# Verificar se há nomes válidos
if(length(policy_names_sig) == 0 || all(is.na(policy_names_sig))) {
cat("AVISO: Nenhum nome de política válido encontrado.\n")
policy_names_sig <- coef_names # Usar nomes originais como fallback
}
return(data.frame(
Policy = policy_names_sig,
OR = round(or_significant, 3),
p_value = round(p_significant, 4),
stringsAsFactors = FALSE
))
}
return(NULL)
}, error = function(e) {
cat("ERRO ao extrair odds ratios significativos:", e$message, "\n")
return(NULL)
})
}
# Compilar resultados significativos por país
if(length(country_models) > 0) {
cat("## Resultados Significativos por País\n\n")
for(country_name in names(country_models)) {
cat("### ", country_name, "\n\n")
models <- country_models[[country_name]]
# Matemática
math_sig <- extract_significant_or(models$math)
if(!is.null(math_sig) && nrow(math_sig) > 0) {
cat("**Matemática:**\n")
# Garantir que não há row.names problemáticos
rownames(math_sig) <- NULL
print(safe_kable(math_sig, caption = paste("Efeitos Significativos - Matemática -", country_name)))
cat("\n")
}
# Leitura
read_sig <- extract_significant_or(models$read)
if(!is.null(read_sig) && nrow(read_sig) > 0) {
cat("**Leitura:**\n")
# Garantir que não há row.names problemáticos
rownames(read_sig) <- NULL
print(safe_kable(read_sig, caption = paste("Efeitos Significativos - Leitura -", country_name)))
cat("\n")
}
# Ciências
scie_sig <- extract_significant_or(models$scie)
if(!is.null(scie_sig) && nrow(scie_sig) > 0) {
cat("**Ciências:**\n")
# Garantir que não há row.names problemáticos
rownames(scie_sig) <- NULL
print(safe_kable(scie_sig, caption = paste("Efeitos Significativos - Ciências -", country_name)))
cat("\n")
}
cat("\n---\n\n")
}
}## ## Resultados Significativos por País
##
## ### Argentina
##
##
## ---
##
## ### Brasil
##
##
## ---
##
## ### Colombia
##
##
## ---
##
## ### Peru
##
##
## ---11 Comparação dos Modelos Gerais
# Compilação dos odds ratios de todos os modelos gerais com verificações de segurança
policy_vars <- c("IC179Q01JA", "IC179Q02JA", "IC179Q03JA", "IC179Q04JA", "IC179Q05JA", "IC179Q06JA")
# Função auxiliar para extrair dados de forma segura
safe_extract_or <- function(or_matrix, index = 1) {
if(nrow(or_matrix) > 1 && ncol(or_matrix) >= index) {
return(or_matrix[-1, index])
} else {
return(rep(NA, length(policy_vars)))
}
}
safe_extract_pvalue <- function(model_summary, index = 4) {
coeffs <- model_summary$coefficients
if(nrow(coeffs) > 1 && ncol(coeffs) >= index) {
return(coeffs[-1, index])
} else {
return(rep(NA, length(policy_vars)))
}
}
# Extrair dados de forma segura
math_or <- safe_extract_or(or_math, 1)
math_p <- safe_extract_pvalue(summary(model_math), 4)
read_or <- safe_extract_or(or_read, 1)
read_p <- safe_extract_pvalue(summary(model_read), 4)
scie_or <- safe_extract_or(or_scie, 1)
scie_p <- safe_extract_pvalue(summary(model_scie), 4)
all_or <- data.frame(
Política = policy_names[policy_vars],
`Matemática OR` = round(math_or, 3),
`Matemática p` = round(math_p, 3),
`Leitura OR` = round(read_or, 3),
`Leitura p` = round(read_p, 3),
`Ciências OR` = round(scie_or, 3),
`Ciências p` = round(scie_p, 3),
stringsAsFactors = FALSE
)
# Remover row.names problemáticos
rownames(all_or) <- NULL
# Criar tabela com verificação robusta usando safe_add_header_above
all_or_table <- safe_kable(all_or,
caption = "Comparação dos Odds Ratios e Significância Estatística - Modelos Gerais") %>%
kable_styling(bootstrap_options = c("striped", "hover")) %>%
safe_add_header_above(c(" " = 1, "Matemática" = 2, "Leitura" = 2, "Ciências" = 2), all_or)## Executando safe_add_header_above...
## Colunas esperadas pelo header_spec: 7
## Colunas reais na tabela: 7
## Executando safe_kable...
## Dimensões dos dados: 6 7
## Nomes das colunas: Política, Matemática.OR, Matemática.p, Leitura.OR, Leitura.p, Ciências.OR, Ciências.p
## Usando kable com nomes automáticos.
## add_header_above aplicado com sucesso.| Política | Matemática.OR | Matemática.p | Leitura.OR | Leitura.p | Ciências.OR | Ciências.p |
|---|---|---|---|---|---|---|
| Proibir celular em sala | 0.728 | 0.000 | 0.717 | 0.000 | 0.732 | 0.000 |
| Proibir notebook/tablet próprio | 0.813 | 0.001 | 0.829 | 0.002 | 0.799 | 0.000 |
| Colaboração aluno-professor | 1.658 | 0.000 | 1.783 | 0.000 | 1.690 | 0.000 |
| Filtros contra redes sociais | 0.988 | 0.849 | 0.857 | 0.010 | 0.990 | 0.872 |
| Filtros contra jogos online | 1.131 | 0.041 | 1.249 | 0.000 | 1.074 | 0.229 |
| Monitoramento pelo professor | 0.999 | 0.983 | 0.959 | 0.410 | 0.978 | 0.660 |
# Métricas comparativas dos modelos
model_comparison <- data.frame(
Modelo = c("Matemática", "Leitura", "Ciências"),
AIC = c(AIC(model_math), AIC(model_read), AIC(model_scie)),
`Pseudo R²` = c(
1 - (model_math$deviance / model_math$null.deviance),
1 - (model_read$deviance / model_read$null.deviance),
1 - (model_scie$deviance / model_scie$null.deviance)
),
`Log-Likelihood` = c(
logLik(model_math)[1],
logLik(model_read)[1],
logLik(model_scie)[1]
)
)
safe_kable(model_comparison %>%
mutate(across(where(is.numeric), ~ round(.x, 4))),
caption = "Comparação das Métricas de Qualidade dos Modelos Gerais") %>%
kable_styling(bootstrap_options = c("striped", "hover"))## Executando safe_kable...
## Dimensões dos dados: 3 4
## Nomes das colunas: Modelo, AIC, Pseudo.R., Log.Likelihood
## Usando kable com nomes automáticos.| Modelo | AIC | Pseudo.R. | Log.Likelihood |
|---|---|---|---|
| Matemática | 4328.208 | 0.0401 | -2157.104 |
| Leitura | 4463.728 | 0.0509 | -2224.864 |
| Ciências | 4439.517 | 0.0423 | -2212.759 |
11.1 Visualização dos Odds Ratios
# Preparação dos dados para visualização com verificações de segurança
math_ci_lower <- safe_extract_or(or_math, 2)
math_ci_upper <- safe_extract_or(or_math, 3)
read_ci_lower <- safe_extract_or(or_read, 2)
read_ci_upper <- safe_extract_or(or_read, 3)
scie_ci_lower <- safe_extract_or(or_scie, 2)
scie_ci_upper <- safe_extract_or(or_scie, 3)
or_data <- data.frame(
policy = rep(policy_names[policy_vars], 3),
domain = rep(c("Matemática", "Leitura", "Ciências"), each = 6),
odds_ratio = c(math_or, read_or, scie_or),
ci_lower = c(math_ci_lower, read_ci_lower, scie_ci_lower),
ci_upper = c(math_ci_upper, read_ci_upper, scie_ci_upper),
p_value = c(math_p, read_p, scie_p),
stringsAsFactors = FALSE
) %>%
mutate(
significant = ifelse(p_value < 0.05, "Significativo", "Não Significativo"),
policy_short = case_when(
policy == "Proibir celular em sala" ~ "Proibir celular",
policy == "Proibir notebook/tablet próprio" ~ "Proibir notebook",
policy == "Colaboração aluno-professor" ~ "Colaboração",
policy == "Filtros contra redes sociais" ~ "Filtros sociais",
policy == "Filtros contra jogos online" ~ "Filtros jogos",
policy == "Monitoramento pelo professor" ~ "Monitoramento"
)
)
# Gráfico de odds ratios
p7 <- ggplot(or_data, aes(x = policy_short, y = odds_ratio, color = domain, shape = significant)) +
geom_point(size = 3, position = position_dodge(width = 0.5)) +
geom_errorbar(aes(ymin = ci_lower, ymax = ci_upper),
width = 0.2, position = position_dodge(width = 0.5)) +
geom_hline(yintercept = 1, linetype = "dashed", color = "red", alpha = 0.7) +
scale_color_brewer(type = "qual", palette = "Set1") +
scale_shape_manual(values = c("Significativo" = 16, "Não Significativo" = 1)) +
coord_flip() +
labs(
title = "Odds Ratios das Políticas de Tecnologia por Domínio - Modelos Gerais",
subtitle = "Intervalos de confiança de 95% | Linha vermelha indica OR = 1",
x = "Políticas de Tecnologia",
y = "Odds Ratio",
color = "Domínio",
shape = "Significância"
) +
theme_minimal() +
theme(
plot.title = element_text(size = 14, face = "bold"),
plot.subtitle = element_text(size = 12),
legend.position = "bottom"
)
print(p7)
12 Análise Comparativa Detalhada por País
12.1 Identificação de Padrões Específicos por País
# Análise de padrões únicos por país
country_patterns <- pisa_data %>%
group_by(CNT, country_name) %>%
summarise(
n = n(),
# Resiliência média por domínio
math_resilient = mean(resil_math, na.rm = TRUE),
read_resilient = mean(resil_read, na.rm = TRUE),
scie_resilient = mean(resil_scie, na.rm = TRUE),
# Políticas mais adotadas (média > 3)
high_phone_ban = mean(IC179Q01JA >= 3, na.rm = TRUE),
high_laptop_ban = mean(IC179Q02JA >= 3, na.rm = TRUE),
high_collaboration = mean(IC179Q03JA >= 3, na.rm = TRUE),
high_social_filters = mean(IC179Q04JA >= 3, na.rm = TRUE),
high_game_filters = mean(IC179Q05JA >= 3, na.rm = TRUE),
high_monitoring = mean(IC179Q06JA >= 3, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(
# Classificação de resiliência geral
overall_resilience = (math_resilient + read_resilient + scie_resilient) / 3,
resilience_category = case_when(
overall_resilience >= 0.30 ~ "Alta Resiliência",
overall_resilience >= 0.20 ~ "Média Resiliência",
TRUE ~ "Baixa Resiliência"
),
# Política mais adotada
most_adopted_policy = case_when(
high_phone_ban == pmax(high_phone_ban, high_laptop_ban, high_collaboration,
high_social_filters, high_game_filters, high_monitoring) ~ "Proibição de celular",
high_collaboration == pmax(high_phone_ban, high_laptop_ban, high_collaboration,
high_social_filters, high_game_filters, high_monitoring) ~ "Colaboração",
high_monitoring == pmax(high_phone_ban, high_laptop_ban, high_collaboration,
high_social_filters, high_game_filters, high_monitoring) ~ "Monitoramento",
TRUE ~ "Filtros"
)
)
# Tabela de padrões por país
patterns_table <- country_patterns %>%
select(country_name, n, resilience_category, most_adopted_policy, overall_resilience) %>%
arrange(desc(overall_resilience))
safe_kable(patterns_table,
col_names = c("País", "N", "Categoria de Resiliência", "Política Mais Adotada", "Resiliência Geral"),
caption = "Padrões de Resiliência e Políticas por País",
digits = 3) %>%
kable_styling(bootstrap_options = c("striped", "hover"))## Executando safe_kable...
## Dimensões dos dados: 11 5
## Nomes das colunas: country_name, n, resilience_category, most_adopted_policy, overall_resilience
## Col.names especificados: 5
## Estrutura compatível. Usando col.names especificados.| País | N | Categoria de Resiliência | Política Mais Adotada | Resiliência Geral |
|---|---|---|---|---|
| PRY | 1256 | Baixa Resiliência | Filtros | 0.113 |
| DOM | 1684 | Baixa Resiliência | Colaboração | 0.111 |
| Uruguay | 1627 | Baixa Resiliência | Colaboração | 0.107 |
| México | 1568 | Baixa Resiliência | Filtros | 0.105 |
| GTM | 1295 | Baixa Resiliência | Filtros | 0.097 |
| Brasil | 2584 | Baixa Resiliência | Colaboração | 0.094 |
| Argentina | 2930 | Baixa Resiliência | Colaboração | 0.085 |
| Chile | 1546 | Baixa Resiliência | Colaboração | 0.083 |
| Colombia | 1865 | Baixa Resiliência | Filtros | 0.077 |
| Panamá | 1057 | Baixa Resiliência | Colaboração | 0.075 |
| Peru | 1731 | Baixa Resiliência | Filtros | 0.063 |
# Gráfico de dispersão: Resiliência vs Adoção de Políticas
policy_adoption <- country_patterns %>%
mutate(
avg_policy_adoption = (high_phone_ban + high_laptop_ban + high_collaboration +
high_social_filters + high_game_filters + high_monitoring) / 6
)
p8 <- ggplot(policy_adoption, aes(x = avg_policy_adoption, y = overall_resilience)) +
geom_point(aes(color = resilience_category, size = n), alpha = 0.7) +
geom_text(aes(label = country_name), vjust = -0.5, size = 3) +
geom_smooth(method = "lm", se = TRUE, color = "blue", alpha = 0.3) +
scale_color_brewer(type = "qual", palette = "Set1") +
scale_size_continuous(range = c(3, 8)) +
labs(
title = "Relação entre Adoção de Políticas e Resiliência Geral",
subtitle = "Cada ponto representa um país",
x = "Proporção Média de Adoção de Políticas (concordância ≥ 3)",
y = "Resiliência Geral (proporção média nos 3 domínios)",
color = "Categoria de Resiliência",
size = "Tamanho da Amostra"
) +
theme_minimal() +
theme(
plot.title = element_text(size = 14, face = "bold"),
plot.subtitle = element_text(size = 12),
legend.position = "bottom"
)
print(p8)
12.2 Análise de Clusters de Países
# Função robusta para análise de clusters
perform_robust_clustering <- function(data, method = "ward.D2", k = 3) {
tryCatch({
# Verificar se há dados suficientes
if(nrow(data) < 3) {
cat("AVISO: Dados insuficientes para clustering (menos de 3 observações).\n")
return(NULL)
}
# Verificar valores problemáticos
cat("Verificando integridade dos dados para clustering...\n")
cat("Dimensões dos dados:", dim(data), "\n")
cat("Valores NA:", sum(is.na(data)), "\n")
cat("Valores NaN:", sum(is.nan(data)), "\n")
cat("Valores Inf:", sum(is.infinite(data)), "\n")
# Limpar dados problemáticos
if(any(is.na(data)) || any(is.nan(data)) || any(is.infinite(data))) {
cat("AVISO: Valores problemáticos detectados. Aplicando correções...\n")
# Substituir valores problemáticos pela média da coluna
for(j in 1:ncol(data)) {
col_values <- data[, j]
valid_values <- col_values[is.finite(col_values)]
if(length(valid_values) > 0) {
col_mean <- mean(valid_values)
data[!is.finite(col_values), j] <- col_mean
} else {
# Se não há valores válidos, usar valor padrão baseado no tipo de variável
if(j <= 3) {
data[, j] <- 0.25 # Para variáveis de resiliência (proporção)
} else {
data[, j] <- 0.5 # Para variáveis de política (proporção)
}
}
}
cat("Correções aplicadas.\n")
}
# Verificar variância das colunas
for(j in 1:ncol(data)) {
col_var <- var(data[, j], na.rm = TRUE)
if(is.na(col_var) || col_var < 1e-10) {
cat("AVISO: Variância muito baixa na coluna", j, ". Adicionando pequena variação...\n")
# Adicionar pequena variação aleatória
data[, j] <- data[, j] + rnorm(nrow(data), 0, 0.001)
}
}
# Padronizar os dados
data_scaled <- scale(data)
# Verificar se a padronização foi bem-sucedida
if(any(is.na(data_scaled)) || any(is.nan(data_scaled)) || any(is.infinite(data_scaled))) {
cat("AVISO: Problemas na padronização. Usando dados originais...\n")
data_scaled <- data
}
# Criar matriz de distância
cat("Criando matriz de distância...\n")
dist_matrix <- dist(data_scaled)
# Verificar matriz de distância
if(any(is.na(dist_matrix)) || any(is.nan(dist_matrix)) || any(is.infinite(dist_matrix))) {
cat("ERRO: Matriz de distância contém valores problemáticos.\n")
cat("Tentando método alternativo de distância...\n")
# Tentar método de distância alternativo
dist_matrix <- dist(data_scaled, method = "manhattan")
if(any(is.na(dist_matrix)) || any(is.nan(dist_matrix)) || any(is.infinite(dist_matrix))) {
cat("ERRO: Ainda há problemas na matriz de distância. Abortando clustering.\n")
return(NULL)
}
}
# Realizar clustering hierárquico
cat("Realizando clustering hierárquico...\n")
hc <- hclust(dist_matrix, method = method)
return(list(
hclust_result = hc,
scaled_data = data_scaled,
dist_matrix = dist_matrix,
original_data = data
))
}, error = function(e) {
cat("ERRO no clustering:", e$message, "\n")
return(NULL)
})
}
# Preparar dados para análise de clusters
cluster_data_temp <- country_patterns %>%
select(country_name, math_resilient, read_resilient, scie_resilient,
high_phone_ban, high_laptop_ban, high_collaboration,
high_social_filters, high_game_filters, high_monitoring)
# Verificar se há dados suficientes
if(nrow(cluster_data_temp) < 3) {
cat("AVISO: Dados insuficientes para análise de clusters. Pulando análise.\n")
} else {
# Criar matriz de dados para clustering de forma segura
cluster_data <- as.matrix(cluster_data_temp[, -1]) # Remover coluna country_name
rownames(cluster_data) <- cluster_data_temp$country_name # Adicionar nomes de forma segura
# Realizar clustering robusto
clustering_result <- perform_robust_clustering(cluster_data, method = "ward.D2", k = 3)
if(!is.null(clustering_result)) {
# Extrair resultados
hc <- clustering_result$hclust_result
cluster_data_scaled <- clustering_result$scaled_data
# Dendrograma
plot(hc, main = "Dendrograma de Países - Resiliência e Políticas",
xlab = "Países", ylab = "Distância", cex = 0.8)
rect.hclust(hc, k = 3, border = "red")
# Identificar clusters
clusters <- cutree(hc, k = 3)
cluster_results <- data.frame(
País = names(clusters),
Cluster = clusters
) %>%
left_join(country_patterns %>% select(country_name, resilience_category, most_adopted_policy),
by = c("País" = "country_name"))
safe_kable(cluster_results,
caption = "Agrupamento de Países por Similaridade") %>%
kable_styling(bootstrap_options = c("striped", "hover"))
# Caracterização dos clusters
cluster_summary <- country_patterns %>%
mutate(cluster = clusters[country_name]) %>%
group_by(cluster) %>%
summarise(
n_countries = n(),
avg_read_resilience = round(mean(read_resilient, na.rm = TRUE), 3),
avg_scie_resilience = round(mean(scie_resilient, na.rm = TRUE), 3),
avg_phone_ban = round(mean(high_phone_ban, na.rm = TRUE), 3),
avg_collaboration = round(mean(high_collaboration, na.rm = TRUE), 3),
avg_monitoring = round(mean(high_monitoring, na.rm = TRUE), 3),
.groups = "drop"
)
# Criar tabela com verificação robusta usando safe_add_header_above
cluster_table <- safe_kable(cluster_summary,
col_names = c("Cluster", "N Países", "Mat", "Lei", "Ciê", "Proib. Cel.", "Colab.", "Monitor."),
caption = "Caracterização dos Clusters de Países") %>%
kable_styling(bootstrap_options = c("striped", "hover")) %>%
safe_add_header_above(c(" " = 2, "Resiliência Média" = 3, "Políticas Médias" = 3), cluster_summary)
cluster_table
cat("Análise de clusters concluída com sucesso.\n")
} else {
cat("ERRO: Não foi possível realizar a análise de clusters devido a problemas nos dados.\n")
cat("Criando visualização alternativa...\n")
# Visualização alternativa sem clustering
alternative_plot <- country_patterns %>%
ggplot(aes(x = overall_resilience, y = reorder(country_name, overall_resilience))) +
geom_col(aes(fill = resilience_category), alpha = 0.8) +
scale_fill_brewer(type = "qual", palette = "Set1") +
labs(
title = "Resiliência Geral por País (Visualização Alternativa)",
x = "Resiliência Geral (Proporção Média)",
y = "País",
fill = "Categoria"
) +
theme_minimal() +
theme(
plot.title = element_text(size = 14, face = "bold"),
legend.position = "bottom"
)
print(alternative_plot)
}
}## Verificando integridade dos dados para clustering...
## Dimensões dos dados: 11 9
## Valores NA: 30
## Valores NaN: 30
## Valores Inf: 0
## AVISO: Valores problemáticos detectados. Aplicando correções...
## Correções aplicadas.
## Criando matriz de distância...
## Realizando clustering hierárquico...
## Executando safe_kable...
## Dimensões dos dados: 11 4
## Nomes das colunas: País, Cluster, resilience_category, most_adopted_policy
## Usando kable com nomes automáticos.
## Executando safe_add_header_above...
## Colunas esperadas pelo header_spec: 8
## Colunas reais na tabela: 7
## AVISO: Incompatibilidade detectada!
## Ajustando header_spec automaticamente...
## Header ajustado: = 2, Resiliência Média = 3, Políticas Médias = 2
## Executando safe_kable...
## Dimensões dos dados: 3 7
## Nomes das colunas: cluster, n_countries, avg_read_resilience, avg_scie_resilience, avg_phone_ban, avg_collaboration, avg_monitoring
## Col.names especificados: 8
## AVISO: Incompatibilidade detectada!
## Colunas nos dados: 7
## Col.names especificados: 8
## Usando nomes de colunas automáticos...
## add_header_above aplicado com sucesso.
## Análise de clusters concluída com sucesso.13 Interpretação e Discussão por País
13.1 Análise das Especificidades de Cada País
# Função para gerar interpretação por país
generate_country_interpretation <- function(country_code) {
country_data <- pisa_data %>% filter(CNT == country_code)
country_info <- country_patterns %>% filter(CNT == country_code)
if(nrow(country_data) == 0) return(NULL)
country_name <- country_info$country_name
# Estatísticas básicas
n_students <- nrow(country_data)
math_resilience <- round(country_info$math_resilient * 100, 1)
read_resilience <- round(country_info$read_resilient * 100, 1)
scie_resilience <- round(country_info$scie_resilient * 100, 1)
# Políticas mais adotadas
policies <- c(
"Proibir celular" = country_info$high_phone_ban,
"Proibir notebook" = country_info$high_laptop_ban,
"Colaboração" = country_info$high_collaboration,
"Filtros sociais" = country_info$high_social_filters,
"Filtros jogos" = country_info$high_game_filters,
"Monitoramento" = country_info$high_monitoring
)
top_policies <- names(sort(policies, decreasing = TRUE))[1:3]
# Ranking regional
country_rank <- country_resilience %>%
arrange(desc(math_resilient)) %>%
mutate(rank = row_number()) %>%
filter(CNT == country_code) %>%
pull(rank)
return(list(
name = country_name,
n = n_students,
math_res = math_resilience,
read_res = read_resilience,
scie_res = scie_resilience,
top_policies = top_policies,
rank = country_rank
))
}
# Gerar interpretações para os principais países
main_countries <- country_patterns %>%
arrange(desc(n)) %>%
head(6) %>%
pull(CNT)
country_interpretations <- list()
for(country in main_countries) {
interpretation <- generate_country_interpretation(country)
if(!is.null(interpretation)) {
country_interpretations[[country]] <- interpretation
}
}
# Apresentar interpretações
if(length(country_interpretations) > 0) {
cat("## Perfis Detalhados por País\n\n")
for(country_code in names(country_interpretations)) {
info <- country_interpretations[[country_code]]
cat("### ", info$name, "\n\n")
cat("**Amostra:** ", info$n, " estudantes\n\n")
cat("**Ranking Regional:** ", info$rank, "º lugar em matemática\n\n")
cat("**Resiliência Acadêmica:**\n")
cat("- Matemática: ", info$math_res, "%\n")
cat("- Leitura: ", info$read_res, "%\n")
cat("- Ciências: ", info$scie_res, "%\n\n")
cat("**Políticas Mais Adotadas:**\n")
for(i in 1:3) {
cat("- ", info$top_policies[i], "\n")
}
cat("\n")
# Análise contextual
if(info$math_res > 30) {
cat("**Análise:** País com alta resiliência acadêmica, indicando políticas efetivas.\n\n")
} else if(info$math_res > 20) {
cat("**Análise:** País com resiliência moderada, com potencial para melhorias.\n\n")
} else {
cat("**Análise:** País com baixa resiliência, necessitando revisão das políticas atuais.\n\n")
}
cat("---\n\n")
}
}## ## Perfis Detalhados por País
##
## ### Argentina
##
## **Amostra:** 2930 estudantes
##
## **Ranking Regional:** 8 º lugar em matemática
##
## **Resiliência Acadêmica:**
## - Matemática: 7.8 %
## - Leitura: 8.5 %
## - Ciências: 9.1 %
##
## **Políticas Mais Adotadas:**
## - Colaboração
## - Monitoramento
## - Filtros jogos
##
## **Análise:** País com baixa resiliência, necessitando revisão das políticas atuais.
##
## ---
##
## ### Brasil
##
## **Amostra:** 2584 estudantes
##
## **Ranking Regional:** 6 º lugar em matemática
##
## **Resiliência Acadêmica:**
## - Matemática: 8.8 %
## - Leitura: 10.3 %
## - Ciências: 9.2 %
##
## **Políticas Mais Adotadas:**
## - Colaboração
## - Filtros jogos
## - Monitoramento
##
## **Análise:** País com baixa resiliência, necessitando revisão das políticas atuais.
##
## ---
##
## ### Colombia
##
## **Amostra:** 1865 estudantes
##
## **Ranking Regional:** 9 º lugar em matemática
##
## **Resiliência Acadêmica:**
## - Matemática: 7.8 %
## - Leitura: 7 %
## - Ciências: 8.2 %
##
## **Políticas Mais Adotadas:**
## - NA
## - NA
## - NA
##
## **Análise:** País com baixa resiliência, necessitando revisão das políticas atuais.
##
## ---
##
## ### Peru
##
## **Amostra:** 1731 estudantes
##
## **Ranking Regional:** 11 º lugar em matemática
##
## **Resiliência Acadêmica:**
## - Matemática: 6.5 %
## - Leitura: 5.9 %
## - Ciências: 6.4 %
##
## **Políticas Mais Adotadas:**
## - NA
## - NA
## - NA
##
## **Análise:** País com baixa resiliência, necessitando revisão das políticas atuais.
##
## ---
##
## ### DOM
##
## **Amostra:** 1684 estudantes
##
## **Ranking Regional:** 1 º lugar em matemática
##
## **Resiliência Acadêmica:**
## - Matemática: 11.4 %
## - Leitura: 10.6 %
## - Ciências: 11.3 %
##
## **Políticas Mais Adotadas:**
## - Colaboração
## - Monitoramento
## - Filtros jogos
##
## **Análise:** País com baixa resiliência, necessitando revisão das políticas atuais.
##
## ---
##
## ### Uruguay
##
## **Amostra:** 1627 estudantes
##
## **Ranking Regional:** 5 º lugar em matemática
##
## **Resiliência Acadêmica:**
## - Matemática: 10.1 %
## - Leitura: 11.2 %
## - Ciências: 10.8 %
##
## **Políticas Mais Adotadas:**
## - Colaboração
## - Monitoramento
## - Filtros jogos
##
## **Análise:** País com baixa resiliência, necessitando revisão das políticas atuais.
##
## ---13.2 Recomendações Específicas por País
# Função para gerar recomendações baseadas no perfil do país
generate_recommendations <- function(country_code) {
country_info <- country_patterns %>% filter(CNT == country_code)
if(nrow(country_info) == 0) return(NULL)
recommendations <- c()
# Baseado na resiliência geral
if(country_info$overall_resilience < 0.20) {
recommendations <- c(recommendations,
"Implementar programa abrangente de melhoria da qualidade educacional",
"Revisar e fortalecer políticas de tecnologia educacional")
} else if(country_info$overall_resilience < 0.30) {
recommendations <- c(recommendations,
"Otimizar políticas existentes com foco em resultados",
"Implementar monitoramento contínuo de efetividade")
} else {
recommendations <- c(recommendations,
"Manter e expandir práticas bem-sucedidas",
"Compartilhar experiências com outros países da região")
}
# Baseado nas políticas mais adotadas com verificação de NA
if(!is.na(country_info$high_collaboration) && country_info$high_collaboration > 0.7) {
recommendations <- c(recommendations,
"Aproveitar cultura colaborativa para inovações pedagógicas")
}
if(!is.na(country_info$high_phone_ban) && country_info$high_phone_ban > 0.7) {
recommendations <- c(recommendations,
"Avaliar impacto das restrições tecnológicas no aprendizado")
}
if(!is.na(country_info$high_monitoring) && country_info$high_monitoring > 0.7) {
recommendations <- c(recommendations,
"Balancear monitoramento com autonomia estudantil")
}
return(list(
country = country_info$country_name,
recommendations = recommendations
))
}
# Gerar recomendações para países principais
cat("## Recomendações Específicas por País\n\n")## ## Recomendações Específicas por Paísfor(country_code in main_countries) {
rec <- generate_recommendations(country_code)
if(!is.null(rec)) {
cat("### ", rec$country, "\n\n")
for(i in 1:length(rec$recommendations)) {
cat(i, ". ", rec$recommendations[i], "\n")
}
cat("\n---\n\n")
}
}## ### Argentina
##
## 1 . Implementar programa abrangente de melhoria da qualidade educacional
## 2 . Revisar e fortalecer políticas de tecnologia educacional
##
## ---
##
## ### Brasil
##
## 1 . Implementar programa abrangente de melhoria da qualidade educacional
## 2 . Revisar e fortalecer políticas de tecnologia educacional
##
## ---
##
## ### Colombia
##
## 1 . Implementar programa abrangente de melhoria da qualidade educacional
## 2 . Revisar e fortalecer políticas de tecnologia educacional
##
## ---
##
## ### Peru
##
## 1 . Implementar programa abrangente de melhoria da qualidade educacional
## 2 . Revisar e fortalecer políticas de tecnologia educacional
##
## ---
##
## ### DOM
##
## 1 . Implementar programa abrangente de melhoria da qualidade educacional
## 2 . Revisar e fortalecer políticas de tecnologia educacional
##
## ---
##
## ### Uruguay
##
## 1 . Implementar programa abrangente de melhoria da qualidade educacional
## 2 . Revisar e fortalecer políticas de tecnologia educacional
##
## ---14 Análise de Qualidade dos Modelos
14.1 Curvas ROC
# Filter complete cases for each domain
complete_math <- complete.cases(pisa_data$resil_math)
complete_read <- complete.cases(pisa_data$resil_read)
complete_scie <- complete.cases(pisa_data$resil_scie)
# Initialize prediction columns with NA
pisa_data$pred_math <- NA
pisa_data$pred_read <- NA
pisa_data$pred_scie <- NA
# Generate predictions only for complete cases
pisa_data$pred_math[complete_math] <- predict(model_math, newdata = pisa_data[complete_math, ], type = "response")
pisa_data$pred_read[complete_read] <- predict(model_read, newdata = pisa_data[complete_read, ], type = "response")
pisa_data$pred_scie[complete_scie] <- predict(model_scie, newdata = pisa_data[complete_scie, ], type = "response")
# Helper function for safe ROC plotting
plot_roc_safe <- function(response, prediction, domain_name, color) {
valid_idx <- complete.cases(response, prediction)
response <- response[valid_idx]
prediction <- prediction[valid_idx]
if(length(unique(response)) != 2) {
cat(paste0("AVISO: Variável resposta '", domain_name, "' não tem dois níveis distintos. ROC não será calculada.\n"))
return(NULL)
}
roc_obj <- roc(response, prediction)
plot(roc_obj, main = paste("ROC -", domain_name), col = color, lwd = 2)
text(0.3, 0.2, paste("AUC =", round(auc(roc_obj), 3)), cex = 1.2)
return(roc_obj)
}
# Plot ROC curves
par(mfrow = c(1, 3))
roc_math <- plot_roc_safe(pisa_data$resil_math, pisa_data$pred_math, "Matemática", "blue")
roc_read <- plot_roc_safe(pisa_data$resil_read, pisa_data$pred_read, "Leitura", "green")
roc_scie <- plot_roc_safe(pisa_data$resil_scie, pisa_data$pred_scie, "Ciências", "red")
par(mfrow = c(1, 1))
# Create AUC table
auc_values <- data.frame(
Modelo = c("Matemática", "Leitura", "Ciências"),
AUC = c(
if(!is.null(roc_math)) auc(roc_math) else NA,
if(!is.null(roc_read)) auc(roc_read) else NA,
if(!is.null(roc_scie)) auc(roc_scie) else NA
)
)
safe_kable(auc_values %>%
mutate(across(where(is.numeric), ~ round(.x, 3))),
caption = "Área Sob a Curva (AUC) dos Modelos Gerais") %>%
kable_styling(bootstrap_options = c("striped", "hover"))## Executando safe_kable...
## Dimensões dos dados: 3 2
## Nomes das colunas: Modelo, AUC
## Usando kable com nomes automáticos.| Modelo | AUC |
|---|---|
| Matemática | 0.658 |
| Leitura | 0.677 |
| Ciências | 0.659 |
15 Conclusões e Implicações
15.1 Principais Achados
15.1.1 Variação por País
Heterogeneidade Regional: Observamos variações significativas na resiliência acadêmica entre países da América Latina, indicando que fatores contextuais nacionais desempenham papel importante.
Padrões de Políticas: Diferentes países adotam diferentes combinações de políticas tecnológicas, refletindo prioridades e contextos educacionais específicos.
Efetividade Diferencial: As mesmas políticas podem ter efeitos diferentes dependendo do contexto nacional, sugerindo necessidade de abordagens adaptadas.
15.1.2 Modelos com Interação
Melhoria do Ajuste: Os modelos com termos de interação país × políticas apresentaram melhor ajuste estatístico, confirmando a importância de considerar diferenças contextuais.
Complexidade dos Efeitos: Os efeitos das políticas tecnológicas não são uniformes across países, requerendo análises mais nuançadas.
15.1.3 Clusters de Países
Agrupamentos Naturais: A análise de clusters revelou agrupamentos naturais de países com perfis similares de resiliência e políticas.
Estratégias Diferenciadas: Cada cluster requer estratégias diferenciadas de implementação de políticas tecnológicas.
15.2 Implicações para Políticas Públicas
15.2.1 Nível Regional
- Cooperação Técnica: Estabelecer mecanismos de cooperação entre países com perfis similares
- Benchmarking: Utilizar países de alta performance como referência para boas práticas
- Adaptação Contextual: Reconhecer que políticas efetivas em um país podem necessitar adaptação em outros
15.2.2 Nível Nacional
- Diagnóstico Específico: Cada país deve realizar diagnóstico específico de suas necessidades
- Implementação Gradual: Considerar implementação gradual e monitoramento contínuo
- Avaliação de Impacto: Estabelecer sistemas de avaliação de impacto das políticas implementadas
15.3 Limitações e Pesquisas Futuras
15.3.1 Limitações
- Causalidade: Os modelos apresentados estabelecem associações, não relações causais
- Variáveis Omitidas: Outros fatores contextuais podem influenciar os resultados
- Temporalidade: Análise transversal não captura mudanças ao longo do tempo
15.3.2 Pesquisas Futuras
- Estudos Longitudinais: Acompanhar evolução das políticas e seus impactos ao longo do tempo
- Análises Qualitativas: Complementar com estudos qualitativos sobre implementação de políticas
- Fatores Contextuais: Investigar fatores socioeconômicos e culturais que mediam os efeitos das políticas
Data de Geração: 2025-08-22
Versão: Análise Expandida com Foco em Diferenças por
País
Fonte: PISA 2022 - América Latina