Curso: Doutorado Profissional em Economia
Disciplina: Introdução à Estatística e
Econometria
Professor: Alexandre Xavier Ywata de Carvalho
Tema: Lista 3 - Modelos de Regressão Linear
Múltipla
Esta atividade apresenta a aplicação de modelos de regressão linear múltipla para diferentes bases de dados, com o objetivo de ilustrar especificação, estimação, avaliação de ajuste e interpretação econômica dos coeficientes.
Na primeira parte, analisamos modelos de regressão para vendas de automóveis, comparando diferentes especificações e aplicando a técnica de best subset selection.
Em seguida, analisa-se a mortalidade infantil em municípios brasileiros, incluindo variáveis socioeconômicas e demográficas.
Por fim, analisa-se a expectativa de vida por país com dados da Organização Mundial da Saúde (OMS), estimando-se modelos com termos de interação e intervalos de confiança.
# Carregar dados de vendas dos automóveis
Car_sales <- read.csv("Car_sales.csv", header = TRUE, sep = ",",
encoding = "UTF-8", stringsAsFactors = FALSE)
# Vetor de descrições
desc_labels <- c(
Manufacturer = "Fabricante do veículo",
Model = "Modelo do veículo",
Sales_in_thousands = "Vendas anuais (em milhares de unidades)",
X__year_resale_value = "Valor de revenda após 3 anos (US\\$)",
Vehicle_type = "Tipo de veículo (Passenger / Car)",
Price_in_thousands = "Preço de venda (US\\$ milhares)",
Latest_Launch = "Data do último lançamento",
Engine_size = "Tamanho do motor",
Horsepower = "Potência (HP)",
Wheelbase = "Entre-eixos",
Width = "Largura",
Length = "Comprimento",
Curb_weight = "Peso em ordem de marcha",
Fuel_capacity = "Capacidade do tanque",
Fuel_efficiency = "Eficiência do combustível",
Power_perf_factor = "Índice de desempenho do veículo"
)
desc_car_sales <- data.frame(
Variavel = names(Car_sales),
Descricao = unname(desc_labels[names(Car_sales)]),
row.names = NULL,
stringsAsFactors = FALSE
)
kable(
desc_car_sales,
caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 1: Descrição das Variáveis - Vendas de Automóveis</p>"
) |>
kable_styling(
bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
position = "center"
) |>
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")| Variavel | Descricao |
|---|---|
| Manufacturer | Fabricante do veículo |
| Model | Modelo do veículo |
| Sales_in_thousands | Vendas anuais (em milhares de unidades) |
| X__year_resale_value | Valor de revenda após 3 anos (US$) |
| Vehicle_type | Tipo de veículo (Passenger / Car) |
| Price_in_thousands | Preço de venda (US$ milhares) |
| Engine_size | Tamanho do motor |
| Horsepower | Potência (HP) |
| Wheelbase | Entre-eixos |
| Width | Largura |
| Length | Comprimento |
| Curb_weight | Peso em ordem de marcha |
| Fuel_capacity | Capacidade do tanque |
| Fuel_efficiency | Eficiência do combustível |
| Latest_Launch | Data do último lançamento |
| Power_perf_factor | Índice de desempenho do veículo |
# Tratamento: Remoção de NA para garantir comparabilidade nos modelos
Car_sales_clean <- na.omit(Car_sales)
# Rodar os seis modelos de regressão
modelo1 <- lm(Sales_in_thousands ~ Price_in_thousands, data = Car_sales_clean)
modelo2 <- lm(Sales_in_thousands ~ Price_in_thousands + Engine_size, data = Car_sales_clean)
modelo3 <- lm(Sales_in_thousands ~ Price_in_thousands + Engine_size + Horsepower + Fuel_efficiency, data = Car_sales_clean)
modelo4 <- lm(Sales_in_thousands ~ Price_in_thousands + Engine_size + Horsepower + Curb_weight + I(Price_in_thousands^2), data = Car_sales_clean)
modelo5 <- lm(Sales_in_thousands ~ Price_in_thousands + Engine_size + Horsepower + Curb_weight + I(Price_in_thousands^2) + as.factor(Vehicle_type), data = Car_sales_clean)
modelo6 <- lm(Sales_in_thousands ~ Price_in_thousands + Engine_size + Horsepower + Curb_weight + I(Price_in_thousands^2) + as.factor(Vehicle_type) + as.factor(Manufacturer), data = Car_sales_clean)
# Coletar R² e R² ajustado
r_squared <- c(summary(modelo1)$r.squared, summary(modelo2)$r.squared,
summary(modelo3)$r.squared, summary(modelo4)$r.squared,
summary(modelo5)$r.squared, summary(modelo6)$r.squared)
adj_r_squared <- c(summary(modelo1)$adj.r.squared, summary(modelo2)$adj.r.squared,
summary(modelo3)$adj.r.squared, summary(modelo4)$adj.r.squared,
summary(modelo5)$adj.r.squared, summary(modelo6)$adj.r.squared)
resultados <- data.frame(
Modelo = 1:6,
R2 = round(r_squared, 4),
R2_Ajustado = round(adj_r_squared, 4)
)
kable(resultados, caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 2: Comparação dos Modelos de Regressão</p>") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50") %>%
row_spec(which.max(resultados$R2_Ajustado), bold = TRUE, background = "#d2d5d6")| Modelo | R2 | R2_Ajustado |
|---|---|---|
| 1 | 0.0634 | 0.0552 |
| 2 | 0.1335 | 0.1183 |
| 3 | 0.1541 | 0.1238 |
| 4 | 0.1747 | 0.1375 |
| 5 | 0.1895 | 0.1453 |
| 6 | 0.4522 | 0.2524 |
# (a) Escolha do modelo baseado nos critérios
modelo_escolhido <- which.max(adj_r_squared)
# (b) Identifica a situação onde R² aumenta mas R² ajustado diminui
situacao_b <- data.frame()
for(i in 2:6) {
if(r_squared[i] > r_squared[i-1] & adj_r_squared[i] < adj_r_squared[i-1]) {
situacao_b <- rbind(situacao_b, data.frame(
Modelo_Atual = i,
Modelo_Anterior = i-1,
R2_Aumentou = round(r_squared[i] - r_squared[i-1], 4),
R2A_Diminuiu = round(adj_r_squared[i] - adj_r_squared[i-1], 4)
))
}
}
# (c) Best subset selection com variáveis artificiais
dados_bs <- Car_sales_clean %>%
select(-Manufacturer, -Model, -Latest_Launch) %>%
mutate(Vehicle_type_Passenger = ifelse(Vehicle_type == "Passenger", 1, 0)) %>%
select(-Vehicle_type)
# Adicionando potências
dados_bs$Price2 <- dados_bs$Price_in_thousands^2
dados_bs$Price3 <- dados_bs$Price_in_thousands^3
dados_bs$Price4 <- dados_bs$Price_in_thousands^4
# Executando regsubsets
invisible(capture.output({
best_subset <- regsubsets(Sales_in_thousands ~ ., data = dados_bs, nvmax = 15)
}))
sum_bs <- summary(best_subset)
# (d) Melhor modelo encontrado
melhor_n <- which.max(sum_bs$adjr2)
vars_selecionadas <- names(coef(best_subset, melhor_n))[-1]
# Tabela de respostas
respostas_q1 <- data.frame(
Item = c("(a)", "(b)", "(c)", "(d)"),
Pergunta = c(
"Modelo escolhido pelos critérios",
"Situação R² aumenta e R² ajustado diminui",
"Aplicação best subset selection",
"Melhor modelo encontrado"
),
Resposta = c(
paste("Modelo", modelo_escolhido, "(maior R² Ajustado)"),
ifelse(nrow(situacao_b) > 0,
paste("Sim, entre modelos", situacao_b$Modelo_Anterior[1], "e", situacao_b$Modelo_Atual[1]),
"Não identificado"),
"Técnica aplicada com sucesso",
paste("Modelo com", length(vars_selecionadas), "variáveis (R² Adj =", round(max(sum_bs$adjr2), 4), ")")
)
)
kable(respostas_q1, caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 3: Respostas da Questão 1</p>") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")| Item | Pergunta | Resposta |
|---|---|---|
|
|
Modelo escolhido pelos critérios | Modelo 6 (maior R² Ajustado) |
|
|
Situação R² aumenta e R² ajustado diminui | Não identificado |
|
|
Aplicação best subset selection | Técnica aplicada com sucesso |
|
|
Melhor modelo encontrado | Modelo com 5 variáveis (R² Adj = 0.3108 ) |
Disclaimer
Embora o enunciado sugira utilizar todas as colunas, optou-se por excluir as variáveis Manufacturer, Model e Latest_Launch do procedimento de best subset selection, devido ao elevado número de categorias (que geraria um número muito grande de dummies) e ao caráter mais ilustrativo do exercício. As demais colunas numéricas relevantes e as variáveis artificiais de preço até a quarta potência foram incluídas.Caso todas as colunas fossem incluídas, o número de dummies tornaria a estimação pouco parcimoniosa.
Melhor R²: Modelo 6
Melhor R² Ajustado: Modelo 6
(a) Escolha do modelo: Eu escolheria o Modelo 6, pois maximiza o R² ajustado, equilibrando qualidade do ajuste e parcimônia.
(b) Anomalia R² vs R² Ajustado: Com base nos resultados apresentados na Tabela 3, não foi identificado nenhum caso em que o R² aumente enquanto o R² ajustado diminua na sequência de modelos testados.
(c) Best Subset Selection: A técnica foi aplicada com sucesso, considerando termos lineares e polinomiais até a quarta ordem.
(d) Melhor Modelo pelo Best Subset:
Variáveis selecionadas: Engine_size, Horsepower, Wheelbase, Curb_weight, Price2
# Carregar dados dos municípios
dados1 <- read.csv2("IDH_Brasil_2010.csv", header = TRUE, sep = ";", dec = ",",
encoding = "latin1", stringsAsFactors = FALSE)
empresas <- read.csv2("CADASTRO_EMPRESAS_2008.csv", header = TRUE, sep = ";", dec = ".",
encoding = "latin1", stringsAsFactors = FALSE)
fiscal <- read.csv2("financas_publicas_2008.csv", header = TRUE, sep = ";", dec = ".",
encoding = "latin1", stringsAsFactors = FALSE)
dados2 <- merge(x = dados1, y = empresas, by.x = "codmun", by.y = "codmun", all.x = TRUE)
dados3 <- merge(x = dados2, y = fiscal, by.x = "codmun", by.y = "cod_mun", all.x = TRUE)
# Estatísticas descritivas da variável resposta
stats_mortalidade <- data.frame(
Estatística = c("Média", "Desvio Padrão", "Mínimo", "Máximo"),
Valor = c(
round(mean(dados3$mort_infantil, na.rm = TRUE), 2),
round(sd(dados3$mort_infantil, na.rm = TRUE), 2),
round(min(dados3$mort_infantil, na.rm = TRUE), 2),
round(max(dados3$mort_infantil, na.rm = TRUE), 2)
)
)
kable(stats_mortalidade, caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 4: Estatísticas Descritivas - Mortalidade Infantil</p>") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")| Estatística | Valor |
|---|---|
| Média | 19.25 |
| Desvio Padrão | 7.14 |
| Mínimo | 8.49 |
| Máximo | 46.80 |
# Modelo inicial
mod1.ex <- lm(mort_infantil ~ renda_per_capita + indice_gini + salario_medio_mensal +
perc_criancas_extrem_pobres + perc_criancas_pobres +
perc_pessoas_dom_agua_estogo_inadequados +
perc_pessoas_dom_paredes_inadequadas +
perc_pop_dom_com_coleta_lixo, data = dados3)
summary_mod1 <- summary(mod1.ex)
# Extração de resultados
coefs_idh <- summary(mod1.ex)$coefficients
df_res_idh <- data.frame(
Variável = rownames(coefs_idh),
Estimativa = round(coefs_idh[,1], 4),
Erro_Padrão = round(coefs_idh[,2], 4),
Valor_t = round(coefs_idh[,3], 4),
P_Valor = round(coefs_idh[,4], 4),
Significância = ifelse(coefs_idh[,4] < 0.01, "***",
ifelse(coefs_idh[,4] < 0.05, "**",
ifelse(coefs_idh[,4] < 0.1, "*", "")))
)
kable(df_res_idh, caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 5: Coeficientes do Modelo de Mortalidade Infantil</p>") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")| Variável | Estimativa | Erro_Padrão | Valor_t | P_Valor | Significância | |
|---|---|---|---|---|---|---|
| (Intercept) | (Intercept) | 19.3648 | 0.8196 | 23.6267 | 0.0000 | *** |
| renda_per_capita | renda_per_capita | -0.0013 | 0.0006 | -2.2091 | 0.0272 | ** |
| indice_gini | indice_gini | -14.2977 | 1.2465 | -11.4698 | 0.0000 | *** |
| salario_medio_mensal | salario_medio_mensal | -0.1775 | 0.0951 | -1.8658 | 0.0621 |
|
| perc_criancas_extrem_pobres | perc_criancas_extrem_pobres | 0.0385 | 0.0122 | 3.1690 | 0.0015 | *** |
| perc_criancas_pobres | perc_criancas_pobres | 0.2159 | 0.0115 | 18.8116 | 0.0000 | *** |
| perc_pessoas_dom_agua_estogo_inadequados | perc_pessoas_dom_agua_estogo_inadequados | 0.0506 | 0.0060 | 8.3966 | 0.0000 | *** |
| perc_pessoas_dom_paredes_inadequadas | perc_pessoas_dom_paredes_inadequadas | 0.0430 | 0.0079 | 5.4227 | 0.0000 | *** |
| perc_pop_dom_com_coleta_lixo | perc_pop_dom_com_coleta_lixo | -0.0070 | 0.0065 | -1.0805 | 0.2800 |
Do ponto de vista dos sinais, os resultados empíricos podem ser resumidos da seguinte forma. A variável renda_per_capita apresenta coeficiente negativo (-0.0013), em linha com o esperado teoricamente, indicando que municípios mais ricos tendem a registrar menor mortalidade infantil, ceteris paribus. As variáveis de vulnerabilidade, como perc_criancas_extrem_pobres e perc_criancas_pobres, apresentam coeficientes positivos, sugerindo que maior incidência de pobreza infantil está associada a maior mortalidade. Os indicadores de inadequação de moradia e saneamento (perc_pessoas_dom_agua_estogo_inadequados e perc_pessoas_dom_paredes_inadequadas) exibem coeficientes positivos, apontando piores condições de habitação como fator de risco adicional para a mortalidade infantil. Por fim, a variável perc_pop_dom_com_coleta_lixo apresenta coeficiente negativo (-0.007), em linha com o esperado teoricamente. Em termos substantivos, isso significa que maior cobertura de coleta de lixo tende a reduzir a mortalidade infantil, o que é coerente com a ideia de que melhor infraestrutura urbana e de limpeza pública melhora as condições sanitárias.
| Métrica | Modelo_Base | Modelo_Rural | Variação |
|---|---|---|---|
| R² | 0.6804 | 0.6941 | +1.37% |
| R² Ajustado | 0.6799 | 0.6936 | +1.37% |
| Item | Descrição | Resposta |
|---|---|---|
| i | Variável dependente e explicativas | Variável Dependente: mort_infantil; Variáveis Explicativas: renda_per_capita, indice_gini, salario_medio_mensal, perc_criancas_extrem_pobres, perc_criancas_pobres, perc_pessoas_dom_agua_estogo_inadequados, perc_pessoas_dom_paredes_inadequadas, perc_pop_dom_com_coleta_lixo |
| ii - 5% | Variáveis significativas a 5% | (Intercept), renda_per_capita, indice_gini, perc_criancas_extrem_pobres, perc_criancas_pobres, perc_pessoas_dom_agua_estogo_inadequados, perc_pessoas_dom_paredes_inadequadas |
| ii - 1% | Variáveis significativas a 1% | (Intercept), indice_gini, perc_criancas_extrem_pobres, perc_criancas_pobres, perc_pessoas_dom_agua_estogo_inadequados, perc_pessoas_dom_paredes_inadequadas |
| iii | Percentual variabilidade explicada | 68.04 % |
| iv | Efeito zona rural sobre mortalidade | Coeficiente: -4.6229 (p-valor = 0); aumento de 10 p.p. em perc_pop_rural ⇒ -0.46 pontos na taxa de mortalidade infantil. |
| v | Variação R² e R² Ajustado | Ver Tabela 6 acima |
| vi | Tipo de dados | Cross-section (dados transversais) |
No modelo ampliado com a variável perc_pop_rural, o coeficiente estimado para essa variável é de -4.6229. Isso significa que, mantidas constantes as demais covariáveis, um aumento de 0,10 (10 pontos percentuais) na participação da população rural está associado, em média, a uma redução de aproximadamente 0.46 pontos na taxa de mortalidade infantil. O respectivo p-valor é p < 0,0001, de forma que o coeficiente é estatisticamente significante ao nível de aproximadamente 1%.
# Carregar dados do vinho
wine_df <- read.csv("wine_data.csv", stringsAsFactors = FALSE)
# Estatísticas descritivas
stats_wine <- describe(wine_df[, c("Price", "AGST", "HarvestRain", "WinterRain", "Year")])
stats_wine <- round(stats_wine[, c("n", "mean", "sd", "min", "max")], 3)
kable(stats_wine, caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 8: Estatísticas Descritivas - Dados do Vinho</p>") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")| n | mean | sd | min | max | |
|---|---|---|---|---|---|
| Price | 27 | 7.042 | 0.635 | 6.205 | 8.494 |
| AGST | 27 | 16.478 | 0.659 | 14.983 | 17.650 |
| HarvestRain | 27 | 144.815 | 73.066 | 38.000 | 292.000 |
| WinterRain | 27 | 608.407 | 129.035 | 376.000 | 830.000 |
| Year | 27 | 1966.815 | 8.246 | 1952.000 | 1980.000 |
# Best Subset com termos quadráticos
reg_wine_full <- lm(Price ~ AGST + HarvestRain + WinterRain + Year +
I(AGST^2) + I(HarvestRain^2) + I(WinterRain^2) + I(Year^2),
data = wine_df)
bs_wine <- regsubsets(formula(reg_wine_full), data = wine_df, nvmax = 8)
sum_bs_wine <- summary(bs_wine)
# Encontrar melhor modelo
id_best_wine <- which.max(sum_bs_wine$adjr2)
vars_wine <- names(coef(bs_wine, id_best_wine))[-1]
# Modelos para comparação
mod_wine_inicial <- lm(Price ~ AGST + HarvestRain + WinterRain, data = wine_df)
mod_wine_final <- lm(as.formula(paste("Price ~", paste(vars_wine, collapse = "+"))), data = wine_df)
# Comparação dos modelos
comparacao_wine <- data.frame(
Modelo = c("Inicial (3 variáveis)", "Final (Best Subset)"),
R2 = c(round(summary(mod_wine_inicial)$r.squared, 4),
round(summary(mod_wine_final)$r.squared, 4)),
R2_Ajustado = c(round(summary(mod_wine_inicial)$adj.r.squared, 4),
round(summary(mod_wine_final)$adj.r.squared, 4)),
Melhoria = c("-",
paste0("+", round((summary(mod_wine_final)$adj.r.squared - summary(mod_wine_inicial)$adj.r.squared) * 100, 2), "%"))
)
kable(comparacao_wine, caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 9: Comparação dos Modelos de Preço do Vinho</p>") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50") %>%
row_spec(2, bold = TRUE, background = "#d2d5d6")| Modelo | R2 | R2_Ajustado | Melhoria |
|---|---|---|---|
| Inicial (3 variáveis) | 0.7407 | 0.7069 |
|
| Final (Best Subset) | 0.8861 | 0.8519 | +14.5% |
respostas_q3 <- data.frame(
Item = c("(a)", "(b) - R²", "(b) - R² Ajustado", "(c)"),
Descrição = c(
"Melhor modelo pelo best subset",
"R² do modelo final",
"R² ajustado do modelo final",
"Comparação com modelo inicial"
),
Resposta = c(
paste("Modelo com", length(vars_wine), "variáveis selecionadas"),
paste(round(summary(mod_wine_final)$r.squared, 4)),
paste(round(summary(mod_wine_final)$adj.r.squared, 4)),
paste("Melhoria de", round((summary(mod_wine_final)$adj.r.squared - summary(mod_wine_inicial)$adj.r.squared) * 100, 2), "% no R² ajustado")
)
)
kable(respostas_q3, caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 10: Respostas da Questão 3</p>") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")| Item | Descrição | Resposta |
|---|---|---|
|
|
Melhor modelo pelo best subset | Modelo com 6 variáveis selecionadas |
|
R² do modelo final | 0.8861 |
|
R² ajustado do modelo final | 0.8519 |
|
|
Comparação com modelo inicial | Melhoria de 14.5 % no R² ajustado |
AGST, HarvestRain, WinterRain, I(AGST^2), I(WinterRain^2), I(Year^2)
Comparando o modelo inicial, com três variáveis explicativas (AGST, HarvestRain e WinterRain), com o modelo selecionado pelo procedimento de best subset selection, observa-se um aumento de aproximadamente 14.5 % no R² ajustado. Esse ganho pode ser considerado expressivo em termos de capacidade explicativa. Do ponto de vista da parcimônia, a adoção do modelo mais complexo só se justifica se o objetivo for maximizar o poder preditivo, aceitando-se o custo de trabalhar com um número maior de regressores e termos quadráticos.
# Modelo com variável da região
mod2.ex <- lm(mort_infantil ~ renda_per_capita + indice_gini + salario_medio_mensal +
perc_criancas_extrem_pobres + perc_criancas_pobres +
perc_pessoas_dom_agua_estogo_inadequados +
perc_pessoas_dom_paredes_inadequadas +
perc_pop_dom_com_coleta_lixo + perc_pop_rural +
as.factor(Regiao), data = dados3)
# Extraindo coeficientes das regiões
coefs_reg <- summary(mod2.ex)$coefficients
# Linhas que contêm os termos de região (as.factor(Regiao) ...)
linhas_regiao <- grep("as.factor\\(Regiao\\)", rownames(coefs_reg))
# Tabela com coeficientes das regiões
tabela_regiao <- data.frame(
Regiao = gsub("as.factor\\(Regiao\\)", "", rownames(coefs_reg)[linhas_regiao]),
Coeficiente = round(coefs_reg[linhas_regiao, 1], 4),
Erro_Padrao = round(coefs_reg[linhas_regiao, 2], 4),
Valor_t = round(coefs_reg[linhas_regiao, 3], 4),
P_Valor = round(coefs_reg[linhas_regiao, 4], 4),
row.names = NULL
)
# Normalizar nomes
tabela_regiao$Regiao <- trimws(tabela_regiao$Regiao)
# Extrair coeficientes por nome da região (Norte, Nordeste, Sudeste, Sul)
coef_nordeste <- tabela_regiao$Coeficiente[tabela_regiao$Regiao == "Nordeste"]
p_nordeste <- tabela_regiao$P_Valor[tabela_regiao$Regiao == "Nordeste"]
coef_norte <- tabela_regiao$Coeficiente[tabela_regiao$Regiao == "Norte"]
p_norte <- tabela_regiao$P_Valor[tabela_regiao$Regiao == "Norte"]
coef_sudeste <- tabela_regiao$Coeficiente[tabela_regiao$Regiao == "Sudeste"]
p_sudeste <- tabela_regiao$P_Valor[tabela_regiao$Regiao == "Sudeste"]
coef_sul <- tabela_regiao$Coeficiente[tabela_regiao$Regiao == "Sul"]
p_sul <- tabela_regiao$P_Valor[tabela_regiao$Regiao == "Sul"]
# Exibir tabela com os efeitos regionais
kable(
tabela_regiao,
caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 11: Efeito Fixo das Regiões (Base: Centro-Oeste)</p>"
) |>
kable_styling(
bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
position = "center"
) |>
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")| Regiao | Coeficiente | Erro_Padrao | Valor_t | P_Valor |
|---|---|---|---|---|
| Nordeste | 5.9276 | 0.2356 | 25.1562 | 0.0000 |
| Norte | 1.2493 | 0.2649 | 4.7162 | 0.0000 |
| Sudeste | -0.3185 | 0.1899 | -1.6771 | 0.0936 |
| Sul | -1.9476 | 0.2062 | -9.4458 | 0.0000 |
Com base nos resultados da Tabela 11, observamos que:
Estes valores representam a diferença na taxa de mortalidade infantil de cada região em comparação à região base (Centro-Oeste), mantendo constantes todas as demais variáveis do modelo. Coeficientes positivos indicam mortalidade maior que no Centro-Oeste, enquanto coeficientes negativos indicam mortalidade menor.
# Carregar base de dados de expectativa de vida
exp_vida <- read.csv("Life Expectancy WHO.csv", stringsAsFactors = FALSE,
na.strings = c("", "NA"))
# Estatísticas descritivas da variável resposta
stats_exp_vida <- data.frame(
Estatística = c("Média", "Desvio Padrão", "Mínimo", "Máximo"),
Valor = c(
round(mean(exp_vida$Life_expectancy, na.rm = TRUE), 2),
round(sd(exp_vida$Life_expectancy, na.rm = TRUE), 2),
round(min(exp_vida$Life_expectancy, na.rm = TRUE), 2),
round(max(exp_vida$Life_expectancy, na.rm = TRUE), 2)
)
)
kable(stats_exp_vida, caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 12: Estatísticas Descritivas - Expectativa de Vida</p>") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")| Estatística | Valor |
|---|---|
| Média | 69.22 |
| Desvio Padrão | 9.52 |
| Mínimo | 36.30 |
| Máximo | 89.00 |
# Modelo Completo
mod_who <- lm(Life_expectancy ~ Adult_Mortality + infant_deaths + Alcohol +
percentage_expenditure + Hepatitis_B + under_five_deaths +
Polio + Measles + BMI + Diphtheria + GDP +
thinness_1_19_years + thinness_5_9_years + Total_expenditure +
HIV_AIDS + Population + Income_composition_of_resources +
Schooling + as.factor(Year) + as.factor(Status),
data = exp_vida)
# Função para calcular IC escalado
calc_ic_delta <- function(modelo, var_name, delta, descricao) {
beta <- coef(modelo)[var_name]
se <- summary(modelo)$coefficients[var_name, 2]
# Calcula cada intervalo
ci_90 <- confint(modelo, parm = var_name, level = 0.90)
ci_95 <- confint(modelo, parm = var_name, level = 0.95)
ci_99 <- confint(modelo, parm = var_name, level = 0.99)
data.frame(
Variável = descricao,
Mudança = paste("+", delta),
Coeficiente = round(beta, 4),
Impacto_Medio = round(beta * delta, 2),
IC_90 = paste0("[", round(ci_90[1] * delta, 2), "; ", round(ci_90[2] * delta, 2), "]"),
IC_95 = paste0("[", round(ci_95[1] * delta, 2), "; ", round(ci_95[2] * delta, 2), "]"),
IC_99 = paste0("[", round(ci_99[1] * delta, 2), "; ", round(ci_99[2] * delta, 2), "]")
)
}
# Cálculo para os itens solicitados
res_ics <- rbind(
calc_ic_delta(mod_who, "Hepatitis_B", 10, "Cobertura Hepatite B (+10%)"),
calc_ic_delta(mod_who, "Polio", 10, "Cobertura Poliomielite (+10%)"),
calc_ic_delta(mod_who, "Diphtheria", 10, "Cobertura Difteria (+10%)"),
calc_ic_delta(mod_who, "Schooling", 1, "Escolaridade Média (+1 ano)"),
calc_ic_delta(mod_who, "GDP", 100, "PIB per capita (+US$ 100)"),
calc_ic_delta(mod_who, "thinness_5_9_years", 10, "Desnutrição 5-9 anos (+10%)")
)
kable(res_ics, caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 13: Impacto Estimado na Expectativa de Vida (Anos) - Intervalos de Confiança</p>") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")| Variável | Mudança | Coeficiente | Impacto_Medio | IC_90 | IC_95 | IC_99 | |
|---|---|---|---|---|---|---|---|
| Hepatitis_B | Cobertura Hepatite B (+10%) |
|
-0.0035 | -0.04 | [-0.11; 0.04] | [-0.12; 0.05] | [-0.15; 0.08] |
| Polio | Cobertura Poliomielite (+10%) |
|
0.0059 | 0.06 | [-0.03; 0.14] | [-0.04; 0.16] | [-0.07; 0.19] |
| Diphtheria | Cobertura Difteria (+10%) |
|
0.0143 | 0.14 | [0.05; 0.24] | [0.03; 0.26] | [-0.01; 0.3] |
| Schooling | Escolaridade Média (+1 ano) |
|
0.8941 | 0.89 | [0.8; 0.99] | [0.78; 1.01] | [0.74; 1.05] |
| GDP | PIB per capita (+US$ 100) |
|
0.0000 | 0.00 | [0; 0.01] | [0; 0.01] | [0; 0.01] |
| thinness_5_9_years | Desnutrição 5-9 anos (+10%) |
|
-0.0515 | -0.52 | [-1.37; 0.34] | [-1.54; 0.51] | [-1.86; 0.83] |
Com base no modelo estimado para a expectativa de vida, os impactos marginais das variáveis de interesse podem ser interpretados da seguinte forma:
Para a variável cobertura vacinal de Hepatite B, um incremento de 10 pontos percentuais está associado, em média, a uma redução de aproximadamente -0.04 anos na expectativa de vida. O intervalo de confiança de 95% para esse impacto vai de -0.12 a 0.05 anos, com intervalo de confiança de 95% que inclui zero, indicando incerteza estatística e necessidade de cautela na interpretação.
Para a variável cobertura vacinal de Poliomielite, um incremento de 10 pontos percentuais está associado, em média, a uma elevação de aproximadamente 0.06 anos na expectativa de vida. O intervalo de confiança de 95% para esse impacto vai de -0.04 a 0.16 anos, com intervalo de confiança de 95% que inclui zero, indicando incerteza estatística e necessidade de cautela na interpretação.
Para a variável cobertura vacinal de Difteria, um incremento de 10 pontos percentuais está associado, em média, a uma elevação de aproximadamente 0.14 anos na expectativa de vida. O intervalo de confiança de 95% para esse impacto vai de 0.03 a 0.26 anos, com intervalo de confiança de 95% totalmente afastado de zero, sugerindo efeito estatisticamente robusto.
Para a variável escolaridade média da população, um incremento de 1 ano está associado, em média, a uma elevação de aproximadamente 0.89 anos na expectativa de vida. O intervalo de confiança de 95% para esse impacto vai de 0.78 a 1.01 anos, com intervalo de confiança de 95% totalmente afastado de zero, sugerindo efeito estatisticamente robusto.
Para a variável PIB per capita, um incremento de 100 US$ está associado, em média, a uma elevação de aproximadamente 0 anos na expectativa de vida. O intervalo de confiança de 95% para esse impacto vai de 0 a 0.01 anos, com intervalo de confiança de 95% que inclui zero, indicando incerteza estatística e necessidade de cautela na interpretação.
Para a variável prevalência de desnutrição em crianças de 5 a 9 anos, um incremento de 10 pontos percentuais está associado, em média, a uma redução de aproximadamente -0.52 anos na expectativa de vida. O intervalo de confiança de 95% para esse impacto vai de -1.54 a 0.51 anos, com intervalo de confiança de 95% que inclui zero, indicando incerteza estatística e necessidade de cautela na interpretação.
# Carregar e preparar os dados
exp_vida <- read.csv("Life Expectancy WHO.csv", stringsAsFactors = FALSE,
na.strings = c("", "NA"))
exp_vida_clean <- na.omit(exp_vida)
# (a) Modelo com interação entre Status e PIB per capita
mod_int_pib <- lm(Life_expectancy ~ Adult_Mortality + infant_deaths +
percentage_expenditure + under_five_deaths +
Polio + BMI + Diphtheria +
thinness_5_9_years + HIV_AIDS +
Income_composition_of_resources + Schooling +
as.factor(Status) + GDP + GDP*as.factor(Status),
data = exp_vida_clean)
# Resumo estatístico do modelo
resumo_pib <- data.frame(
Métrica = c("R²", "R² Ajustado", "F-Statistic", "Observações"),
Valor = c(
round(summary(mod_int_pib)$r.squared, 4),
round(summary(mod_int_pib)$adj.r.squared, 4),
round(summary(mod_int_pib)$fstatistic[1], 2),
nrow(exp_vida_clean)
)
)
kable(resumo_pib, caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 14: Estatísticas do Modelo com Interação PIB × Status</p>") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")| Métrica | Valor |
|---|---|
| R² | 0.8360 |
| R² Ajustado | 0.8346 |
| F-Statistic | 594.9600 |
| Observações | 1649.0000 |
# (b) Extrair coeficientes efetivos do PIB
coef_pib <- coef(mod_int_pib)
# Países desenvolvidos (categoria de referência): apenas coeficiente do GDP
coef_pib_desenvolvido <- coef_pib["GDP"]
# Países em desenvolvimento: GDP + interação
coef_pib_em_desenvolvimento <- coef_pib["GDP"] + coef_pib["as.factor(Status)Developing:GDP"]
# Tabela de resultados para PIB
resultados_pib <- data.frame(
Status = c("Desenvolvido", "Em Desenvolvimento"),
Coeficiente_PIB = c(
round(coef_pib_desenvolvido, 6),
round(coef_pib_em_desenvolvimento, 6)
),
Interpretação = c(
"Efeito marginal do PIB (categoria de referência)",
"Efeito marginal do PIB + efeito da interação"
)
)
kable(resultados_pib, caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 15: Coeficientes Efetivos do PIB per Capita por Status</p>") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")| Status | Coeficiente_PIB | Interpretação |
|---|---|---|
| Desenvolvido | -0.000029 | Efeito marginal do PIB (categoria de referência) |
| Em Desenvolvimento | 0.000059 | Efeito marginal do PIB + efeito da interação |
# (c) Modelo com interação entre Status e cobertura de vacinação para difteria
mod_int_dip <- lm(Life_expectancy ~ Adult_Mortality + infant_deaths +
percentage_expenditure + under_five_deaths +
Polio + BMI + Diphtheria * as.factor(Status) +
thinness_5_9_years + HIV_AIDS +
Income_composition_of_resources + Schooling + GDP,
data = exp_vida_clean)
# Resumo estatístico do modelo
resumo_dip <- data.frame(
Métrica = c("R²", "R² Ajustado", "F-Statistic", "Observações"),
Valor = c(
round(summary(mod_int_dip)$r.squared, 4),
round(summary(mod_int_dip)$adj.r.squared, 4),
round(summary(mod_int_dip)$fstatistic[1], 2),
nrow(exp_vida_clean)
)
)
kable(resumo_dip, caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 16: Estatísticas do Modelo com Interação Difteria × Status</p>") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")| Métrica | Valor |
|---|---|
| R² | 0.8342 |
| R² Ajustado | 0.8328 |
| F-Statistic | 587.4200 |
| Observações | 1649.0000 |
# (d) Extrair coeficientes efetivos da vacinação para difteria
coef_dip <- coef(mod_int_dip)
# Países desenvolvidos (categoria de referência): apenas coeficiente do Diphtheria
coef_dip_desenvolvido <- coef_dip["Diphtheria"]
# Países em desenvolvimento: Diphtheria + interação
coef_dip_em_desenvolvimento <- coef_dip["Diphtheria"] + coef_dip["Diphtheria:as.factor(Status)Developing"]
# Tabela de resultados para Difteria
resultados_dip <- data.frame(
Status = c("Desenvolvido", "Em Desenvolvimento"),
Coeficiente_Difteria = c(
round(coef_dip_desenvolvido, 6),
round(coef_dip_em_desenvolvimento, 6)
),
Interpretação = c(
"Efeito marginal da cobertura vacinal (categoria de referência)",
"Efeito marginal da cobertura vacinal + efeito da interação"
)
)
kable(resultados_dip, caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 17: Coeficientes Efetivos da Cobertura Vacinal para Difteria por Status</p>") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")| Status | Coeficiente_Difteria | Interpretação |
|---|---|---|
| Desenvolvido | 0.022328 | Efeito marginal da cobertura vacinal (categoria de referência) |
| Em Desenvolvimento | 0.010779 | Efeito marginal da cobertura vacinal + efeito da interação |
# Criar tabela resumo com todas as respostas
respostas_q6 <- data.frame(
Item = c("6(a)", "6(b) - PIB Desenvolvido", "6(b) - PIB Em Desenvolvimento",
"6(c)", "6(d) - Difteria Desenvolvido", "6(d) - Difteria Em Desenvolvimento"),
Descrição = c(
"Modelo com interação Status × PIB",
"Coeficiente efetivo do PIB para países desenvolvidos",
"Coeficiente efetivo do PIB para países em desenvolvimento",
"Modelo com interação Status × Cobertura Vacinal",
"Coeficiente efetivo da vacinação para países desenvolvidos",
"Coeficiente efetivo da vacinação para países em desenvolvimento"
),
Resposta = c(
"Modelo estimado com sucesso",
paste(round(coef_pib_desenvolvido, 6)),
paste(round(coef_pib_em_desenvolvimento, 6)),
"Modelo estimado com sucesso",
paste(round(coef_dip_desenvolvido, 6)),
paste(round(coef_dip_em_desenvolvimento, 6))
)
)
kable(respostas_q6, caption = "<p style='text-align: center; color: black; font-weight: bold;'>Tabela 18: Respostas da Questão 6</p>") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")| Item | Descrição | Resposta |
|---|---|---|
| 6(a) | Modelo com interação Status × PIB | Modelo estimado com sucesso |
| 6(b) - PIB Desenvolvido | Coeficiente efetivo do PIB para países desenvolvidos | -0.000029 |
| 6(b) - PIB Em Desenvolvimento | Coeficiente efetivo do PIB para países em desenvolvimento | 0.000059 |
| 6(c) | Modelo com interação Status × Cobertura Vacinal | Modelo estimado com sucesso |
| 6(d) - Difteria Desenvolvido | Coeficiente efetivo da vacinação para países desenvolvidos | 0.022328 |
| 6(d) - Difteria Em Desenvolvimento | Coeficiente efetivo da vacinação para países em desenvolvimento | 0.010779 |
Efeito do PIB per Capita:
Efeito da Cobertura Vacinal para Difteria:
Conclusão: Os termos de interação revelam que os efeitos do PIB e da cobertura vacinal na expectativa de vida variam significativamente entre países desenvolvidos e em desenvolvimento, destacando a importância de considerar o contexto socioeconômico na formulação de políticas públicas.
FÁVERO, L. P.; BELFIORE, P. Manual de análise de dados. 2. ed. Rio de
Janeiro: LTC, 2025.
HOFFMANN, R.Estatística para Economistas. 3.
ed. São Paulo: Editora Pioneira, 1998.
VENABLES, W. N.; SMITH,
D. M.An Introduction to R. [S.l.]: R-Project, 2015. Disponível em: https://cran.r-project.org/doc/manuals/R-intro.pdf.
XIE, Yihui; DERVIEUX, Christophe; RIEDERER, Emily.R Markdown
Cookbook>. [S.l.: s.n.], 2025. Disponível em: https://bookdown.org/yihui/rmarkdown-cookbook/. Acesso
em: 30 out. 2025.