Analises Estatisticas - Atividade Avaliativa
Paula Araujo
2025-12-05
2 VA - CPAD
resolucao de tres questoes de analise estatistica utilizando R, incluindo visualizacao de dados, graficos e demonstracao do Teorema do Limite Central.
VADeaths
Visualizacao do Dataset VADeaths
# Carregando bibliotecas necessarias
library(ggplot2)
library(reshape2)
# Visualizando o dataset VADeaths
print(VADeaths)## Rural Male Rural Female Urban Male Urban Female
## 50-54 11.7 8.7 15.4 8.4
## 55-59 18.1 11.7 24.3 13.6
## 60-64 26.9 20.3 37.0 19.3
## 65-69 41.0 30.9 54.6 35.1
## 70-74 66.0 54.3 71.1 50.0## num [1:5, 1:4] 11.7 18.1 26.9 41 66 8.7 11.7 20.3 30.9 54.3 ...
## - attr(*, "dimnames")=List of 2
## ..$ : chr [1:5] "50-54" "55-59" "60-64" "65-69" ...
## ..$ : chr [1:4] "Rural Male" "Rural Female" "Urban Male" "Urban Female"## Rural Male Rural Female Urban Male Urban Female
## Min. :11.70 Min. : 8.70 Min. :15.40 Min. : 8.40
## 1st Qu.:18.10 1st Qu.:11.70 1st Qu.:24.30 1st Qu.:13.60
## Median :26.90 Median :20.30 Median :37.00 Median :19.30
## Mean :32.74 Mean :25.18 Mean :40.48 Mean :25.28
## 3rd Qu.:41.00 3rd Qu.:30.90 3rd Qu.:54.60 3rd Qu.:35.10
## Max. :66.00 Max. :54.30 Max. :71.10 Max. :50.00Grafico de Barras Agrupadas
# Convertendo a matriz em data frame
va_df <- as.data.frame(VADeaths)
va_df$AgeGroup <- rownames(VADeaths)
# Transformando para formato longo
va_long <- melt(va_df, id.vars = "AgeGroup",
variable.name = "Category",
value.name = "DeathRate")
# Ajustando nomes das categorias para manter espacos e ordem original
va_long$Category <- gsub("\\.", " ", va_long$Category)
va_long$Category <- factor(
va_long$Category,
levels = c("Rural Male", "Rural Female", "Urban Male", "Urban Female"),
ordered = TRUE
)
cores_categorias <- c(
"Rural Male" = "#2E8B57", # Verde escuro
"Rural Female" = "#90EE90", # Verde claro
"Urban Male" = "#4169E1", # Azul royal
"Urban Female" = "#87CEEB" # Azul claro
)
# Criando o grafico de barras empilhadas agrupadas por faixa etaria
ggplot(va_long, aes(x = AgeGroup, y = DeathRate, fill = Category)) +
geom_bar(stat = "identity", width = 0.8, alpha = 0.9) +
scale_fill_manual(values = cores_categorias) +
labs(
title = "Taxas de Mortalidade em Virginia (1940)",
subtitle = "Dados agrupados por faixa etaria, genero e area",
x = "Faixa Etaria",
y = "Taxa de Mortalidade (por 1000 habitantes)",
fill = "Categoria",
caption = "Fonte: Dataset VADeaths (R base)"
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(hjust = 0.5, size = 18, face = "bold", color = "#2C3E50"),
plot.subtitle = element_text(hjust = 0.5, size = 14, color = "#34495E"),
axis.title = element_text(size = 13, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1, size = 11),
axis.text.y = element_text(size = 11),
legend.position = "bottom",
legend.title = element_text(face = "bold", size = 12),
legend.text = element_text(size = 11),
panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "#F8F9FA", color = NA)
) +
guides(fill = guide_legend(nrow = 2))
ClassificacaoDoenca
Dados dos Pacientes
# Dados dos 20 pacientes examinados
dados_doenca <- c("moderado", "leve", "leve", "severo", "leve", "moderado",
"moderado", "moderado", "leve", "leve", "severo", "leve",
"moderado", "moderado", "leve", "severo", "moderado",
"moderado", "moderado", "leve")
# Criando tabela de frequencias
freq_doenca <- table(dados_doenca)
print(freq_doenca)## dados_doenca
## leve moderado severo
## 8 9 3# Calculando porcentagens
porcentagens <- round(prop.table(freq_doenca) * 100, 1)
print(porcentagens)## dados_doenca
## leve moderado severo
## 40 45 15Grafico de Pizza
# Definindo cores para cada estagio
cores <- c("leve" = "#90EE90", # Verde claro
"moderado" = "#FFD700", # Dourado
"severo" = "#FF6347") # Vermelho tomate
# Ordenando os dados (leve, moderado, severo)
ordem <- c("leve", "moderado", "severo")
freq_ordenada <- freq_doenca[ordem]
porc_ordenada <- porcentagens[ordem]
cores_ordenadas <- cores[ordem]
# Criando labels com porcentagens para o grafico
labels_com_porc <- paste0(freq_ordenada, "\n(", porc_ordenada, "%)")
# Configurando layout para melhor visualizacao
par(mar = c(2, 2, 4, 2), bg = "white")
# Criando o grafico de pizza
pie(freq_ordenada,
labels = labels_com_porc,
col = cores_ordenadas,
main = "Classificacao dos Estagios da Doenca\n(n = 20 pacientes)",
cex.main = 1.5,
cex = 1.3,
border = "white",
clockwise = TRUE,
init.angle = 90,
radius = 0.9)
# Adicionando legenda com legend()
legend("topright",
legend = c(paste("Leve (", porc_ordenada["leve"], "%)", sep=""),
paste("Moderado (", porc_ordenada["moderado"], "%)", sep=""),
paste("Severo (", porc_ordenada["severo"], "%)", sep="")),
fill = cores_ordenadas,
cex = 1.2,
bty = "o",
bg = "white",
box.lwd = 2,
title = "Estagios",
title.adj = 0.5)
Teorema
Dataset Flu - Carregamento
# Carregando bibliotecas
library(ggplot2)
library(gridExtra)
# Carregando o dataset flu
flu <- read.csv("flu.csv")
# Verificando estrutura
str(flu)## 'data.frame': 75034 obs. of 1 variable:
## $ age: int 0 0 0 0 0 0 0 0 0 0 ...## age
## 1 0
## 2 0
## 3 0
## 4 0
## 5 0
## 6 0
## 7 0
## 8 0
## 9 0
## 10 0(1) Histograma e Densidade - Populacao Original
## ESTATISTICAS DA POPULACAO ORIGINAL## ===================================## Total de observacoes: 75034## Idade minima: 0## Idade maxima: 100## Media populacional: 43.22## Desvio padrao populacional: 26.35# Histograma e curva de densidade do conjunto original
ggplot(flu, aes(x = age)) +
geom_histogram(aes(y = after_stat(density)),
bins = 40,
fill = "#FF6B6B",
alpha = 0.75,
color = "white",
linewidth = 0.3) +
geom_density(color = "#2E4057",
linewidth = 1.5,
alpha = 0.3,
fill = "#2E4057") +
labs(
title = "Distribuicao das Idades das Mortes - Gripe Espanhola (1918)",
subtitle = "Dataset original (populacao) - Distribuicao NAO NORMAL",
x = "Idade (anos)",
y = "Densidade",
caption = "Fonte: Dataset flu (mosaicData)"
) +
theme_minimal(base_size = 13) +
theme(
plot.title = element_text(hjust = 0.5, size = 16, face = "bold", color = "#2C3E50"),
plot.subtitle = element_text(hjust = 0.5, size = 13, color = "#E74C3C"),
axis.title = element_text(size = 13, face = "bold"),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "#F8F9FA", color = NA)
) +
annotate("text",
x = max(flu$age) * 0.75,
y = max(density(flu$age)$y) * 0.8,
label = paste0("Media = ", round(mean(flu$age), 2), " anos\n",
"DP = ", round(sd(flu$age), 2), " anos\n",
"n = ", nrow(flu)),
size = 5,
hjust = 0,
color = "#2C3E50",
fontface = "bold")
# Teste de normalidade (se dataset permitir)
tamanho_teste <- min(5000, nrow(flu))
if(tamanho_teste >= 3) {
shapiro_test <- shapiro.test(sample(flu$age, tamanho_teste))
cat("\nTeste de Shapiro-Wilk:\n")
cat("Tamanho da amostra testada:", tamanho_teste, "\n")
cat("p-value:", format(shapiro_test$p.value, scientific = TRUE), "\n")
cat("Conclusao: Distribuicao",
ifelse(shapiro_test$p.value < 0.05, "NAO NORMAL", "NORMAL"), "\n")
}##
## Teste de Shapiro-Wilk:
## Tamanho da amostra testada: 5000
## p-value: 1.773643e-38
## Conclusao: Distribuicao NAO NORMAL(2) Criando 200 Medias Amostrais (n=35)
# Criando 200 medias de amostras com tamanho n = 35
set.seed(123) # Reprodutibilidade
n_amostras <- 200
tamanho_amostra <- 35
medias_amostrais <- numeric(n_amostras)
# Calculando as medias amostrais
for(i in 1:n_amostras) {
amostra <- sample(flu$age, tamanho_amostra, replace = TRUE)
medias_amostrais[i] <- mean(amostra)
}
cat("ESTATISTICAS DAS MEDIAS AMOSTRAIS\n")## ESTATISTICAS DAS MEDIAS AMOSTRAIS## ==================================## Numero de amostras: 200## Tamanho de cada amostra (n): 35## Media das medias amostrais: 42.86## Desvio padrao das medias: 4.16## Erro padrao teorico (sigma/sqrt(n)): 4.45# Teste de normalidade das medias
shapiro_medias <- shapiro.test(medias_amostrais)
cat("\nTeste de Shapiro-Wilk para medias amostrais:\n")##
## Teste de Shapiro-Wilk para medias amostrais:## p-value: 9.278934e-01cat("Conclusao: Distribuicao das medias",
ifelse(shapiro_medias$p.value < 0.05, "NAO NORMAL", "APROXIMADAMENTE NORMAL"), "\n")## Conclusao: Distribuicao das medias APROXIMADAMENTE NORMAL(3) Histograma das Medias Amostrais
# Criando dataframe
df_medias <- data.frame(medias = medias_amostrais)
# Histograma e curva de densidade das medias amostrais
ggplot(df_medias, aes(x = medias)) +
geom_histogram(aes(y = after_stat(density)),
bins = 30,
fill = "#4ECDC4",
alpha = 0.75,
color = "white",
linewidth = 0.3) +
geom_density(color = "#2E4057",
linewidth = 1.5,
alpha = 0.3,
fill = "#4ECDC4") +
# Curva normal teorica
stat_function(
fun = dnorm,
args = list(mean = mean(flu$age),
sd = sd(flu$age)/sqrt(tamanho_amostra)),
color = "#E74C3C",
linewidth = 1.5,
linetype = "dashed"
) +
labs(
title = "Distribuicao das Medias Amostrais - TEOREMA DO LIMITE CENTRAL",
subtitle = paste("200 amostras de tamanho n =", tamanho_amostra, "- Distribuicao APROXIMADAMENTE NORMAL"),
x = "Media Amostral",
y = "Densidade",
caption = "Linha solida: densidade observada | Linha tracejada: curva normal teorica"
) +
theme_minimal(base_size = 13) +
theme(
plot.title = element_text(hjust = 0.5, size = 16, face = "bold", color = "#2C3E50"),
plot.subtitle = element_text(hjust = 0.5, size = 13, color = "#27AE60"),
axis.title = element_text(size = 13, face = "bold"),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "#F8F9FA", color = NA)
) +
annotate("text",
x = max(medias_amostrais) * 0.95,
y = max(density(medias_amostrais)$y) * 0.85,
label = paste0("Media = ", round(mean(medias_amostrais), 2), "\n",
"DP = ", round(sd(medias_amostrais), 2), "\n",
"EP teorico = ", round(sd(flu$age)/sqrt(tamanho_amostra), 2)),
size = 5,
hjust = 1,
color = "#2C3E50",
fontface = "bold")
Comparacao: Populacao vs Medias Amostrais
# Grafico da populacao
p1 <- ggplot(flu, aes(x = age)) +
geom_histogram(aes(y = after_stat(density)), bins = 40,
fill = "#FF6B6B", alpha = 0.7, color = "white") +
geom_density(color = "#2E4057", linewidth = 1.2) +
labs(title = "POPULACAO ORIGINAL\n(NAO Normal)",
x = "Idade", y = "Densidade") +
theme_minimal(base_size = 12) +
theme(plot.title = element_text(hjust = 0.5, face = "bold", color = "#E74C3C"),
panel.background = element_rect(fill = "#F8F9FA"))
# Grafico das medias
p2 <- ggplot(df_medias, aes(x = medias)) +
geom_histogram(aes(y = after_stat(density)), bins = 30,
fill = "#4ECDC4", alpha = 0.7, color = "white") +
geom_density(color = "#2E4057", linewidth = 1.2) +
stat_function(fun = dnorm,
args = list(mean = mean(flu$age),
sd = sd(flu$age)/sqrt(tamanho_amostra)),
color = "#E74C3C", linewidth = 1.2, linetype = "dashed") +
labs(title = "MEDIAS AMOSTRAIS\n(Aproximadamente Normal)",
x = "Media Amostral", y = "Densidade") +
theme_minimal(base_size = 12) +
theme(plot.title = element_text(hjust = 0.5, face = "bold", color = "#27AE60"),
panel.background = element_rect(fill = "#F8F9FA"))
# Combinando graficos
grid.arrange(p1, p2, ncol = 2,
top = grid::textGrob("DEMONSTRACAO DO TEOREMA DO LIMITE CENTRAL",
gp = grid::gpar(fontsize = 18, fontface = "bold")))
Conclusoes do Teorema do Limite Central
Mesmo partindo de uma população altamente não-normal (com distribuição assimétrica das idades de morte durante a Gripe Espanhola de 1918), observamos um fenômeno matemático fascinante: quando extraímos múltiplas amostras e calculamos suas médias, a distribuição resultante converge para uma distribuição aproximadamente normal.
A população original apresenta uma média (μ) de aproximadamente 43.22 anos com desvio padrão (σ) de 26.35 anos. No entanto, as 200 médias amostrais de tamanho n = 35 mostram uma distribuição muito mais regular, com centro em 42.86 anos e erro padrão de aproximadamente 4.16, confirmando a fórmula teórica σ/√n = 4.45.
Este resultado prático demonstra os três pilares do Teorema do Limite Central: o centro da distribuição amostral permanece na média populacional, a variabilidade reduz proporcionalmente à raiz quadrada do tamanho amostral, e a forma converge para uma distribuição normal, independentemente da forma da população original.
Portanto, o Teorema do Limite Central foi confirmado com sucesso através desta análise dos dados históricos da Gripe Espanhola.