Criando Gráficos de Barras e Pizza no R

19/12/202530/08/2025 Por antonino

Desenho de gráfico de barras no quadro negro e um professor explicando o gráfico

Desmatamento na Amazônia Legal em 2019

Esta página apresenta uma análise completa dos dados de desmatamento na Amazônia Legal em 2019 utilizando a linguagem R, incluindo a geração e salvamento de gráficos de barras e pizza.

Dados de Desmatamento por Estado

Os dados representam a área desmatada em km² por estado da Amazônia Legal em 2019:

Estado	Sigla	Área Desmatada (km²)
Acre	AC	682
Amazonas	AM	1,434
Amapá	AP	32
Maranhão	MA	237
Mato Grosso	MT	1,702
Pará	PA	4,172
Rondônia	RO	1,257
Roraima	RR	590
Tocantins	TO	23

Total de desmatamento em 2019: 10,129 km²

Gráfico de Barras

Gráfico de Pizza

Análise Estatística e Visualização com R

O código abaixo realiza uma análise completa dos dados, gera e salva gráficos de barras e pizza em C:/Graficos_Desmatamento/ :

# ANÁLISE DE DESMATAMENTO NA AMAZÔNIA LEGAL - 2019
# Dados: Estados e área desmatada em km²

# Dados de desmatamento
estados <- c("AC", "AM", "AP", "MA", "MT", "PA", "RO", "RR", "TO")
nomes_completos <- c("Acre", "Amazonas", "Amapá", "Maranhão", "Mato Grosso", 
                    "Pará", "Rondônia", "Roraima", "Tocantins")
desmatamento <- c(682, 1434, 32, 237, 1702, 4172, 1257, 590, 23)

# Criar data frame
dados_desmatamento <- data.frame(
  Estado = estados,
  Estado_Completo = nomes_completos,
  Area_km2 = desmatamento
)

# Calcular percentuais
dados_desmatamento$Percentual <- round(dados_desmatamento$Area_km2 / sum(dados_desmatamento$Area_km2) * 100, 1)

# Ordenar por área desmatada (do maior para o menor)
dados_ordenados <- dados_desmatamento[order(dados_desmatamento$Area_km2, decreasing = TRUE), ]

# Definir diretório para salvar os gráficos (altere conforme necessário)
diretorio <- "C:/Graficos_Desmatamento/"
dir.create(diretorio, showWarnings = FALSE)

# 1. GRÁFICO DE BARRAS HORIZONTAL - SALVAR COMO PNG
cat("=== GERANDO E SALVANDO GRÁFICO DE BARRAS ===\n")

png(paste0(diretorio, "desmatamento_barras.png"), width = 1000, height = 700, res = 150)

# Configurar margens
par(mar = c(5, 10, 4, 4) + 0.1)

# Gráfico de barras horizontal
barras <- barplot(height = dados_ordenados$Area_km2,
        names.arg = paste0(dados_ordenados$Estado, " - ", dados_ordenados$Estado_Completo),
        horiz = TRUE,
        las = 1,
        col = terrain.colors(nrow(dados_ordenados), alpha = 0.7),
        border = "darkgray",
        main = "Desmatamento na Amazônia Legal por Estado (2019)",
        xlab = "Área Desmatada (km²)",
        cex.names = 0.8,
        xlim = c(0, max(dados_ordenados$Area_km2) * 1.15))

# Adicionar valores no final das barras
text(x = dados_ordenados$Area_km2, 
     y = barras,
     labels = paste0(dados_ordenados$Area_km2, " km² (", dados_ordenados$Percentual, "%)"),
     pos = 4,
     cex = 0.8,
     col = "darkblue")

# Adicionar linha de média
media <- mean(dados_ordenados$Area_km2)
abline(v = media, col = "red", lty = 2, lwd = 2)
text(x = media * 1.05, 
     y = max(barras) / 2,
     labels = paste0("Média: ", round(media, 1), " km²"),
     col = "red",
     cex = 0.9)

# Adicionar grid
grid(nx = NA, ny = NULL, col = "lightgray", lty = "dotted")

dev.off()
cat("Gráfico de barras salvo como 'desmatamento_barras.png'\n")

# 2. GRÁFICO DE PIZZA (SETORES) - SALVAR COMO PNG
cat("\n=== GERANDO E SALVANDO GRÁFICO DE PIZZA ===\n")

png(paste0(diretorio, "desmatamento_pizza.png"), width = 1000, height = 800, res = 150)

# Configurar layout para mostrar gráfico e legenda lado a lado
layout(matrix(c(1, 2), ncol = 2), widths = c(2, 1))

# Preparar dados para o gráfico de pizza
# Juntar estados com percentual muito baixo em "Outros"
limite_percentual <- 5  # Estados com menos de 5% serão agrupados
dados_agrupados <- dados_desmatamento
outros <- sum(dados_agrupados$Area_km2[dados_agrupados$Percentual < limite_percentual])
outros_percentual <- round(outros / sum(dados_agrupados$Area_km2) * 100, 1)

# Filtrar apenas estados com percentual significativo
dados_significativos <- dados_agrupados[dados_agrupados$Percentual >= limite_percentual, ]

# Adicionar categoria "Outros" se necessário
if (outros > 0) {
  outros_df <- data.frame(
    Estado = "OUT",
    Estado_Completo = "Outros",
    Area_km2 = outros,
    Percentual = outros_percentual
  )
  dados_significativos <- rbind(dados_significativos, outros_df)
}

# Ordenar por percentual para melhor visualização
dados_significativos <- dados_significativos[order(dados_significativos$Percentual, decreasing = TRUE), ]

# Criar rótulos para o gráfico de pizza
rotulos <- paste0(dados_significativos$Estado, " (", dados_significativos$Percentual, "%)")

# Gráfico de pizza
pie(dados_significativos$Area_km2,
    labels = rotulos,
    main = "Distribuição do Desmatamento na Amazônia Legal (2019)",
    col = rainbow(nrow(dados_significativos), alpha = 0.7),
    clockwise = TRUE,
    cex = 0.9,
    radius = 0.9)

# Legenda detalhada
par(mar = c(0, 0, 0, 0))
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
legend("center", 
       legend = paste0(dados_significativos$Estado_Completo, ": ", 
                      dados_significativos$Area_km2, " km²"),
       cex = 0.8,
       fill = rainbow(nrow(dados_significativos), alpha = 0.7),
       title = "Legenda Detalhada",
       title.adj = 0)

dev.off()
cat("Gráfico de pizza salvo como 'desmatamento_pizza.png'\n")

# Restaurar configurações padrão de plotagem
par(mfrow = c(1, 1), mar = c(5, 4, 4, 2) + 0.1)

# 3. GRÁFICO COMBINADO - BARRAS VERTICAIS - SALVAR COMO PDF
cat("\n=== GERANDO E SALVANDO GRÁFICO COMBINADO (PDF) ===\n")

pdf(paste0(diretorio, "desmatamento_combinado.pdf"), width = 10, height = 8)

# Configurar layout para 2 gráficos
layout(matrix(c(1, 2), nrow = 2, byrow = TRUE), heights = c(2, 1.5))

# Gráfico de barras verticais
barplot(dados_ordenados$Area_km2,
        names.arg = dados_ordenados$Estado,
        col = heat.colors(nrow(dados_ordenados), alpha = 0.7),
        main = "Desmatamento por Estado - Amazônia Legal (2019)",
        ylab = "Área Desmatada (km²)",
        ylim = c(0, max(dados_ordenados$Area_km2) * 1.1))

# Adicionar valores no topo das barras
text(x = 1:nrow(dados_ordenados) - 0.4, 
     y = dados_ordenados$Area_km2,
     labels = dados_ordenados$Area_km2,
     pos = 3,
     cex = 0.8,
     col = "darkred")

# Adicionar linha de média
abline(h = media, col = "blue", lty = 2, lwd = 2)
text(x = nrow(dados_ordenados) / 2, 
     y = media * 1.05,
     labels = paste0("Média: ", round(media, 1), " km²"),
     col = "blue",
     cex = 0.9)

# Gráfico de pizza simplificado
pie(dados_significativos$Area_km2,
    labels = rotulos,
    main = "Distribuição Percentual do Desmatamento",
    col = rainbow(nrow(dados_significativos), alpha = 0.7),
    clockwise = TRUE,
    cex = 0.8,
    radius = 0.8)

dev.off()
cat("Gráfico combinado salvo como 'desmatamento_combinado.pdf'\n")

# ESTATÍSTICAS DESCRITIVAS
cat("\n=== ESTATÍSTICAS DESCRITIVAS ===\n")
cat("Total desmatado:", sum(desmatamento), "km²\n")
cat("Média:", round(mean(desmatamento), 1), "km²\n")
cat("Mediana:", median(desmatamento), "km²\n")
cat("Desvio padrão:", round(sd(desmatamento), 1), "km²\n")
cat("Amplitude:", range(desmatamento)[2] - range(desmatamento)[1], "km²\n")
cat("Coeficiente de variação:", round(sd(desmatamento)/mean(desmatamento)*100, 1), "%\n")

cat("\n=== DISTRIBUIÇÃO POR ESTADO ===\n")
for(i in 1:nrow(dados_ordenados)) {
  cat(dados_ordenados$Estado[i], "(", dados_ordenados$Estado_Completo[i], "):", 
      dados_ordenados$Area_km2[i], "km² (", dados_ordenados$Percentual[i], "%)\n")
}

# TESTE DE NORMALIDADE
cat("\n=== TESTE DE NORMALIDADE (SHAPIRO-WILK) ===\n")
shapiro_test <- shapiro.test(desmatamento)
cat("Valor-p:", format.pval(shapiro_test$p.value, digits = 3), "\n")
if(shapiro_test$p.value < 0.05) {
    cat("Os dados NÃO seguem uma distribuição normal (p < 0.05)\n") } else { cat("Os dados seguem uma distribuição normal (p >= 0.05)\n")
}

# ANÁLISE DE CONCENTRAÇÃO
cat("\n=== ANÁLISE DE CONCENTRAÇÃO ===\n")
# Calcular percentual acumulado
dados_ordenados$Percentual_Acumulado <- cumsum(dados_ordenados$Percentual)
cat("Os 3 estados com maior desmatamento representam", 
    round(sum(dados_ordenados$Percentual[1:3]), 1), "% do total\n")
cat("O estado com maior desmatamento (", dados_ordenados$Estado_Completo[1], 
    ") representa sozinho", dados_ordenados$Percentual[1], "% do total\n")

# Salvar dados em CSV
write.csv(dados_desmatamento, paste0(diretorio, "dados_desmatamento.csv"), row.names = FALSE)
cat("\nDados salvos em 'dados_desmatamento.csv'\n")

cat("\n=== ANÁLISE CONCLUSIVA ===\n")
cat("Os gráficos e arquivos de dados foram salvos no diretório:", diretorio, "\n")
cat("Foram gerados 3 arquivos:\n")
cat("1. desmatamento_barras.png - Gráfico de barras horizontal\n")
cat("2. desmatamento_pizza.png - Gráfico de pizza com legenda\n")
cat("3. desmatamento_combinado.pdf - Gráficos combinados em PDF\n")
cat("4. dados_desmatamento.csv - Dados completos em CSV\n")

cat("\nPara alterar o diretório de salvamento, modifique a variável 'diretorio' no código.\n")

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

# ANÁLISE DE DESMATAMENTO NA AMAZÔNIA LEGAL - 2019

# Dados: Estados e área desmatada em km²

# Dados de desmatamento

estados <- c("AC", "AM", "AP", "MA", "MT", "PA", "RO", "RR", "TO")

nomes_completos <- c("Acre", "Amazonas", "Amapá", "Maranhão", "Mato Grosso",

"Pará", "Rondônia", "Roraima", "Tocantins")

desmatamento <- c(682, 1434, 32, 237, 1702, 4172, 1257, 590, 23)

# Criar data frame

dados_desmatamento <- data.frame(

Estado = estados,

Estado_Completo = nomes_completos,

Area_km2 = desmatamento

)

# Calcular percentuais

dados_desmatamento$Percentual <- round(dados_desmatamento$Area_km2 / sum(dados_desmatamento$Area_km2) * 100, 1)

# Ordenar por área desmatada (do maior para o menor)

dados_ordenados <- dados_desmatamento[order(dados_desmatamento$Area_km2, decreasing = TRUE), ]

# Definir diretório para salvar os gráficos (altere conforme necessário)

diretorio <- "C:/Graficos_Desmatamento/"

dir.create(diretorio, showWarnings = FALSE)

# 1. GRÁFICO DE BARRAS HORIZONTAL - SALVAR COMO PNG

cat("=== GERANDO E SALVANDO GRÁFICO DE BARRAS ===\n")

png(paste0(diretorio, "desmatamento_barras.png"), width = 1000, height = 700, res = 150)

# Configurar margens

par(mar = c(5, 10, 4, 4) + 0.1)

# Gráfico de barras horizontal

barras <- barplot(height = dados_ordenados$Area_km2,

names.arg = paste0(dados_ordenados$Estado, " - ", dados_ordenados$Estado_Completo),

horiz = TRUE,

las = 1,

col = terrain.colors(nrow(dados_ordenados), alpha = 0.7),

border = "darkgray",

main = "Desmatamento na Amazônia Legal por Estado (2019)",

xlab = "Área Desmatada (km²)",

cex.names = 0.8,

xlim = c(0, max(dados_ordenados$Area_km2) * 1.15))

# Adicionar valores no final das barras

text(x = dados_ordenados$Area_km2,

y = barras,

labels = paste0(dados_ordenados$Area_km2, " km² (", dados_ordenados$Percentual, "%)"),

pos = 4,

cex = 0.8,

col = "darkblue")

# Adicionar linha de média

media <- mean(dados_ordenados$Area_km2)

abline(v = media, col = "red", lty = 2, lwd = 2)

text(x = media * 1.05,

y = max(barras) / 2,

labels = paste0("Média: ", round(media, 1), " km²"),

col = "red",

cex = 0.9)

# Adicionar grid

grid(nx = NA, ny = NULL, col = "lightgray", lty = "dotted")

dev.off()

cat("Gráfico de barras salvo como 'desmatamento_barras.png'\n")

# 2. GRÁFICO DE PIZZA (SETORES) - SALVAR COMO PNG

cat("\n=== GERANDO E SALVANDO GRÁFICO DE PIZZA ===\n")

png(paste0(diretorio, "desmatamento_pizza.png"), width = 1000, height = 800, res = 150)

# Configurar layout para mostrar gráfico e legenda lado a lado

layout(matrix(c(1, 2), ncol = 2), widths = c(2, 1))

# Preparar dados para o gráfico de pizza

# Juntar estados com percentual muito baixo em "Outros"

limite_percentual <- 5 # Estados com menos de 5% serão agrupados

dados_agrupados <- dados_desmatamento

outros <- sum(dados_agrupados$Area_km2[dados_agrupados$Percentual < limite_percentual])

outros_percentual <- round(outros / sum(dados_agrupados$Area_km2) * 100, 1)

# Filtrar apenas estados com percentual significativo

dados_significativos <- dados_agrupados[dados_agrupados$Percentual >= limite_percentual, ]

# Adicionar categoria "Outros" se necessário

if (outros > 0) {

outros_df <- data.frame(

Estado = "OUT",

Estado_Completo = "Outros",

Area_km2 = outros,

Percentual = outros_percentual

)

dados_significativos <- rbind(dados_significativos, outros_df)

}

# Ordenar por percentual para melhor visualização

dados_significativos <- dados_significativos[order(dados_significativos$Percentual, decreasing = TRUE), ]

# Criar rótulos para o gráfico de pizza

rotulos <- paste0(dados_significativos$Estado, " (", dados_significativos$Percentual, "%)")

# Gráfico de pizza

pie(dados_significativos$Area_km2,

labels = rotulos,

main = "Distribuição do Desmatamento na Amazônia Legal (2019)",

col = rainbow(nrow(dados_significativos), alpha = 0.7),

clockwise = TRUE,

cex = 0.9,

radius = 0.9)

# Legenda detalhada

par(mar = c(0, 0, 0, 0))

plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")

legend("center",

legend = paste0(dados_significativos$Estado_Completo, ": ",

dados_significativos$Area_km2, " km²"),

cex = 0.8,

fill = rainbow(nrow(dados_significativos), alpha = 0.7),

title = "Legenda Detalhada",

title.adj = 0)

dev.off()

cat("Gráfico de pizza salvo como 'desmatamento_pizza.png'\n")

# Restaurar configurações padrão de plotagem

par(mfrow = c(1, 1), mar = c(5, 4, 4, 2) + 0.1)

# 3. GRÁFICO COMBINADO - BARRAS VERTICAIS - SALVAR COMO PDF

cat("\n=== GERANDO E SALVANDO GRÁFICO COMBINADO (PDF) ===\n")

pdf(paste0(diretorio, "desmatamento_combinado.pdf"), width = 10, height = 8)

# Configurar layout para 2 gráficos

layout(matrix(c(1, 2), nrow = 2, byrow = TRUE), heights = c(2, 1.5))

# Gráfico de barras verticais

barplot(dados_ordenados$Area_km2,

names.arg = dados_ordenados$Estado,

col = heat.colors(nrow(dados_ordenados), alpha = 0.7),

main = "Desmatamento por Estado - Amazônia Legal (2019)",

ylab = "Área Desmatada (km²)",

ylim = c(0, max(dados_ordenados$Area_km2) * 1.1))

# Adicionar valores no topo das barras

text(x = 1:nrow(dados_ordenados) - 0.4,

y = dados_ordenados$Area_km2,

labels = dados_ordenados$Area_km2,

pos = 3,

cex = 0.8,

col = "darkred")

# Adicionar linha de média

abline(h = media, col = "blue", lty = 2, lwd = 2)

text(x = nrow(dados_ordenados) / 2,

y = media * 1.05,

labels = paste0("Média: ", round(media, 1), " km²"),

col = "blue",

cex = 0.9)

# Gráfico de pizza simplificado

pie(dados_significativos$Area_km2,

labels = rotulos,

main = "Distribuição Percentual do Desmatamento",

col = rainbow(nrow(dados_significativos), alpha = 0.7),

clockwise = TRUE,

cex = 0.8,

radius = 0.8)

dev.off()

cat("Gráfico combinado salvo como 'desmatamento_combinado.pdf'\n")

# ESTATÍSTICAS DESCRITIVAS

cat("\n=== ESTATÍSTICAS DESCRITIVAS ===\n")

cat("Total desmatado:", sum(desmatamento), "km²\n")

cat("Média:", round(mean(desmatamento), 1), "km²\n")

cat("Mediana:", median(desmatamento), "km²\n")

cat("Desvio padrão:", round(sd(desmatamento), 1), "km²\n")

cat("Amplitude:", range(desmatamento)[2] - range(desmatamento)[1], "km²\n")

cat("Coeficiente de variação:", round(sd(desmatamento)/mean(desmatamento)*100, 1), "%\n")

cat("\n=== DISTRIBUIÇÃO POR ESTADO ===\n")

for(i in 1:nrow(dados_ordenados)) {

cat(dados_ordenados$Estado[i], "(", dados_ordenados$Estado_Completo[i], "):",

dados_ordenados$Area_km2[i], "km² (", dados_ordenados$Percentual[i], "%)\n")

}

# TESTE DE NORMALIDADE

cat("\n=== TESTE DE NORMALIDADE (SHAPIRO-WILK) ===\n")

shapiro_test <- shapiro.test(desmatamento)

cat("Valor-p:", format.pval(shapiro_test$p.value, digits = 3), "\n")

if(shapiro_test$p.value < 0.05) {

cat("Os dados NÃO seguem uma distribuição normal (p < 0.05)\n") } else { cat("Os dados seguem uma distribuição normal (p >= 0.05)\n")

}

# ANÁLISE DE CONCENTRAÇÃO

cat("\n=== ANÁLISE DE CONCENTRAÇÃO ===\n")

# Calcular percentual acumulado

dados_ordenados$Percentual_Acumulado <- cumsum(dados_ordenados$Percentual)

cat("Os 3 estados com maior desmatamento representam",

round(sum(dados_ordenados$Percentual[1:3]), 1), "% do total\n")

cat("O estado com maior desmatamento (", dados_ordenados$Estado_Completo[1],

") representa sozinho", dados_ordenados$Percentual[1], "% do total\n")

# Salvar dados em CSV

write.csv(dados_desmatamento, paste0(diretorio, "dados_desmatamento.csv"), row.names = FALSE)

cat("\nDados salvos em 'dados_desmatamento.csv'\n")

cat("\n=== ANÁLISE CONCLUSIVA ===\n")

cat("Os gráficos e arquivos de dados foram salvos no diretório:", diretorio, "\n")

cat("Foram gerados 3 arquivos:\n")

cat("1. desmatamento_barras.png - Gráfico de barras horizontal\n")

cat("2. desmatamento_pizza.png - Gráfico de pizza com legenda\n")

cat("3. desmatamento_combinado.pdf - Gráficos combinados em PDF\n")

cat("4. dados_desmatamento.csv - Dados completos em CSV\n")

cat("\nPara alterar o diretório de salvamento, modifique a variável 'diretorio' no código.\n")

Instruções de Execução

Como executar este código R:

Copie todo o código R para um script no RStudio
Altere o diretório de salvamento na variável diretorio conforme necessário
Execute o código completo
Os gráficos serão salvos como arquivos PNG e PDF no diretório especificado
Os dados também serão salvos em um arquivo CSV para análise adicional

Observação: Certifique-se de que o diretório especificado existe e que você tem permissão de escrita.

Resultados Esperados

Arquivos Gerados

desmatamento_barras.png: Gráfico de barras horizontal com valores e percentuais
desmatamento_pizza.png: Gráfico de pizza com legenda detalhada
desmatamento_combinado.pdf: Gráficos combinados em formato vetorial
dados_desmatamento.csv: Dados completos para análise adicional

Análises Realizadas

Estatísticas descritivas completas
Teste de normalidade de Shapiro-Wilk
Análise de concentração do desmatamento
Cálculo de percentuais e rankings
Identificação de estados críticos

Conclusão

Este código R fornece uma análise completa do desmatamento na Amazônia Legal em 2019, com foco na geração e salvamento de visualizações profissionais.

Os gráficos gerados permitem identificar claramente a concentração do desmatamento em poucos estados, com o Pará respondendo por mais de 40% do total.

Os arquivos salvos podem ser utilizados em relatórios, apresentações e divulgações, contribuindo para a conscientização sobre o problema do desmatamento na região.

Implementação de Amostragem Estratificada em R

19/12/202529/08/2025 Por antonino

Este documento apresenta uma implementação completa de amostragem estratificada em R, utilizando o pacote sampling e demonstrando todo o processo desde a preparação dos dados até a estimação de parâmetros populacionais.

Visão Geral do Código

O código R apresentado realiza uma amostragem estratificada proporcional utilizando a base de dados MU284, que contém informações sobre municípios suecos. O processo inclui:

Limpeza do ambiente de trabalho
Carregamento e preparação dos dados
Cálculo de alocações por estrato
Seleção da amostra
Estimação de parâmetros populacionais

Funções Auxiliares

Função clean_env

Esta função realiza uma limpeza completa do ambiente de trabalho do R:

clean_env <- function(hidden = TRUE, packages = FALSE, graphics = FALSE) {
  cat("?? Iniciando limpeza do ambiente...\n")
  
  # 1. Limpar objetos do ambiente global
  if (hidden) {
    rm(list = ls(all.names = TRUE), envir = .GlobalEnv)
    cat("? Objetos visíveis e ocultos removidos\n")
  } else {
    rm(list = ls(all.names = FALSE), envir = .GlobalEnv)
    cat("? Objetos visíveis removidos\n")
  }
  
  # 2. Limpar console (opcional - depende do ambiente)
  tryCatch({
    cat("\014") # Limpa console no RStudio
    cat("? Console limpo\n")
  }, error = function(e) {
    cat("??  Não foi possível limpar o console\n")
  })
  
  # 3. Fechar dispositivos gráficos
  if (graphics) {
    while (!is.null(dev.list())) {
      dev.off()
    }
    cat("? Dispositivos gráficos fechados\n")
  }
  
  # 4. Descarregar pacotes não-essenciais
  if (packages) {
    essential_pkgs <- c("base", "utils", "stats", "graphics", "grDevices", "methods")
    all_pkgs <- .packages()
    pkgs_to_unload <- setdiff(all_pkgs, essential_pkgs) if (length(pkgs_to_unload) > 0) {
      for (pkg in pkgs_to_unload) {
        tryCatch({
          detach(paste0("package:", pkg), character.only = TRUE, unload = TRUE)
        }, error = function(e) {
          # Alguns pacotes não podem ser descarregados
        })
      }
      cat("? Pacotes não-essenciais descarregados\n")
    }
  }
  
  # 5. Coletar lixo da memória
  gc(verbose = FALSE)
  cat("? Coleta de lixo realizada\n")
  
  cat("?? Ambiente limpo com sucesso!\n")
  invisible(TRUE)
}

clean_env <- function(hidden = TRUE, packages = FALSE, graphics = FALSE) {

cat("?? Iniciando limpeza do ambiente...\n")

# 1. Limpar objetos do ambiente global

if (hidden) {

rm(list = ls(all.names = TRUE), envir = .GlobalEnv)

cat("? Objetos visíveis e ocultos removidos\n")

} else {

rm(list = ls(all.names = FALSE), envir = .GlobalEnv)

cat("? Objetos visíveis removidos\n")

}

# 2. Limpar console (opcional - depende do ambiente)

tryCatch({

cat("\014") # Limpa console no RStudio

cat("? Console limpo\n")

}, error = function(e) {

cat("?? Não foi possível limpar o console\n")

})

# 3. Fechar dispositivos gráficos

if (graphics) {

while (!is.null(dev.list())) {

dev.off()

}

cat("? Dispositivos gráficos fechados\n")

}

# 4. Descarregar pacotes não-essenciais

if (packages) {

essential_pkgs <- c("base", "utils", "stats", "graphics", "grDevices", "methods")

all_pkgs <- .packages()

pkgs_to_unload <- setdiff(all_pkgs, essential_pkgs) if (length(pkgs_to_unload) > 0) {

for (pkg in pkgs_to_unload) {

tryCatch({

detach(paste0("package:", pkg), character.only = TRUE, unload = TRUE)

}, error = function(e) {

# Alguns pacotes não podem ser descarregados

})

}

cat("? Pacotes não-essenciais descarregados\n")

}

# 5. Coletar lixo da memória

gc(verbose = FALSE)

cat("? Coleta de lixo realizada\n")

cat("?? Ambiente limpo com sucesso!\n")

invisible(TRUE)

}

Funções de Suporte

Funções auxiliares para verificação de números inteiros e arredondamento:

# Verificar se um número é inteiro
eh_inteiro <- function(numero) {
  resultado <- (numero %% 1) == 0
  return(resultado)
}

# Arredondar cada elemento de um vetor para cima
arredondar_para_cima <- function(lista) {
  resultado <- numeric(length(lista))
  
  for (i in seq_along(lista)) {
    valor <- lista[i]
    if (eh_inteiro(valor)) {
      resultado[i] <- as.integer(valor) + 1
    } else {
      resultado[i] <- ceiling(valor)
    }
  }
  return(resultado)
}

# Verificar se um número é inteiro

eh_inteiro <- function(numero) {

resultado <- (numero %% 1) == 0

return(resultado)

}

# Arredondar cada elemento de um vetor para cima

arredondar_para_cima <- function(lista) {

resultado <- numeric(length(lista))

for (i in seq_along(lista)) {

valor <- lista[i]

if (eh_inteiro(valor)) {

resultado[i] <- as.integer(valor) + 1

} else {

resultado[i] <- ceiling(valor)

}

return(resultado)

}

Processo de Amostragem Estratificada

Preparação dos Dados

# Instalação e carregamento do pacote sampling
install.packages("sampling")
library(sampling)

# Carregar base de dados MU284 (municípios da Suécia)
data(MU284)

# Construir tabela de frequências da variável de estratificação
freq_estratos <- table(MU284$REG)  # Tabela de frequência por região
dados_populacao <- MU284           # Dados originais
nome_dataset <- "MU284"            # Nome do dataset como string

# Definições iniciais
N <- nrow(MU284)                   # Tamanho total da população
tamanhos <- list(80, 80)           # Tamanhos de amostra possíveis
n <- tamanhos[[1]]                 # Primeiro tamanho de amostra
qtd_estratos <- length(freq_estratos) # Número de estratos

# Definir semente para reprodutibilidade
semente <- 3
set.seed(semente)

# Variável usada para estratificação
variavel_estrato <- "REG"

# Variável numérica de interesse (estimativa média e total)
variavel_estimacao <- "P85"   # População em 1985
formula_estimacao <- as.formula(paste("~", variavel_estimacao))

# Instalação e carregamento do pacote sampling

install.packages("sampling")

library(sampling)

# Carregar base de dados MU284 (municípios da Suécia)

data(MU284)

# Construir tabela de frequências da variável de estratificação

freq_estratos <- table(MU284$REG) # Tabela de frequência por região

dados_populacao <- MU284 # Dados originais

nome_dataset <- "MU284" # Nome do dataset como string

# Definições iniciais

N <- nrow(MU284) # Tamanho total da população

tamanhos <- list(80, 80) # Tamanhos de amostra possíveis

n <- tamanhos[[1]] # Primeiro tamanho de amostra

qtd_estratos <- length(freq_estratos) # Número de estratos

# Definir semente para reprodutibilidade

semente <- 3

set.seed(semente)

# Variável usada para estratificação

variavel_estrato <- "REG"

# Variável numérica de interesse (estimativa média e total)

variavel_estimacao <- "P85" # População em 1985

formula_estimacao <- as.formula(paste("~", variavel_estimacao))

Cálculo de Alocações e Probabilidades

Alocação Proporcional

O cálculo da alocação proporcional segue a fórmula:

$n_h = n \times \frac{N_h}{N}$

Onde:

$n_h$ = tamanho da amostra no estrato h
$n$ = tamanho total da amostra
$N_h$ = tamanho do estrato h na população
$N$ = tamanho total da população

# Cálculo da alocação proporcional teórica
alocacao_teorica <- n * prop.table(freq_estratos)

# Ajuste da alocação (sempre arredondando para cima)
alocacao_final <- arredondar_para_cima(alocacao_teorica)

# Probabilidades de seleção em cada estrato
probabilidades <- alocacao_final / freq_estratos

# Cálculo da alocação proporcional teórica

alocacao_teorica <- n * prop.table(freq_estratos)

# Ajuste da alocação (sempre arredondando para cima)

alocacao_final <- arredondar_para_cima(alocacao_teorica)

# Probabilidades de seleção em cada estrato

probabilidades <- alocacao_final / freq_estratos

Seleção da Amostra e Estimação

Seleção da Amostra

# Seleção da amostra estratificada
amostra_ids <- strata(dados_populacao,
                      stratanames = variavel_estrato,
                      size = alocacao_final,
                      method = "srswor")

# Extração dos dados completos da amostra
amostra <- getdata(dados_populacao, amostra_ids)

# Seleção da amostra estratificada

amostra_ids <- strata(dados_populacao,

stratanames = variavel_estrato,

size = alocacao_final,

method = "srswor")

# Extração dos dados completos da amostra

amostra <- getdata(dados_populacao, amostra_ids)

Estimação com Correção para População Finita

O Fator de Correção para População Finita (FPC) é calculado como:

$FPC = \frac{N – n}{N}$

E é aplicado para reduzir o erro padrão das estimativas quando a amostra é uma fração significativa da população.

library(survey)

# Fator de correção para população finita (FPC)
fpc <- rep(freq_estratos, alocacao_final)

# Criar plano amostral com FPC
plano_amostral <- svydesign(
  id = ~1,
  strata = ~Stratum,
  probs = ~amostra_ids$Prob,
  data = amostra,
  fpc = ~fpc
)

# Estimar média e total populacional da variável de interesse
media_populacional <- svymean(formula_estimacao, plano_amostral)
total_populacional <- svytotal(formula_estimacao, plano_amostral)

# Estimativas por estrato (com FPC)
media_por_estrato <- svyby(formula_estimacao, by = ~Stratum, design = plano_amostral, FUN = svymean)
total_por_estrato <- svyby(formula_estimacao, by = ~Stratum, design = plano_amostral, FUN = svytotal)

library(survey)

# Fator de correção para população finita (FPC)

fpc <- rep(freq_estratos, alocacao_final)

# Criar plano amostral com FPC

plano_amostral <- svydesign(

id = ~1,

strata = ~Stratum,

probs = ~amostra_ids$Prob,

data = amostra,

fpc = ~fpc

)

# Estimar média e total populacional da variável de interesse

media_populacional <- svymean(formula_estimacao, plano_amostral)

total_populacional <- svytotal(formula_estimacao, plano_amostral)

# Estimativas por estrato (com FPC)

media_por_estrato <- svyby(formula_estimacao, by = ~Stratum, design = plano_amostral, FUN = svymean)

total_por_estrato <- svyby(formula_estimacao, by = ~Stratum, design = plano_amostral, FUN = svytotal)

Considerações Importantes

Vantagens da Amostragem Estratificada

Garante representatividade de todos os subgrupos relevantes
Pode resultar em estimativas mais precisas
Permite análise separada para cada estrato
Mais eficiente quando os estratos são homogêneos internamente

Desafios e Considerações

Requer conhecimento prévio da população para definir estratos
O arredondamento pode alterar ligeiramente o tamanho total da amostra
A escolha da variável de estratificação é crucial
Pode ser mais complexa de implementar que amostragem aleatória simples

Conclusão

Este código demonstra uma implementação completa de amostragem estratificada em R, desde a preparação do ambiente até a estimação de parâmetros populacionais com correção para população finita. A abordagem apresentada garante que todos os estratos da população estejam adequadamente representados na amostra, resultando em estimativas mais precisas e confiáveis.

O uso do pacote survey permite incorporar o desenho amostral complexo nas estimativas, produzindo erros padrão apropriados e intervalos de confiança válidos para os parâmetros populacionais de interesse.

Referências

Lumley, T. (2004). “Analysis of Complex Survey Samples”. Journal of Statistical Software.
Cochran, W. G. (1977). “Sampling Techniques”. 3rd ed. John Wiley & Sons.
Sarndal, C. E., Swensson, B., & Wretman, J. (1992). “Model Assisted Survey Sampling”. Springer-Verlag.
Documentação do pacote sampling: https://cran.r-project.org/web/packages/sampling/
Documentação do pacote survey: https://cran.r-project.org/web/packages/survey/

Projeto no GitHub

Amostragem Estratificada em R