--- title: "Classificacao de Imagens RGB com SVM" subtitle: "CEAO-802 - Metodos de Analise de Dados" author: - "1T Generoso" - "1T João Marcos" - "1T Vitor Cesa" format: html: toc: true toc-depth: 3 number-sections: true theme: cosmo df-print: paged execute: warning: false message: false echo: true --- # Introducao Este trabalho aplica tecnicas de classificacao supervisionada ao dataset RGB disponibilizado na disciplina CEAO-802 - Metodos de Analise de Dados. O documento de datasets apresenta um problema de classificacao de cenas urbanas com imagens RGB e TIR coletadas por drone sobre Guaratingueta (SP), com 13 classes de cobertura urbana. Nesta analise sera utilizada apenas a parte RGB do dataset, armazenada localmente em `D:/Vitor/Documents/CEAO/802/HAB/DADOS CEAO 2026/RGB`. A abordagem adotada segue a sugestao do material da disciplina: em vez de extrair atributos estatisticos simples (media, desvio, histogramas), serao utilizadas **redes neurais convolucionais pre-treinadas** como extratores de atributos (*transfer learning*). A rede MobileNetV2, pre-treinada no ImageNet, e carregada sem a camada de classificacao final. Cada imagem e redimensionada para `224x224` pixels e processada pela rede, que produz um vetor de 1280 atributos representando caracteristicas visuais de alto nivel aprendidas em milhoes de imagens. Esses vetores sao entao usados como entrada para os classificadores SVM e Random Forest. A aula de Support Vector Machine (SVM) apresentou o metodo como um classificador baseado na busca de um hiperplano de separacao entre classes. A ideia central e encontrar uma fronteira que maximize a margem entre os grupos. Quando os dados nao sao linearmente separaveis, o SVM pode usar variaveis de folga, controladas pelo parametro `cost`, e tambem kernels, como o kernel radial ou RBF, para criar fronteiras de decisao nao lineares por meio do chamado *kernel trick*. Como a pasta RGB possui grande volume de dados, sera usada uma amostra estratificada e balanceada de 50 imagens por classe. Essa escolha torna o processamento viavel em um computador comum, preservando a comparacao entre as classes. Neste relatorio, serao avaliados: 1. SVM com kernel linear; 2. SVM com kernel radial; 3. SVM radial com ajuste simples de hiperparametros; 4. PCA + SVM radial; 5. Random Forest, como modelo de comparacao. # Preparacao do ambiente ```{r} # ============================================================ # 1. Instalacao e carregamento dos pacotes # ============================================================ pacotes <- c( "tidyverse", "keras3", "caret", "e1071", "randomForest", "knitr" ) pacotes_faltando <- setdiff(pacotes, rownames(installed.packages())) if (length(pacotes_faltando) > 0) { install.packages(pacotes_faltando) } library(tidyverse) library(keras3) library(caret) library(e1071) library(randomForest) library(knitr) backend_ativo <- tryCatch(config_backend(), error = function(e) NA_character_) cat("Backend keras3:", backend_ativo, "\n") ``` # Caminho do dataset Em R, e mais seguro usar barras `/` no caminho, mesmo no Windows. ```{r} # ============================================================ # 2. Caminho do dataset RGB # ============================================================ caminho_rgb <- "../RGB" if (!dir.exists(caminho_rgb)) { stop("A pasta do dataset RGB nao foi encontrada. Verifique o caminho informado em caminho_rgb.") } caminho_rgb ``` # Leitura dos arquivos de imagem O codigo procura imagens dentro da pasta RGB. Se o dataset estiver organizado em subpastas, o nome da subpasta sera usado como classe. No dataset usado neste trabalho, os arquivos TIFF estao diretamente na pasta `RGB`, entao a classe e inferida pelo prefixo do nome do arquivo, como `C1`, `C2`, ..., `C13`. ```{r} # ============================================================ # 3. Listar imagens # ============================================================ extensoes_imagem <- "\\.(jpg|jpeg|png|bmp|tif|tiff)$" arquivos <- list.files( path = caminho_rgb, pattern = extensoes_imagem, recursive = TRUE, full.names = TRUE, ignore.case = TRUE ) if (length(arquivos) == 0) { stop("Nenhuma imagem foi encontrada na pasta RGB.") } length(arquivos) ``` ```{r} # ============================================================ # 4. Criar metadados # ============================================================ obter_classe <- function(arquivo, raiz) { arquivo_norm <- normalizePath(arquivo, winslash = "/", mustWork = FALSE) raiz_norm <- normalizePath(raiz, winslash = "/", mustWork = FALSE) nome_sem_extensao <- tools::file_path_sans_ext(basename(arquivo)) classe_inferida <- stringr::str_extract(nome_sem_extensao, "^C\\d+") if (!is.na(classe_inferida)) { return(classe_inferida) } caminho_relativo <- stringr::str_remove( arquivo_norm, paste0("^", stringr::fixed(raiz_norm), "/?") ) partes <- strsplit(caminho_relativo, "/", fixed = TRUE)[[1]] if (length(partes) >= 2) { return(partes[1]) } stringr::str_extract(nome_sem_extensao, "^[^_-]+") } metadados_completo <- tibble( arquivo = arquivos, classe = map_chr(arquivos, obter_classe, raiz = caminho_rgb) ) %>% mutate( classe = factor(classe, levels = paste0("C", 1:13)), tamanho_mb = file.info(arquivo)$size / 1024^2 ) %>% arrange(classe, arquivo) resumo_dataset <- metadados_completo %>% group_by(classe) %>% summarise( n_imagens = n(), tamanho_total_mb = sum(tamanho_mb, na.rm = TRUE), tamanho_medio_mb = mean(tamanho_mb, na.rm = TRUE), .groups = "drop" ) resumo_dataset %>% mutate(across(where(is.numeric), ~ round(.x, 2))) %>% kable() ``` # Amostra balanceada A amostragem estratificada foi usada para manter a mesma quantidade de imagens em cada classe. Isso evita que classes maiores dominem o treinamento e reduz o tempo de processamento. ```{r} # ============================================================ # 5. Criar amostra balanceada por classe # ============================================================ set.seed(123) max_imagens_por_classe <- 50 metadados <- metadados_completo %>% group_by(classe) %>% group_modify(~ { qtd <- min(max_imagens_por_classe, nrow(.x)) slice_sample(.x, n = qtd) }) %>% ungroup() %>% mutate(classe = factor(classe, levels = paste0("C", 1:13))) cat("Total de imagens no dataset completo:", nrow(metadados_completo), "\n") cat("Total de imagens na amostra:", nrow(metadados), "\n") metadados %>% count(classe, name = "n_imagens_amostra") %>% arrange(classe) %>% kable() ``` ```{r} ggplot(metadados, aes(x = classe)) + geom_bar(fill = "#2C7FB8") + coord_flip() + labs( title = "Distribuicao de imagens por classe na amostra", x = "Classe", y = "Numero de imagens" ) + theme_minimal() ``` # Modelo pre-treinado (Transfer Learning) A estrategia de *transfer learning* consiste em usar uma rede neural convolucional (CNN) ja treinada em um grande dataset — neste caso, o ImageNet, com mais de 1 milhao de imagens e 1000 classes — e aproveitá-la como extrator de atributos. A rede escolhida e a **MobileNetV2**, uma arquitetura compacta e eficiente desenvolvida pelo Google. Ela e carregada sem a camada de classificacao final (`include_top = FALSE`) e com pooling global medio (`pooling = "avg"`), o que produz um vetor de **1280 atributos** por imagem. Esses atributos representam caracteristicas visuais de alto nivel (bordas, texturas, formas, padroes complexos) que a rede aprendeu ao longo de seu treinamento no ImageNet. ```{r} # ============================================================ # 6. Carregar modelo pre-treinado MobileNetV2 # ============================================================ modelo_base <- application_mobilenet_v2( include_top = FALSE, weights = "imagenet", pooling = "avg", input_shape = c(224L, 224L, 3L) ) cat("Modelo carregado:", modelo_base$name, "\n") cat("Dimensao do vetor de features:", modelo_base$output_shape[[2]], "\n") ``` # Extracao de atributos por Transfer Learning Cada imagem e redimensionada para `224x224` pixels (formato padrao do MobileNetV2), normalizada com a funcao de preprocessamento especifica da rede e entao passada pela CNN. O vetor de saida e armazenado como atributos da imagem. O processamento e feito em lotes (*batch*) para maior eficiencia, e o resultado e armazenado em cache para evitar reprocessamento em execucoes posteriores. ```{r} # ============================================================ # 7. Extracao de features via CNN pre-treinada (com cache) # ============================================================ pasta_saida <- "outputs_parcial" dir.create(pasta_saida, recursive = TRUE, showWarnings = FALSE) arquivo_cache_features <- file.path(pasta_saida, "features_rgb_mobilenetv2.rds") arquivo_cache_parcial <- file.path(pasta_saida, "features_rgb_mobilenetv2_temp.rds") tamanho_imagem <- 224L tamanho_lote <- 16L extrair_features_batch <- function(arquivos, modelo, tamanho = 224L, lote = 16L) { n <- length(arquivos) resultados <- matrix(NA_real_, nrow = n, ncol = as.integer(modelo$output_shape[[2]])) for (inicio in seq(1, n, by = lote)) { fim <- min(inicio + lote - 1L, n) bloco <- arquivos[inicio:fim] tam_bloco <- length(bloco) batch_array <- array(0, dim = c(tam_bloco, tamanho, tamanho, 3L)) for (j in seq_len(tam_bloco)) { img <- image_load(bloco[j], target_size = c(tamanho, tamanho)) batch_array[j, , , ] <- image_to_array(img) } batch_prep <- (batch_array / 127.5) - 1.0 features <- predict(modelo, batch_prep, verbose = 0L) resultados[inicio:fim, ] <- features } resultados } if (file.exists(arquivo_cache_features)) { dados <- readRDS(arquivo_cache_features) cat("Features carregadas do cache:", arquivo_cache_features, "\n") } else { cat("Extraindo features com MobileNetV2. Isso pode levar alguns minutos...\n") erros_idx <- integer(0) if (file.exists(arquivo_cache_parcial)) { features_matrix <- readRDS(arquivo_cache_parcial) linhas_prontas <- which(complete.cases(features_matrix)) cat("Cache parcial encontrado:", length(linhas_prontas), "imagens ja processadas.\n") } else { n_features <- as.integer(modelo_base$output_shape[[2]]) features_matrix <- matrix(NA_real_, nrow = nrow(metadados), ncol = n_features) linhas_prontas <- integer(0) } linhas_pendentes <- setdiff(seq_len(nrow(metadados)), linhas_prontas) if (length(linhas_pendentes) > 0) { for (inicio in seq(1, length(linhas_pendentes), by = tamanho_lote)) { fim <- min(inicio + tamanho_lote - 1L, length(linhas_pendentes)) idxs <- linhas_pendentes[inicio:fim] arquivos_bloco <- metadados$arquivo[idxs] resultado <- tryCatch( extrair_features_batch(arquivos_bloco, modelo_base, tamanho_imagem, length(idxs)), error = function(e) { message("Erro no lote ", inicio, "-", fim, ": ", conditionMessage(e)) erros_idx <<- c(erros_idx, idxs) NULL } ) if (!is.null(resultado)) { features_matrix[idxs, ] <- resultado } cat(sprintf(" Processadas: %d / %d\r", min(fim, length(linhas_pendentes)), length(linhas_pendentes))) if (fim %% (tamanho_lote * 5L) == 0L) { saveRDS(features_matrix, arquivo_cache_parcial) } } cat("\n") saveRDS(features_matrix, arquivo_cache_parcial) } imagens_ok <- complete.cases(features_matrix) n_features <- ncol(features_matrix) nomes_feat <- paste0("feat_", stringr::str_pad(seq_len(n_features), 4, pad = "0")) colnames(features_matrix) <- nomes_feat dados <- bind_cols( metadados[imagens_ok, ], as_tibble(features_matrix[imagens_ok, ]) ) if (length(erros_idx) > 0) { erros_df <- metadados[erros_idx, ] %>% mutate(erro = "falha na extracao CNN") arquivo_erros <- file.path(pasta_saida, "erros_processamento_rgb.csv") write_csv(erros_df, arquivo_erros) cat("Imagens com erro:", length(erros_idx), "(ver", arquivo_erros, ")\n") } saveRDS(dados, arquivo_cache_features) if (file.exists(arquivo_cache_parcial)) file.remove(arquivo_cache_parcial) cat("Features salvas em:", arquivo_cache_features, "\n") } cat("Imagens na base final:", nrow(dados), "\n") cat("Numero de atributos extraidos (MobileNetV2):", ncol(dados) - 3L, "\n") ``` ```{r} dados %>% count(classe, name = "n_imagens_processadas") %>% arrange(classe) %>% kable() ``` ```{r} dados %>% select(arquivo, classe, feat_0001, feat_0002, feat_0003, feat_0004, feat_0005) %>% head(10) %>% mutate(across(starts_with("feat_"), ~ round(.x, 4))) %>% kable() ``` # Separacao entre treino e teste A separacao treino/teste sera feita de forma estratificada, mantendo a proporcao das classes sempre que possivel. ```{r} # ============================================================ # 8. Separacao treino/teste # ============================================================ set.seed(123) idx_treino <- createDataPartition( y = dados$classe, p = 0.70, list = FALSE ) treino <- dados[idx_treino, ] teste <- dados[-idx_treino, ] cat("Imagens no treino:", nrow(treino), "\n") cat("Imagens no teste:", nrow(teste), "\n") treino %>% count(classe, name = "treino") %>% full_join( teste %>% count(classe, name = "teste"), by = "classe" ) %>% arrange(classe) %>% kable() ``` # Pre-processamento Como o SVM e sensivel a escala das variaveis, os atributos serao centralizados e padronizados. Tambem serao removidas variaveis com variancia quase nula. ```{r} # ============================================================ # 9. Preparar matrizes X e vetor y # ============================================================ colunas_nao_preditoras <- c("arquivo", "classe", "tamanho_mb") x_treino <- treino %>% select(-all_of(colunas_nao_preditoras)) x_teste <- teste %>% select(-all_of(colunas_nao_preditoras)) y_treino <- droplevels(treino$classe) y_teste <- factor(teste$classe, levels = levels(y_treino)) variaveis_nzv <- nearZeroVar(x_treino) if (length(variaveis_nzv) > 0) { x_treino <- x_treino[, -variaveis_nzv, drop = FALSE] x_teste <- x_teste[, colnames(x_treino), drop = FALSE] } preproc <- preProcess( x_treino, method = c("center", "scale") ) x_treino_norm <- predict(preproc, x_treino) x_teste_norm <- predict(preproc, x_teste) cat("Preditores usados nos modelos:", ncol(x_treino_norm), "\n") ``` # Modelo 1: SVM linear O SVM linear tenta separar as classes por hiperplanos lineares. E o modelo mais simples e serve como referencia inicial. ```{r} # ============================================================ # 10. SVM linear # ============================================================ set.seed(123) modelo_svm_linear <- svm( x = x_treino_norm, y = y_treino, kernel = "linear", cost = 1, scale = FALSE ) pred_svm_linear <- predict(modelo_svm_linear, x_teste_norm) cm_svm_linear <- confusionMatrix(pred_svm_linear, y_teste) cm_svm_linear ``` # Modelo 2: SVM radial O kernel radial, tambem chamado de RBF, permite construir fronteiras de decisao nao lineares. Nesta primeira versao, serao usados valores fixos para `cost` e `gamma`. ```{r} # ============================================================ # 11. SVM radial com parametros fixos # ============================================================ set.seed(123) modelo_svm_radial <- svm( x = x_treino_norm, y = y_treino, kernel = "radial", cost = 10, gamma = 0.01, scale = FALSE ) pred_svm_radial <- predict(modelo_svm_radial, x_teste_norm) cm_svm_radial <- confusionMatrix(pred_svm_radial, y_teste) cm_svm_radial ``` # Modelo 3: Ajuste de hiperparametros do SVM radial O parametro `cost` controla o quanto o modelo penaliza erros de classificacao. O parametro `gamma` influencia o alcance do kernel radial. Valores maiores podem gerar fronteiras mais complexas. ```{r} # ============================================================ # 12. Ajuste simples de hiperparametros do SVM radial # ============================================================ set.seed(123) k_cv <- min(5, as.integer(min(table(y_treino)))) if (k_cv >= 2) { ajuste_svm_radial <- tune.svm( x = x_treino_norm, y = y_treino, kernel = "radial", cost = c(0.1, 1, 10, 100), gamma = c(0.001, 0.01, 0.05, 0.1), tunecontrol = tune.control(cross = k_cv) ) modelo_svm_radial_ajustado <- ajuste_svm_radial$best.model pred_svm_radial_ajustado <- predict( modelo_svm_radial_ajustado, x_teste_norm ) cm_svm_radial_ajustado <- confusionMatrix( pred_svm_radial_ajustado, y_teste ) ajuste_svm_radial$best.parameters %>% kable() } else { warning("Poucas amostras por classe para validacao cruzada. O ajuste automatico sera ignorado.") ajuste_svm_radial <- NULL modelo_svm_radial_ajustado <- modelo_svm_radial pred_svm_radial_ajustado <- pred_svm_radial cm_svm_radial_ajustado <- cm_svm_radial } ``` ```{r} cm_svm_radial_ajustado ``` # Modelo 4: PCA + SVM radial O PCA transforma os atributos originais em componentes principais. Aqui, serao mantidos componentes suficientes para explicar pelo menos 95% da variancia, com limite maximo de 30 componentes. ```{r} # ============================================================ # 13. PCA # ============================================================ pca <- prcomp( x_treino_norm, center = FALSE, scale. = FALSE ) variancia <- pca$sdev^2 variancia_exp <- variancia / sum(variancia) variancia_acum <- cumsum(variancia_exp) n_comp_95 <- which(variancia_acum >= 0.95)[1] n_comp <- min(n_comp_95, 30, ncol(x_treino_norm)) cat("Componentes necessarios para 95% da variancia:", n_comp_95, "\n") cat("Componentes usados no modelo:", n_comp, "\n") ``` ```{r} tibble( componente = seq_along(variancia_acum), variancia_acumulada = variancia_acum ) %>% ggplot(aes(x = componente, y = variancia_acumulada)) + geom_line(color = "#2C7FB8") + geom_point(color = "#2C7FB8") + geom_hline(yintercept = 0.95, linetype = "dashed") + labs( title = "Variancia acumulada pelo PCA", x = "Numero de componentes principais", y = "Variancia acumulada" ) + theme_minimal() ``` ```{r} x_treino_pca <- as.data.frame(pca$x[, 1:n_comp, drop = FALSE]) x_teste_pca <- as.data.frame( predict(pca, newdata = x_teste_norm)[, 1:n_comp, drop = FALSE] ) set.seed(123) modelo_svm_pca <- svm( x = x_treino_pca, y = y_treino, kernel = "radial", cost = 10, gamma = 0.01, scale = FALSE ) pred_svm_pca <- predict(modelo_svm_pca, x_teste_pca) cm_svm_pca <- confusionMatrix(pred_svm_pca, y_teste) cm_svm_pca ``` ```{r} scores_pca <- as_tibble(pca$x[, 1:2, drop = FALSE]) %>% mutate(classe = y_treino) ggplot(scores_pca, aes(x = PC1, y = PC2, color = classe)) + geom_point(alpha = 0.8) + labs( title = "Visualizacao do conjunto de treino no espaco PCA", x = "PC1", y = "PC2", color = "Classe" ) + theme_minimal() ``` # Modelo 5: Random Forest O Random Forest sera usado como classificador de comparacao. Ele costuma lidar bem com relacoes nao lineares e tambem permite estimar a importancia das variaveis. ```{r} # ============================================================ # 14. Random Forest # ============================================================ set.seed(123) modelo_rf <- randomForest( x = x_treino_norm, y = y_treino, ntree = 500, importance = TRUE ) pred_rf <- predict(modelo_rf, x_teste_norm) cm_rf <- confusionMatrix(pred_rf, y_teste) cm_rf ``` # Comparacao dos modelos Os modelos serao comparados por acuracia, Kappa, sensibilidade macro, especificidade macro e F1 macro. ```{r} # ============================================================ # 15. Funcao de avaliacao dos modelos # ============================================================ avaliar_modelo <- function(nome, matriz_confusao) { overall <- matriz_confusao$overall by_class <- matriz_confusao$byClass if (is.matrix(by_class)) { sensibilidade_macro <- mean(by_class[, "Sensitivity"], na.rm = TRUE) especificidade_macro <- mean(by_class[, "Specificity"], na.rm = TRUE) f1_macro <- mean(by_class[, "F1"], na.rm = TRUE) } else { sensibilidade_macro <- by_class["Sensitivity"] especificidade_macro <- by_class["Specificity"] f1_macro <- by_class["F1"] } tibble( modelo = nome, acuracia = as.numeric(overall["Accuracy"]), kappa = as.numeric(overall["Kappa"]), sensibilidade_macro = as.numeric(sensibilidade_macro), especificidade_macro = as.numeric(especificidade_macro), f1_macro = as.numeric(f1_macro) ) } resultados <- bind_rows( avaliar_modelo("SVM linear", cm_svm_linear), avaliar_modelo("SVM radial", cm_svm_radial), avaliar_modelo("SVM radial ajustado", cm_svm_radial_ajustado), avaliar_modelo("PCA + SVM radial", cm_svm_pca), avaliar_modelo("Random Forest", cm_rf) ) %>% arrange(desc(acuracia)) resultados %>% mutate(across(where(is.numeric), ~ round(.x, 4))) %>% kable() ``` ```{r} ggplot(resultados, aes(x = reorder(modelo, acuracia), y = acuracia)) + geom_col(fill = "#2C7FB8") + coord_flip() + labs( title = "Comparacao da acuracia dos modelos", x = "Modelo", y = "Acuracia" ) + theme_minimal() ``` ```{r} resultados_long <- resultados %>% pivot_longer( cols = c(acuracia, kappa, sensibilidade_macro, especificidade_macro, f1_macro), names_to = "metrica", values_to = "valor" ) ggplot(resultados_long, aes(x = reorder(modelo, valor), y = valor, fill = metrica)) + geom_col(show.legend = FALSE) + coord_flip() + facet_wrap(~ metrica, scales = "free_x") + labs( title = "Metricas comparativas dos modelos", x = "Modelo", y = "Valor" ) + theme_minimal() ``` # Melhor modelo ```{r} melhor_modelo <- resultados$modelo[1] cat("Melhor modelo pela acuracia:", melhor_modelo, "\n") ``` ```{r} cm_melhor <- switch( melhor_modelo, "SVM linear" = cm_svm_linear, "SVM radial" = cm_svm_radial, "SVM radial ajustado" = cm_svm_radial_ajustado, "PCA + SVM radial" = cm_svm_pca, "Random Forest" = cm_rf ) as.data.frame(cm_melhor$table) %>% ggplot(aes(x = Reference, y = Prediction, fill = Freq)) + geom_tile(color = "white") + geom_text(aes(label = Freq), size = 3) + scale_fill_gradient(low = "#F7FBFF", high = "#08519C") + labs( title = paste("Matriz de confusao -", melhor_modelo), x = "Classe real", y = "Classe prevista", fill = "Frequencia" ) + theme_minimal() + theme(axis.text.x = element_text(angle = 45, hjust = 1)) ``` # Importancia das variaveis A importancia das variaveis sera estimada pelo Random Forest. Essa etapa ajuda a observar quais atributos contribuiram mais para a classificacao. ```{r} # ============================================================ # 16. Importancia das variaveis # ============================================================ importancia <- importance(modelo_rf) coluna_importancia <- if ("MeanDecreaseGini" %in% colnames(importancia)) { "MeanDecreaseGini" } else { colnames(importancia)[1] } importancia_df <- tibble( variavel = rownames(importancia), importancia = importancia[, coluna_importancia] ) %>% arrange(desc(importancia)) importancia_df %>% slice_head(n = 20) %>% kable() ``` ```{r} importancia_df %>% slice_head(n = 20) %>% ggplot(aes(x = reorder(variavel, importancia), y = importancia)) + geom_col(fill = "#2C7FB8") + coord_flip() + labs( title = "20 variaveis mais importantes segundo o Random Forest", x = "Variavel", y = "Importancia" ) + theme_minimal() ``` # Salvamento dos resultados ```{r} # ============================================================ # 17. Salvar saidas # ============================================================ dir.create(pasta_saida, recursive = TRUE, showWarnings = FALSE) write_csv(dados, file.path(pasta_saida, "features_rgb.csv")) write_csv(resultados, file.path(pasta_saida, "resultados_modelos_rgb.csv")) write_csv(importancia_df, file.path(pasta_saida, "importancia_variaveis_rgb.csv")) saveRDS( list( preproc = preproc, modelo_svm_linear = modelo_svm_linear, modelo_svm_radial = modelo_svm_radial, ajuste_svm_radial = ajuste_svm_radial, modelo_svm_radial_ajustado = modelo_svm_radial_ajustado, modelo_svm_pca = modelo_svm_pca, modelo_rf = modelo_rf, pca = pca, resultados = resultados, extrator_cnn = "MobileNetV2 (ImageNet, sem topo, pooling=avg, 1280 features)" ), file.path(pasta_saida, "modelos_rgb.rds") ) cat("Arquivos salvos em:", pasta_saida, "\n") ``` # Validacao Cruzada K-Fold Na abordagem anterior (holdout), o conjunto de dados foi dividido uma unica vez em treino (70%) e teste (30%). Isso pode gerar uma estimativa otimista ou pessimista do desempenho real, dependendo de como a divisao ocorreu. A validacao cruzada k-fold resolve esse problema dividindo o dataset em `k` partes iguais e estratificadas. Em cada rodada, uma parte diferente e usada como teste e as restantes como treino. O desempenho final e a media das `k` rodadas, o que aproveita todas as observacoes para avaliacao e produz uma estimativa mais estavel. Nesta etapa, sera usado `k=5`. Para manter a avaliacao independente do holdout, o SVM radial ajustado tera `cost` e `gamma` reotimizados dentro de cada fold, usando apenas os dados de treino daquele fold. ```{r} # ============================================================ # 18. Validacao cruzada k-fold (k=5, estratificada) # ============================================================ set.seed(123) k_folds <- 5L folds <- createFolds(dados$classe, k = k_folds, list = TRUE, returnTrain = FALSE) grade_cost_kfold <- c(1, 10, 100) grade_gamma_kfold <- c(0.001, 0.01, 0.05, 0.1) metricas_folds <- vector("list", k_folds) for (fold_i in seq_len(k_folds)) { idx_teste <- folds[[fold_i]] idx_treino <- setdiff(seq_len(nrow(dados)), idx_teste) fold_treino <- dados[idx_treino, ] fold_teste <- dados[idx_teste, ] x_fold_tr <- fold_treino %>% select(-all_of(colunas_nao_preditoras)) x_fold_te <- fold_teste %>% select(-all_of(colunas_nao_preditoras)) y_fold_tr <- droplevels(fold_treino$classe) y_fold_te <- factor(fold_teste$classe, levels = levels(y_fold_tr)) nzv_fold <- nearZeroVar(x_fold_tr) if (length(nzv_fold) > 0) { x_fold_tr <- x_fold_tr[, -nzv_fold, drop = FALSE] x_fold_te <- x_fold_te[, colnames(x_fold_tr), drop = FALSE] } pp_fold <- preProcess(x_fold_tr, method = c("center", "scale")) x_fold_tr_n <- predict(pp_fold, x_fold_tr) x_fold_te_n <- predict(pp_fold, x_fold_te) m1 <- svm(x = x_fold_tr_n, y = y_fold_tr, kernel = "linear", cost = 1, scale = FALSE) m2 <- svm(x = x_fold_tr_n, y = y_fold_tr, kernel = "radial", cost = 10, gamma = 0.01, scale = FALSE) k_cv_fold <- min(5L, min(table(y_fold_tr))) ajuste_fold <- tune.svm( x = x_fold_tr_n, y = y_fold_tr, kernel = "radial", cost = grade_cost_kfold, gamma = grade_gamma_kfold, tunecontrol = tune.control(cross = k_cv_fold) ) m3 <- ajuste_fold$best.model pca_fold <- prcomp(x_fold_tr_n, center = FALSE, scale. = FALSE) var_acum_f <- cumsum(pca_fold$sdev^2 / sum(pca_fold$sdev^2)) n_comp_f <- min(which(var_acum_f >= 0.95)[1], 30L, ncol(x_fold_tr_n)) x_pca_tr <- as.data.frame(pca_fold$x[, 1:n_comp_f, drop = FALSE]) x_pca_te <- as.data.frame(predict(pca_fold, x_fold_te_n)[, 1:n_comp_f, drop = FALSE]) m4 <- svm(x = x_pca_tr, y = y_fold_tr, kernel = "radial", cost = 10, gamma = 0.01, scale = FALSE) m5 <- randomForest(x = x_fold_tr_n, y = y_fold_tr, ntree = 200L) metricas_folds[[fold_i]] <- bind_rows( avaliar_modelo("SVM linear", confusionMatrix(predict(m1, x_fold_te_n), y_fold_te)), avaliar_modelo("SVM radial", confusionMatrix(predict(m2, x_fold_te_n), y_fold_te)), avaliar_modelo("SVM radial ajustado", confusionMatrix(predict(m3, x_fold_te_n), y_fold_te)), avaliar_modelo("PCA + SVM radial", confusionMatrix(predict(m4, x_pca_te), y_fold_te)), avaliar_modelo("Random Forest", confusionMatrix(predict(m5, x_fold_te_n), y_fold_te)) ) %>% mutate(fold = fold_i) cat(sprintf( "Fold %d/%d concluido. SVM ajustado: cost = %s | gamma = %s\n", fold_i, k_folds, ajuste_fold$best.parameters$cost, ajuste_fold$best.parameters$gamma )) } ``` ```{r} resultados_kfold <- bind_rows(metricas_folds) %>% group_by(modelo) %>% summarise(across(c(acuracia, kappa, sensibilidade_macro, especificidade_macro, f1_macro), mean), .groups = "drop") %>% arrange(desc(acuracia)) write_csv(resultados_kfold, file.path(pasta_saida, "resultados_kfold_rgb.csv")) resultados_kfold %>% mutate(across(where(is.numeric), ~ round(.x, 4))) %>% kable(caption = "Acuracia media - K-Fold (k=5)") ``` ```{r} ggplot(resultados_kfold, aes(x = reorder(modelo, acuracia), y = acuracia)) + geom_col(fill = "#E06C00") + coord_flip() + labs( title = "Acuracia media - Validacao cruzada 5-fold", x = "Modelo", y = "Acuracia media" ) + theme_minimal() ``` # Comparacao: Holdout vs K-Fold ```{r} # ============================================================ # 19. Comparacao direta entre as duas estrategias # ============================================================ comparacao <- bind_rows( resultados %>% mutate(estrategia = "Holdout 70/30"), resultados_kfold %>% mutate(estrategia = "K-Fold (k=5)") ) %>% select(estrategia, modelo, acuracia, kappa, f1_macro) %>% arrange(estrategia, desc(acuracia)) comparacao %>% mutate(across(where(is.numeric), ~ round(.x, 4))) %>% kable(caption = "Comparacao entre Holdout 70/30 e Validacao Cruzada K-Fold") ``` ```{r} ggplot(comparacao, aes(x = reorder(modelo, acuracia), y = acuracia, fill = estrategia)) + geom_col(position = "dodge") + coord_flip() + scale_fill_manual(values = c("Holdout 70/30" = "#2C7FB8", "K-Fold (k=5)" = "#E06C00")) + labs( title = "Acuracia: Holdout 70/30 vs K-Fold (k=5)", x = "Modelo", y = "Acuracia", fill = "Estrategia" ) + theme_minimal() ``` ```{r} melhor_holdout <- max(resultados$acuracia) melhor_kf <- max(resultados_kfold$acuracia) melhor_metodo <- if (melhor_kf >= melhor_holdout) "K-Fold (k=5)" else "Holdout 70/30" resultados_finais <- if (melhor_kf >= melhor_holdout) resultados_kfold else resultados cat("Acuracia maxima - Holdout:", round(melhor_holdout, 4), "\n") cat("Acuracia maxima - K-Fold: ", round(melhor_kf, 4), "\n") cat("Metodo adotado como referencia:", melhor_metodo, "\n") ``` # Discussao Os resultados permitem comparar diferentes classificadores aplicados sobre atributos extraidos por *transfer learning* com a rede MobileNetV2, e tambem avaliar o impacto da estrategia de avaliacao adotada. A extracao de atributos por CNN pre-treinada substitui o calculo manual de medias, desvios e histogramas de cor por um vetor de 1280 atributos que codificam padroes visuais de alto nivel aprendidos em mais de um milhao de imagens do ImageNet. Essa representacao tende a ser muito mais discriminativa para problemas de classificacao de cenas. O SVM linear busca fronteiras lineares nesse espaco de 1280 dimensoes. O SVM radial permite fronteiras nao lineares, sendo mais flexivel. O PCA reduz a dimensionalidade antes do SVM, eliminando redundancias entre as 1280 features da CNN. O Random Forest serve como referencia nao-linear e permite identificar quais atributos foram mais relevantes. **Sobre a estrategia de avaliacao:** na primeira abordagem, o dataset foi dividido uma unica vez em 70% treino e 30% teste (holdout). Embora simples, esse metodo pode gerar estimativas instáveis com datasets de tamanho moderado, pois o resultado depende de como essa divisao ocorreu. Para verificar se os resultados eram representativos, o experimento foi repetido com validacao cruzada k-fold com k=5: o dataset e dividido em 5 partes estratificadas e, em cada rodada, uma parte diferente e usada como teste. O desempenho final e a media das 5 rodadas. ```{r} if (melhor_kf >= melhor_holdout) { cat("O k-fold produziu acuracia igual ou superior ao holdout, sendo adotado como resultado principal.\n") } else { cat("O holdout produziu acuracia superior ao k-fold. Isso pode indicar que a divisao holdout foi favoravel.\n", "O k-fold e metodologicamente mais robusto, mas neste caso o holdout resultou em estimativa mais otimista.\n") } ``` # Conclusao Este trabalho implementou uma pipeline de classificacao de imagens RGB baseada em *transfer learning*, reducao de dimensionalidade e classificadores supervisionados, avaliada por duas estrategias distintas. A estrategia de usar a MobileNetV2 pre-treinada como extrator de atributos, seguida de SVM ou Random Forest, combina o poder de representacao das redes neurais com a interpretabilidade dos classificadores classicos, sem necessidade de treinar a CNN do zero. ```{r} cat(sprintf( "O melhor resultado foi obtido com '%s' usando a estrategia '%s', com acuracia de %.1f%%.\n", resultados_finais$modelo[1], melhor_metodo, max(resultados_finais$acuracia) * 100 )) ``` Como expansao futura, o trabalho pode ser repetido com outros extratores CNN presentes no material da disciplina (EfficientNetB0, ResNet50, VGG19) e com a incorporacao das imagens TIR ao vetor de atributos, aproveitando a informacao termica disponivel no dataset.