Análise Florística Chaco
T.R.F. Sinani
2026-06-08
Conjunto de dados
Este é um documento anexo que pertence ao artigo intitulado “Analyzing beta-diversity and the biogeographical delimitation of forest and woody savanna formations in South America”, de autoria de Ângela Lúcia Bagnatori Sartori, Geraldo Alves Damasceno Junior, Emerson Pereira da Silva, Giovana Amaral Umar, Isabela Oliveira Ferreira, Mateus César Araújo Pestana, Maxwell da Rosa Oliveira, Thomaz Ricardo Favreto Sinani e Flávio Macedo Alves
Estas análises são baseadas em 112 referencias artigos e base de dados dos autores realizados em remanescentes de Chaco e ecorregiões adjacentes. Nós compilamos dados de ocorrência de 1.625 táxons da flora em 307 localidades, que podem ser acessados no Material Suplementar “matrix_original.xlsx” e as análises replicadas seguindo este roteiro.
1. Carregamento de pacotes
library(readxl)
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.1 ✔ readr 2.2.0
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.3 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(vegan)## Carregando pacotes exigidos: permutelibrary(betapart)
library(venn)
library(ggrepel)
library(dendextend)## Registered S3 method overwritten by 'dendextend':
## method from
## rev.hclust vegan
##
## ---------------------
## Welcome to dendextend version 1.19.1
## Type citation('dendextend') for how to cite the package.
##
## Type browseVignettes(package = 'dendextend') for the package vignette.
## The github page is: https://github.com/talgalili/dendextend/
##
## Suggestions and bug-reports can be submitted at: https://github.com/talgalili/dendextend/issues
## You may ask questions at stackoverflow, use the r and dendextend tags:
## https://stackoverflow.com/questions/tagged/dendextend
##
## To suppress this message use: suppressPackageStartupMessages(library(dendextend))
## ---------------------
##
##
## Anexando pacote: 'dendextend'
##
## O seguinte objeto é mascarado por 'package:permute':
##
## shuffle
##
## O seguinte objeto é mascarado por 'package:stats':
##
## cutreelibrary(geosphere)
library(ggplot2)
library(venn)
library(dplyr)
library(tidyr)
library(indicspecies)
library(rgbif)
library(sf)## Linking to GEOS 3.14.1, GDAL 3.12.1, PROJ 9.7.1; sf_use_s2() is TRUElibrary(terra)## terra 1.9.34
##
## Anexando pacote: 'terra'
##
## O seguinte objeto é mascarado por 'package:dendextend':
##
## rotate
##
## O seguinte objeto é mascarado por 'package:tidyr':
##
## extractlibrary(circlize)## ========================================
## circlize version 0.4.18
## CRAN page: https://cran.r-project.org/package=circlize
## Github page: https://github.com/jokergoo/circlize
## Documentation: https://jokergoo.github.io/circlize_book/book/
##
## If you use it in published research, please cite:
## Gu, Z. circlize implements and enhances circular visualization
## in R. Bioinformatics 2014.
##
## This message can be suppressed by:
## suppressPackageStartupMessages(library(circlize))
## ========================================set.seed(123)Anotações: se houver erro, os pacotes devem ser previamente instalados.
2. Carregamento e estruturação dos dados
2.1. Localidades alvo para caracterização
# Inserir no vetor as áreas que gostaria de obter a caracterização
local_target <- c("CERDAO_CER_19",
"CHA_PANT_01",
"CHA_PANT_02",
"CHA_PANT_03",
"CHA_PANT_04",
"CHA_PANT_05",
"CHA_PANT_07",
"CHA_PANT_08",
"CHA_PANT_09",
"CHA_PANT_10",
"FES_PANT_01")2.2. Área geográfica dos domínios na delimitação dos dados
# Inserir coordenadas de abrangência dos dados (Bounding Box)
# c(Long_Min, Long_Max, Lat_Min, Lat_Max)
boundary_area <- c(-67.720090, -41.072987, -41.011410, -4.714250)2.3. Base de dados completa
# 2.1. Importar a planilha original
input_matrix <- read_excel("matrix_original.xlsx")
# 2.2. Processar e pivotar os dados
pivot_matrix <- input_matrix %>%
# Selecionar apenas as colunas que contêm localidade e taxa
select(locality, taxa) %>%
# Remover registros duplicados da mesma espécie na mesma localidade
distinct(locality, taxa) %>%
# Criar uma coluna de preenchimento indicando a presença (1)
mutate(presence = 1) %>%
# Pivotar o dataframe: cada 'taxa' vira uma coluna
pivot_wider(names_from = taxa, values_from = presence, values_fill = 0)
# 2.3. Ajustar os nomes das linhas (rownames) e converter para matriz numérica
# Transformar em data.frame clássico para habilitar rownames
matriz_df <- as.data.frame(pivot_matrix)
# Definir a coluna 'locality' como o identificador de cada linha
rownames(matriz_df) <- matriz_df$locality
# Remover a coluna de texto 'locality' que ficou residual
matriz_df <- matriz_df %>% select(-locality)
# Converter formalmente para a classe 'matrix' do R
matrix_PA <- as.matrix(matriz_df)
# 2.4 Limpeza Recursiva da Matriz (manter localidades >= 5 e espécies > 1 [que ocorrem em mais de uma localidade])
# Criar uma cópia da matriz original para iniciar o processo
matrix_PA_clean <- matrix_PA
# Variáveis para o relatório final
initial_row <- nrow(matrix_PA_clean)
initial_col <- ncol(matrix_PA_clean)
iteration <- 0
# Iniciar o Loop: "Enquanto houver locais com <5 OU espécies com <=1"
while(any(rowSums(matrix_PA_clean) < 5) | any(colSums(matrix_PA_clean) <= 1)) {
iteration <- iteration + 1
# Manter apenas localidades com 5 ou mais espécies
valid_rows <- rowSums(matrix_PA_clean) >= 5
matrix_PA_clean <- matrix_PA_clean[valid_rows, , drop = FALSE]
# Manter apenas espécies que ocorrem em mais de 1 localidade (Remove Singletons)
valid_cols <- colSums(matrix_PA_clean) > 1
matrix_PA_clean <- matrix_PA_clean[, valid_cols, drop = FALSE]
# Proteção: Se a matriz esvaziar completamente (raro, mas seguro programar)
if(nrow(matrix_PA_clean) == 0 | ncol(matrix_PA_clean) == 0) {
stop("O filtro foi muito rigoroso e esvaziou a matriz inteira!")
}
}
# Relatório da Limpeza
cat("--- RELATÓRIO DE ESTABILIZAÇÃO DA MATRIZ ---\n")## --- RELATÓRIO DE ESTABILIZAÇÃO DA MATRIZ --- cat("O R atingiu a estabilidade perfeita em", iteration, "ciclos de limpeza.\n\n")## O R atingiu a estabilidade perfeita em 2 ciclos de limpeza. cat("LOCALIDADES (Linhas):\n")## LOCALIDADES (Linhas): cat(" - Originais:", initial_row, "\n")## - Originais: 307 cat(" - Mantidas: ", nrow(matrix_PA_clean), "\n")## - Mantidas: 304 cat(" - Removidas:", initial_row - nrow(matrix_PA_clean), "\n\n")## - Removidas: 3 cat("ESPÉCIES (Colunas):\n")## ESPÉCIES (Colunas): cat(" - Originais:", initial_col, "\n")## - Originais: 1625 cat(" - Mantidas: ", ncol(matrix_PA_clean), "\n")## - Mantidas: 1066 cat(" - Removidas:", initial_col - ncol(matrix_PA_clean), "\n")## - Removidas: 559Anotações: a planilha “matrix_original.xlsx” está disponível para download no material suplementar. No momento da preparação dos dados para excluir localidades com táxon < 5 e táxons por localidade <= 1, a matriz foi filtrada iterativamente até a estabilização de ambos os parâmetros.
3. Análise Exploratória de Dados
3.1. Rank-Frequency
# Calcular o número total de ocorrências de cada espécie (soma das colunas)
frequency_sp <- colSums(matrix_PA_clean)
# Ordenar as espécies da mais comum para a mais rara
frequency_order <- sort(frequency_sp, decreasing = TRUE)
# Converter para percentagem (proporção face às N localidades)
percent_ocur <- (frequency_order / nrow(matrix_PA_clean)) * 100
# Criar o gráfico de Frequência-Ordem
plot(percent_ocur,
type = "l", # Desenha uma linha
lwd = 2, col = "blue",
main = "Curva de Frequencia-Ordem das Angiospermas",
xlab = "Ordenacao das Especies (da mais comum a mais rara)",
ylab = "Frequencia de Ocorrencia (%)")
# Adicionar uma linha de corte visual para espécies raras (ex: presentes em menos de 5% das áreas)
abline(h = 5, col = "red", lty = 2)
# Extrair dados interessantes para o artigo:
cat("A espécie mais comum ocorre em", round(percent_ocur[1], 1), "% das áreas.\n")## A espécie mais comum ocorre em 36.2 % das áreas.cat("Número de espécies hiper-raras (<5% de ocorrência):", sum(percent_ocur < 5), "\n")## Número de espécies hiper-raras (<5% de ocorrência): 795Anotações: o gráfico inicia alto à esquerda e cai rapidamente para formar uma cauda em “J” invertido; o alto cruzamento da linha vermelha (espécies raras) no eixo X determina se o conjunto de espécies especialistas locais ou de transição.
3.2. Heatmap
# Preparar a matriz (o R desenha de baixo para cima, então invertemos para ficar intuitivo)
matrix_image <- as.matrix(matrix_PA_clean)
matrix_image <- t(matrix_image)[, nrow(matrix_image):1]
# Gerar o Heatmap
image(x = 1:ncol(matrix_PA_clean),
y = 1:nrow(matrix_PA_clean),
z = matrix_image,
col = c("white", "black"), # 0 (ausência) é branco, 1 (presença) é preto
main = "Mapa de Calor da Matriz de Presença/Ausência",
xlab = "Espécies",
ylab = "Localidades")
Anotações: Os pontos pretos no heatmap representam presença (1) e a parte branca representa ausência (0); é possível detectar agrupamentos prévios das espécies nas localidades.
3.3. Rarefaction
# Calcular a curva de acumulação exata
# 'random' vai misturar as suas N áreas dezenas de vezes para criar uma curva suave
regional_rare <- specaccum(matrix_PA_clean, method = "random", permutations = 100)
# Plotar a curva
plot(regional_rare,
ci.type = "poly", col = "darkgreen", lwd = 2,
ci.lty = 0, ci.col = "lightgreen",
main = "Curva de Acumulacao Regional de Especies",
xlab = "Esforco Amostral (Número de Localidades Adicionadas)",
ylab = "Riqueza Acumulada de Especies")
# Adicionar uma grelha para facilitar a leitura
grid()
Anotações: Foi construída uma curva de acumulação de espécies baseada em amostras (dados de incidência em matriz binária) utilizando permutações aleatórias das localidades.
3.4. Diagrama de Venn/Euler
# Extrair os nomes das localidades da matriz de presença/ausência
# Transformar o nome das linhas em coluna
df_locality <- tibble(locality = rownames(matrix_PA_clean))
# Fazer o Cruzamento (Left Join) para encontrar o 'dominio_bioma' correspondente
df_biome_align <- df_locality %>%
left_join(input_matrix %>% select(locality, domain_biome) %>%
distinct(), by = "locality")
df_biome_align <- df_locality %>%
left_join(input_matrix %>% select(locality, domain_biome) %>% distinct(),
by = "locality")
# Criar o vetor final de biomas
biome_vec <- df_biome_align$domain_biome
# Descobrir quais são os biomas únicos presentes nos dados
biome_uniq <- unique(na.omit(biome_vec))
# Criar a lista de espécies para o diagrama de forma automática
# Usar lapply para varrer cada bioma e extrair as espécies presentes nele
list_venn_dinamic <- lapply(biome_uniq, function(biome_actual) {
# Filtrar a matriz apenas para as linhas deste bioma
row_biome <- matrix_PA_clean[biome_vec == biome_actual, , drop = FALSE]
# Quais espécies têm soma > 0 nestas linhas?
present_sp <- colnames(row_biome)[colSums(row_biome) > 0]
return(present_sp)
})
# Dar os nomes corretos a cada conjunto na lista
names(list_venn_dinamic) <- biome_uniq
# Colar a riqueza total de cada bioma diretamente no nome da categoria
biome_name <- names(list_venn_dinamic)
biome_rich <- sapply(list_venn_dinamic, length)
# Atualizar os nomes na lista com o valor entre parênteses
names(list_venn_dinamic) <- paste0(biome_name, "\n(", biome_rich, " spp.)")
# Gerar o gráfico
venn(list_venn_dinamic,
# --- CORES E SOBREPOSIÇÃO ---
zcolor = "style",
opacity = 0.4,
# --- FORÇAR EXIBIÇÃO DOS NÚMEROS ---
counts = TRUE,
ilcs = 0.5,
sncs = 0.8,
# --- ESTÉTICA GERAL ---
box = FALSE,
borders = FALSE)
Anotações: Os biomas indicados no diagrama de Venn foram obtidos das informações presentes do material consultado com a finalidade de obter uma visão geral desta análise exploratória de dados.
3.5. Detecção de Outliers via Z-Score
# Recalcular os parâmetros na matriz estruturada (matrix_PA_clean)
square_matrix_raw <- as.matrix(vegdist(matrix_PA_clean, method = "jaccard"))
distm_raw <- rowMeans(square_matrix_raw)
z_scores_raw <- (distm_raw - mean(distm_raw)) / sd(distm_raw)
raw_rich <- rowSums(matrix_PA_clean)
# 2. Montar o Data Frame de Diagnóstico
df_diagnostic <- data.frame(
Localidade = rownames(matrix_PA_clean),
Riqueza = raw_rich,
Z_Score = z_scores_raw
)
# 3. Classificar o status de cada área (Aprovada vs. Reprovada)
# Reprovada se Z > 2.0 OU Riqueza < 5
df_diagnostic <- df_diagnostic %>%
mutate(Status = ifelse(Z_Score > 2.0 | Riqueza < 5,
"Excluída (Outlier/Subamostrada)",
"Mantida (Matriz Final)"))
# 4. Gerar o Gráfico de Diagnóstico
ggplot(df_diagnostic, aes(x = Riqueza, y = Z_Score, color = Status)) +
geom_point(alpha = 0.7, size = 2.5) +
# Linha de Corte Matemática (McCune & Grace)
geom_hline(yintercept = 2.0, linetype = "dashed", linewidth = 1, color = "darkred") +
annotate("text", x = max(df_diagnostic$Riqueza) * 0.5, y = 2.25,
label = "Corte Multivariado (Z > 2.0)", color = "darkred", fontface = "bold") +
# Linha de Corte Biológica (Riqueza Mínima)
geom_vline(xintercept = 4.5, linetype = "dotted", linewidth = 1, color = "blue") +
annotate("text", x = 1.5, y = max(df_diagnostic$Z_Score) * 0.85,
label = "Corte Biologico (< 5 spp)", color = "blue", fontface = "bold", angle = 90, hjust = 1) +
theme_bw() +
labs(title = "Diagnostico de Curadoria da Matriz Floristica",
subtitle = "Identificacao de localidades com desvio multivariado extremo ou subamostragem",
x = "Riqueza Floristica (Numero de Especies)",
y = "Distancia Media Multivariada (Z-Score)",
color = "Status da Curadoria:") +
scale_color_manual(values = c("Excluída (Outlier/Subamostrada)" = "red",
"Mantida (Matriz Final)" = "grey40")) +
theme(legend.position = "bottom",
plot.title = element_text(face = "bold"))
Anotações: Gráfico de Dispersão (Scatterplot) cruzando a Riqueza de
Espécies com o Z-score. Mostra que os locais com poucas espécies são os
mesmos que estouraram o limite matemático. O Z-Score acina de 2.0, gera
outliers, que posteriormente podem ser excluídos.
4. Tratamento dos Dados
4.1. Retirada de Outliers e Singletons
# Obter a matriz de distância de Jaccard em formato de tabela completa (quadrada)
square_matrix <- as.matrix(vegdist(matrix_PA_clean, method = "jaccard"))
# Calcular a distância média de cada localidade para todas as outras
local_distm_matrix <- rowMeans(square_matrix)
# Calcular a Grande Média e o Desvio Padrão Geral
large_media <- mean(local_distm_matrix)
sd_general <- sd(local_distm_matrix)
# Cálculo do Z-score (Desvios Padrão) para cada localidade
z_scores <- (local_distm_matrix - large_media) / sd_general
# Identificar quem ultrapassa o corte rigoroso de McCune & Grace (Z > 2.0)
outliers_multi <- which(z_scores > 2.0)
cat("\n--- RESULTADO 2: CRITÉRIO DE McCUNE & GRACE (MULTIVARIADO) ---\n")##
## --- RESULTADO 2: CRITÉRIO DE McCUNE & GRACE (MULTIVARIADO) --- cat("Número de localidades classificadas matematicamente como outliers (Z > 2.0):", length(outliers_multi), "\n")## Número de localidades classificadas matematicamente como outliers (Z > 2.0): 8 if(length(outliers_multi) > 0) {
cat("\nEstas são as localidades problemáticas:\n")
# Criar um resumo focado apenas no Z-score
info_outliers <- data.frame(
Localidade = names(outliers_multi),
Z_Score = round(z_scores[outliers_multi], 2)
)
# Ordenar das piores (Z maior) para as "menos piores"
print(info_outliers[order(-info_outliers$Z_Score), ])
cat("\nCONCLUSÃO: As localidades listadas acima apresentam desvio multivariado extremo (Z-score > 2.0) e serão removidas.\n")
}##
## Estas são as localidades problemáticas:
## Localidade Z_Score
## CHA_SEC_11 CHA_SEC_11 2.65
## CERDAO_CER_33 CERDAO_CER_33 2.48
## CHA_SEC_15 CHA_SEC_15 2.17
## CERDAO_CER_35 CERDAO_CER_35 2.13
## CERDAO_CER_26 CERDAO_CER_26 2.12
## CHA_HYGRO_03 CHA_HYGRO_03 2.07
## FES_AMAZ_01 FES_AMAZ_01 2.04
## CILIAR_CER_17 CILIAR_CER_17 2.03
##
## CONCLUSÃO: As localidades listadas acima apresentam desvio multivariado extremo (Z-score > 2.0) e serão removidas. # Executar o corte do Z-Score na matriz
matrix_PA_clean_inter <- matrix_PA_clean[z_scores <= 2.0, ]
cat("\nApós corte multivariado (Z <= 2.0): Restam", nrow(matrix_PA_clean_inter), "localidades.\n")##
## Após corte multivariado (Z <= 2.0): Restam 296 localidades.Anotações: Passo essencial para garantir a robustez das ordenações subsequentes; o Z-score das distâncias médias foi extraído para detectar e remover localidades que representam anomalias multivariadas extremas (Z > 2.0), evitando distorções no espaço de ordenação.
4.2. Conferência final de baixa riqueza e táxons raros
cat("Limpeza Biológica Recursiva (Riqueza < 5 e Frequência <= 1) ---\n")## Limpeza Biológica Recursiva (Riqueza < 5 e Frequência <= 1) --- # Parâmetros para o ciclo recursivo
iteration_bio <- 1
continue_clean_bio <- TRUE
matrix_PA_clean_recur <- matrix_PA_clean_inter
while(continue_clean_bio) {
cat("[Rodada", iteration_bio, "] ")
# Calcular a riqueza atual (soma das linhas) e frequência atual (soma das colunas)
curren_rich <- rowSums(matrix_PA_clean_recur)
curren_freq <- colSums(matrix_PA_clean_recur)
# Avaliar quem cai na malha fina (Localidades < 5 spp E Espécies <= 1 ocorrência)
loc_remove <- which(curren_rich < 5)
spp_remove <- which(curren_freq <= 1)
# Condição de Paragem: Matriz 100% limpa e estável
if(length(loc_remove) == 0 && length(spp_remove) == 0) {
cat("A matriz estabilizou! Nenhuma localidade < 5 spp ou espécie única detectada.\n")
continue_clean_bio <- FALSE
} else {
cat("Removendo", length(loc_remove), "localidades e", length(spp_remove), "espécies raras/fantasmas...\n")
# Cortar e manter apenas quem atende aos critérios ecológicos rigorosos
matrix_PA_clean_recur <- matrix_PA_clean_recur[curren_rich >= 5, curren_freq > 1]
cat(" -> Novo tamanho parcial:", nrow(matrix_PA_clean_recur), "localidades e", ncol(matrix_PA_clean_recur), "espécies.\n")
iteration_bio <- iteration_bio + 1
# Trava de segurança para evitar um loop infinito que apague gradientes naturais
if(iteration_bio > 4) {
cat("\n[!] ALERTA: Limite de segurança atingido (4 rodadas). Parando para preservar a ecologia real.\n")
continue_clean_bio <- FALSE
}
}
}## [Rodada 1 ] Removendo 0 localidades e 20 espécies raras/fantasmas...
## -> Novo tamanho parcial: 296 localidades e 1046 espécies.
## [Rodada 2 ] A matriz estabilizou! Nenhuma localidade < 5 spp ou espécie única detectada. # Resultado final após limpeza
matrix_run <- matrix_PA_clean_recur
cat("\n=== RESUMO DA CURADORIA DE DADOS ===\n")##
## === RESUMO DA CURADORIA DE DADOS === cat("Matriz Original: ", nrow(matrix_PA_clean), "localidades e", ncol(matrix_PA_clean), "espécies.\n")## Matriz Original: 304 localidades e 1066 espécies. cat("Matriz Definitiva: ", nrow(matrix_run), "localidades e", ncol(matrix_run), "espécies.\n")## Matriz Definitiva: 296 localidades e 1046 espécies.Anotações: Aqui foi necessário novamente a checagem da presença de singletons e riqueza < 5 táxons.
5. Análises Multivariadas e Delimitação Florística
5.1. Turnover vs. Nestedness
# Calcular a partição usando a sua matriz binária limpa
part_beta <- beta.multi(matrix_run, index.family = "jaccard")
# Visualizar os resultados gerais da região
cat("Dissimilaridade Jaccard Total (Regiao):", round(part_beta$beta.JAC, 3), "\n")## Dissimilaridade Jaccard Total (Regiao): 0.996cat("Fracao por Turnover (Substituicao - Biomas diferentes):", round(part_beta$beta.JTU, 3), "\n")## Fracao por Turnover (Substituicao - Biomas diferentes): 0.994cat("Fracao por Aninhamento (Perda de especies):", round(part_beta$beta.JNE, 3), "\n")## Fracao por Aninhamento (Perda de especies): 0.002Anotações: Na (dis)similaridade de Jaccard, quando o Turnover é muito maior que o Aninhamento, há evidências fortes de que a área de estudo abrange diferentes domínios florísticos.
5.2. Escalonamento Multidimensional Não-Métrico (NMDS) com Jaccard
# Calcular a matriz de distância florística (Dissimilaridade de Jaccard)
dissimilarity_matrix <- vegdist(matrix_run, method = "jaccard")
# Criar a Árvore de Agrupamento (Clustering) com método 'ward.D2', excelente para criar grupos densos e bem definidos
tree_biome <- hclust(dissimilarity_matrix, method = "ward.D2")
# Definir k=2 e extrair os grupos (aqui foi mantido k=2)
k_excell <- 2
# Cortar a árvore para gerar 2 grupos
my_data_group <- cutree(tree_biome, k = k_excell)
# Extrair os grupos da árvore
my_data_group <- factor(my_data_group,
levels = c(1, 2),
labels = c("Floristic Domain A", "Floristic Domain B"))
# Converter para objeto de dendrograma manipulável
dendro_obj <- as.dendrogram(tree_biome)
# Automatizar a correspondência de cores para evitar inversões acidentais no gráfico
grupos_na_ordem_do_plot <- my_data_group[tree_biome$order]
left_branc <- as.character(grupos_na_ordem_do_plot[1])
if (left_branc == "Floristic Domain A") {
# Se o Domínio A caiu na esquerda: Laranja primeiro, Verde depois
cores_ramos <- c("#d95f02", "#1b9e77")
} else {
# Se o Domínio B caiu na esquerda: Verde primeiro, Laranja depois
cores_ramos <- c("#1b9e77", "#d95f02")
}
# Aplicar as cores aos ramos
dendro_colorido <- color_branches(dendro_obj, k = k_excell, col = cores_ramos)
# Limpar os rótulos de texto no eixo X (pois seriam centenas de nomes ilegíveis sobrepostos)
labels(dendro_colorido) <- NULL ## Warning in `labels<-.dendrogram`(`*tmp*`, value = NULL): The lengths of the new
## labels is shorter than the number of leaves in the dendrogram - labels are
## recycled.## Warning in rep(new_labels, length.out = leaves_length): 'x' is NULL so the
## result will be NULL # Gerar o Gráfico Final
plot(dendro_colorido,
main = "Dendrograma Floristico: Separacao dos Dominios (k=2)",
ylab = "Distancia de Ward",
xlab = "Localidades",
sub = "") # Remove o subtítulo automático
# Adicionar a Legenda Dinâmica no canto superior direito
legend("topright",
legend = c("Floristic Domain A", "Floristic Domain B"),
fill = c("#d95f02", "#1b9e77"), # As cores oficiais dos seus domínios
border = "black", # Borda preta nos quadradinhos da legenda
bty = "n", # Remove a caixa em volta da legenda para ficar mais limpo
cex = 0.9, # Ajuste do tamanho da fonte
inset = c(0.02, 0.02)) # Afasta ligeiramente a legenda da margem
# Correr o NMDS
nmds_result <- metaMDS(dissimilarity_matrix, k = 2, trymax = 100)## Run 0 stress 0.1538772
## Run 1 stress 0.159868
## Run 2 stress 0.157327
## Run 3 stress 0.1599269
## Run 4 stress 0.1581167
## Run 5 stress 0.1644621
## Run 6 stress 0.1606032
## Run 7 stress 0.1616801
## Run 8 stress 0.1579059
## Run 9 stress 0.1565362
## Run 10 stress 0.163321
## Run 11 stress 0.158987
## Run 12 stress 0.1563745
## Run 13 stress 0.1580461
## Run 14 stress 0.1619688
## Run 15 stress 0.1580616
## Run 16 stress 0.1558318
## Run 17 stress 0.1605585
## Run 18 stress 0.1609669
## Run 19 stress 0.1595668
## Run 20 stress 0.1588359
## Run 21 stress 0.1610586
## Run 22 stress 0.1560034
## Run 23 stress 0.1578817
## Run 24 stress 0.1581547
## Run 25 stress 0.1620074
## Run 26 stress 0.1631254
## Run 27 stress 0.1635754
## Run 28 stress 0.1516935
## ... New best solution
## ... Procrustes: rmse 0.02814159 max resid 0.1098283
## Run 29 stress 0.1620814
## Run 30 stress 0.1605064
## Run 31 stress 0.1636923
## Run 32 stress 0.1652184
## Run 33 stress 0.159657
## Run 34 stress 0.1610614
## Run 35 stress 0.1617727
## Run 36 stress 0.1630601
## Run 37 stress 0.1567329
## Run 38 stress 0.16224
## Run 39 stress 0.1641996
## Run 40 stress 0.1586634
## Run 41 stress 0.161297
## Run 42 stress 0.1604643
## Run 43 stress 0.1617837
## Run 44 stress 0.164748
## Run 45 stress 0.1592573
## Run 46 stress 0.1614378
## Run 47 stress 0.1593177
## Run 48 stress 0.1585103
## Run 49 stress 0.1614381
## Run 50 stress 0.1628197
## Run 51 stress 0.1531495
## Run 52 stress 0.1602232
## Run 53 stress 0.163549
## Run 54 stress 0.1662476
## Run 55 stress 0.1560088
## Run 56 stress 0.1646541
## Run 57 stress 0.1628783
## Run 58 stress 0.1526834
## Run 59 stress 0.1584566
## Run 60 stress 0.1644607
## Run 61 stress 0.1602382
## Run 62 stress 0.1653418
## Run 63 stress 0.162051
## Run 64 stress 0.1535105
## Run 65 stress 0.1623221
## Run 66 stress 0.1594547
## Run 67 stress 0.1583977
## Run 68 stress 0.1612296
## Run 69 stress 0.1545565
## Run 70 stress 0.1608594
## Run 71 stress 0.1623332
## Run 72 stress 0.1589415
## Run 73 stress 0.1531414
## Run 74 stress 0.1555455
## Run 75 stress 0.1650273
## Run 76 stress 0.154647
## Run 77 stress 0.1591741
## Run 78 stress 0.1622951
## Run 79 stress 0.1609539
## Run 80 stress 0.1637709
## Run 81 stress 0.1606889
## Run 82 stress 0.1624491
## Run 83 stress 0.1633616
## Run 84 stress 0.1579332
## Run 85 stress 0.1585743
## Run 86 stress 0.159373
## Run 87 stress 0.1617023
## Run 88 stress 0.1630577
## Run 89 stress 0.1625042
## Run 90 stress 0.1600504
## Run 91 stress 0.1578835
## Run 92 stress 0.1569575
## Run 93 stress 0.161925
## Run 94 stress 0.1568248
## Run 95 stress 0.1625766
## Run 96 stress 0.1583156
## Run 97 stress 0.1539664
## Run 98 stress 0.1575864
## Run 99 stress 0.1609561
## Run 100 stress 0.1588355
## *** Best solution was not repeated -- monoMDS stopping criteria:
## 9: no. of iterations >= maxit
## 74: stress ratio > sratmax
## 17: scale factor of the gradient < sfgrmin # Juntar as Coordenadas com os Novos Grupos Gerados
df_nmds_blind <- data.frame(
Locality = rownames(matrix_run),
NMDS1 = nmds_result$points[, 1],
NMDS2 = nmds_result$points[, 2],
Floristic_Group = my_data_group
)
# Recuperar a lista de outliers isolados no passo anterior
val_calc <- df_nmds_blind %>%
group_by(Floristic_Group) %>%
summarise(Outliers_NMDS1 = list(boxplot.stats(NMDS1)$out), .groups = "drop")
nmds_outliers_id <- df_nmds_blind %>%
filter(NMDS1 %in% unlist(val_calc$Outliers_NMDS1))
# Criar uma coluna de marcação no Data Frame principal
# Isso vai dizer ao R: "Este ponto é um outlier? Sim ou Não"
df_nmds_blind <- df_nmds_blind %>%
mutate(Is_Outlier = ifelse(Locality %in% nmds_outliers_id$Locality, "Sim", "Não"))
# Gerar o NMDS Revelador
ggplot(df_nmds_blind, aes(x = NMDS1, y = NMDS2, color = Floristic_Group, fill = Floristic_Group)) +
# Plotar os pontos
geom_point(size = 3, alpha = ifelse(df_nmds_blind$Is_Outlier == "Sim", 1, 0.4)) +
# Elipses dos biomas
stat_ellipse(geom = "polygon", alpha = 0.15, linetype = "solid", linewidth = 0.8) +
# Colar o nome da localidade APENAS nos pontos anômalos
geom_text_repel(data = subset(df_nmds_blind, Is_Outlier == "Sim"),
aes(label = Locality),
size = 3.5,
color = "black", # O texto fica preto para leitura fácil
fontface = "bold",
box.padding = 0.6, # Afasta o texto do ponto
point.padding = 0.3) + # Desenha uma linha do texto até ao ponto
theme_bw() +
labs(title = "NMDS: Identificacao de Areas de Transicao (Ecotonos)",
subtitle = "Localidades atípicas reveladas no espaço multivariado",
x = "Eixo NMDS 1",
y = "Eixo NMDS 2",
color = "Comunidade (k)",
fill = "Comunidade (k)") +
scale_color_manual(values = c("#d95f02", "#1b9e77")) +
scale_fill_manual(values = c("#d95f02", "#1b9e77")) +
theme(legend.position = "bottom",
plot.title = element_text(face = "bold"))
# O Boxplot focando no Eixo 1 do NMDS
ggplot(df_nmds_blind, aes(x = Floristic_Group, y = NMDS1, fill = Floristic_Group)) +
# Criar as caixas. O outlier.shape destaca localidades atípicas dentro do próprio bioma
geom_boxplot(alpha = 0.8, outlier.shape = 16, outlier.size = 2, outlier.color = "red") +
theme_bw() +
labs(title = "Separacao Floristica ao Longo do Gradiente Principal",
subtitle = "Distribuicao das localidades no Eixo 1 do NMDS",
x = "Dominio Fitogeografico (k=2)",
y = "Coordenadas do Eixo 1 (NMDS1)") +
scale_fill_manual(values = c("#d95f02", "#1b9e77")) +
theme(legend.position = "none",
plot.title = element_text(face = "bold"),
axis.text.x = element_text(size = 11, face = "bold"))
Anotações: o teste NMDS seguiu uma análise não supervisionada (Data-Driven) para evitar viés tendencioso com a informação dos biomas da matriz de dados; o dendrograma apresentou 2 grandes ramos, então k=2, que representa a quebra florística mais profunda do estudo; uma localidade foi detectada como outlier no gráfico de ordenação e mais de 3 no bloxpot; apesar de apresentar outliers, o Stress foi <0.20, que pode ser usado.
5.3. Análise de Coordenadas Principais (PCoA)
# Correr a PCoA com base na matriz de distância de Jaccard e objetos do tópico de NMDS
pcoa_result <- cmdscale(dissimilarity_matrix, k = 2, eig = TRUE)
# Calcular a variância explicada pelos dois eixos principais
percent_axis1 <- round(pcoa_result$eig[1] / sum(pcoa_result$eig) * 100, 1)
percent_axis2 <- round(pcoa_result$eig[2] / sum(pcoa_result$eig) * 100, 1)
# Montar o Data Frame com as Coordenadas da PCoA e os Grupos do Cluster
df_pcoa_blind <- data.frame(
Locality = rownames(matrix_run),
PCoA1 = pcoa_result$points[, 1],
PCoA2 = pcoa_result$points[, 2],
Floristic_Group = my_data_group
)
# Plotar o Gráfico Final da PCoA Data-Driven
ggplot(df_pcoa_blind, aes(x = PCoA1, y = PCoA2, color = Floristic_Group, fill = Floristic_Group)) +
geom_point(size = 3, alpha = 0.7) +
stat_ellipse(geom = "polygon", alpha = 0.15, linetype = "solid", linewidth = 0.8) +
theme_bw() +
labs(title = "Ordenacao Floristica Data-Driven (PCoA)",
subtitle = "Grupos definidos cegamente pela flora (Ward Clustering)",
x = paste0("Eixo PCoA 1 (", percent_axis1, "%)"),
y = paste0("Eixo PCoA 2 (", percent_axis2, "%)"),
color = "Comunidade (k)",
fill = "Comunidade (k)") +
scale_color_manual(values = c("Floristic Domain A" = "#d95f02",
"Floristic Domain B" = "#1b9e77")) +
scale_fill_manual(values = c("Floristic Domain A" = "#d95f02",
"Floristic Domain B" = "#1b9e77")) +
theme(legend.position = "bottom",
plot.title = element_text(face = "bold"))
# O Boxplot focando no Eixo 1 da PCoA
ggplot(df_pcoa_blind, aes(x = Floristic_Group, y = PCoA1, fill = Floristic_Group)) +
# Criar as caixas. O outlier.shape destaca localidades atípicas dentro do próprio bioma
geom_boxplot(alpha = 0.8, outlier.shape = 16, outlier.size = 2, outlier.color = "red") +
theme_bw() +
labs(title = "Separacao Floristica ao Longo do Gradiente Principal",
subtitle = "Distribuicao das localidades no Eixo 1 da PCoA",
x = "Dominio Fitogeografico (k=2)",
y = "Coordenadas do Eixo 1 (PCoA1)") +
scale_fill_manual(values = c("#d95f02", "#1b9e77")) +
theme(legend.position = "none",
plot.title = element_text(face = "bold"),
axis.text.x = element_text(size = 11, face = "bold"))
Anotações: diferentemente do NMDS, o PCoA não apresentou potenciais outliers e foca na distância métrica linear; poderia ser uma alternativa ao NMDS. Os dois primeiros eixos da PCoA capturaram conjuntamente 17,6% da variação florística total (Eixo 1 = 12,2%; Eixo 2 = 5,4%). Em estudos de comunidades vegetais neotropicais baseados em dados de presença/ausência, essa proporção de variância retida nos eixos primários é considerada robusta devido à alta dimensionalidade e à proporção inerente de zeros (espécies restritas) na matriz de dados, evidenciando um forte gradiente principal estruturando a flora regional.
5.4. Análise de Variância Permutacional Multivariada (PERMANOVA)
# Criar um dataframe simples contendo os grupos gerados pelo corte da árvore (k=2)
df_permanova_blind <- data.frame(
Floristic_Group = my_data_group)
# Executar a PERMANOVA usando a matriz de Jaccard
permanova_test <- adonis2(dissimilarity_matrix ~ Floristic_Group,
data = df_permanova_blind,
permutations = 999)
print("--- RESULTADO DA PERMANOVA ---")## [1] "--- RESULTADO DA PERMANOVA ---"print(permanova_test)## Permutation test for adonis under reduced model
## Permutation: free
## Number of permutations: 999
##
## adonis2(formula = dissimilarity_matrix ~ Floristic_Group, data = df_permanova_blind, permutations = 999)
## Df SumOfSqs R2 F Pr(>F)
## Model 1 13.333 0.10159 33.245 0.001 ***
## Residual 294 117.909 0.89841
## Total 295 131.242 1.00000
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Calcular a dispersão e extrair coordenadas
dispers_grupos <- betadisper(dissimilarity_matrix, df_permanova_blind$Floristic_Group)
# Criar dataframe com as coordenadas dos pontos (Localidades)
df_perm_scatter <- data.frame(
PCoA1 = dispers_grupos$vectors[, 1],
PCoA2 = dispers_grupos$vectors[, 2],
Floristic_Group = df_permanova_blind$Floristic_Group
)
# Criar dataframe com as coordenadas dos "Corações" (Centróides)
df_centroids <- data.frame(
Floristic_Group = rownames(dispers_grupos$centroids),
Centroid1 = dispers_grupos$centroids[, 1],
Centroid2 = dispers_grupos$centroids[, 2]
)
# Juntar as informações para poder desenhar as linhas conectando pontos aos centróides
df_perm_scatter <- df_perm_scatter %>% left_join(df_centroids, by = "Floristic_Group")
# Plotar a Teia (Spider Plot)
ggplot(df_perm_scatter, aes(color = Floristic_Group)) +
# Desenha a "teia" (linha ligando o ponto ao centro)
geom_segment(aes(x = Centroid1, y = Centroid2, xend = PCoA1, yend = PCoA2), alpha = 0.3) +
# Desenha os pontos normais das localidades
geom_point(aes(x = PCoA1, y = PCoA2), size = 2, alpha = 0.7) +
# Desenha os Centróides em destaque (Losango preto)
geom_point(aes(x = Centroid1, y = Centroid2), size = 6, shape = 18, color = "black") +
theme_bw() +
labs(title = "Dispersao da PERMANOVA (Teia de Centróides)",
subtitle = "Projecao multivariada das distâncias florísticas ao centro de cada grupo",
x = "Eixo Principal 1",
y = "Eixo Principal 2") +
scale_color_manual(values = c("#d95f02", "#1b9e77")) +
theme(legend.position = "bottom", plot.title = element_text(face = "bold"))
# Inserir os valores calculados no dataframe original
df_permanova_blind$Centroid_Distance <- dispers_grupos$distances
# Plotar o Boxplot
ggplot(df_permanova_blind, aes(x = Floristic_Group, y = Centroid_Distance, fill = Floristic_Group)) +
geom_boxplot(alpha = 0.8, outlier.shape = 16, outlier.size = 2, outlier.color = "red") +
theme_bw() +
labs(title = "Variância Interna dos Grupos (PERMANOVA)",
subtitle = "Mediana das distâncias de cada localidade para o núcleo do seu bioma",
x = "Domínio Fitogeográfico (k=2)",
y = "Distância Florística (Jaccard)") +
scale_fill_manual(values = c("#d95f02", "#1b9e77")) +
theme(legend.position = "none",
plot.title = element_text(face = "bold"),
axis.text.x = element_text(size = 11, face = "bold"))
Anotações: para verificar se a separação de grupos via NMDS ou PCoA ficaram estatisticamente significativas, usou-se a PERMANOVA; o p-value (Pr(>F)) foi XXX por ser >< X; O R2 (R-squared) diz a porcentagem exata de toda a variação da vegetação de cada grupo formado.
5.5. Teste de Mantel
# Recalcular a dissimilaridade com dados limpos
dissimilarity_matrix_clean <- vegdist(matrix_run, method = "jaccard")
# Fazer o Cruzamento (Left Join) original
df_coords_align <- df_locality %>%
left_join(input_matrix %>%
select(locality, longitud, latitud) %>%
distinct(),
by = "locality") %>%
mutate(
longitud = as.numeric(gsub(",", ".", longitud)),
latitud = as.numeric(gsub(",", ".", latitud))
)
# Descobrir quem são as localidades que sobreviveram na matriz limpa
surv_locality <- rownames(matrix_run)
# Filtrar o dataframe de coordenadas e ORDENAR exatamente como na matriz florística
df_coords_clean <- df_coords_align[match(surv_locality, df_coords_align$locality), ]
# Preparar para a distância matemática
coords_numeric <- df_coords_clean %>%
select(longitud, latitud)
# Converter coordenadas para matriz (exigência do pacote geosphere)
coords_matrix <- as.matrix(coords_numeric)
# Calcular a Distância Geográfica Real (Haversine) em metros, depois passar para km
geo_dist_matrix_m <- distm(coords_matrix, fun = distHaversine)
geo_dist_matrix_km <- geo_dist_matrix_m / 1000
# Converter para o formato 'dist' exigido pela função mantel()
geo_distance_clean <- as.dist(geo_dist_matrix_km)
# Iniciar o teste de Mantel
# Calcular a Distância Geográfica limpa
geo_distance_clean <- vegdist(coords_numeric, method = "euclidean")
# Rodar o Mantel (agora as duas matrizes têm o mesmo tamanho exato!)
mantel_test <- mantel(dissimilarity_matrix_clean, geo_distance_clean,
method = "spearman",
permutations = 999)
# Imprimir o resultado
print("--- RESULTADO DO TESTE DE MANTEL ---")## [1] "--- RESULTADO DO TESTE DE MANTEL ---"print(mantel_test)##
## Mantel statistic based on Spearman's rank correlation rho
##
## Call:
## mantel(xdis = dissimilarity_matrix_clean, ydis = geo_distance_clean, method = "spearman", permutations = 999)
##
## Mantel statistic r: 0.4671
## Significance: 0.001
##
## Upper quantiles of permutations (null model):
## 90% 95% 97.5% 99%
## 0.0235 0.0301 0.0361 0.0423
## Permutation: free
## Number of permutations: 999# Graficar
# 'Achatar' as matrizes limpas para formato vetorial
vec_floristic <- as.vector(dissimilarity_matrix_clean)
vec_geo <- as.vector(geo_distance_clean)
# Montar dataframe cruzado
df_mantel_visual <- data.frame(
Dist_Geo = vec_geo,
Dist_Flor = vec_floristic
)
# Plotar a regressão contínua
ggplot(df_mantel_visual, aes(x = Dist_Geo, y = Dist_Flor)) +
geom_point(alpha = 0.08, color = "#2c3e50", size = 0.4) +
geom_smooth(method = "lm", formula = y ~ x, color = "red", linetype = "dashed", linewidth = 1, se = FALSE) +
theme_bw() +
labs(title = "Isolamento por Distancia (Dispersao de Mantel)",
subtitle = "Autocorrelacao espacial: Dissimilaridade floristica vs. Separacao geografica",
x = "Distancia Geografica Real (km)",
y = "Dissimilaridade Floristica (Jaccard)") +
theme(plot.title = element_text(face = "bold"))
# Fatiar a distância geográfica contínua em 4 classes discretas
df_mantel_visual$Class_Geo <- cut(df_mantel_visual$Dist_Geo,
breaks = 4,
labels = c("Curta Distancia", "Media-Curta", "Media-Longa", "Longa Distancia"))
# Plotar o Boxplot Espacial
ggplot(df_mantel_visual, aes(x = Class_Geo, y = Dist_Flor, fill = Class_Geo)) +
geom_boxplot(alpha = 0.8, outlier.shape = 16, outlier.size = 1, outlier.color = "grey50") +
theme_bw() +
labs(title = "Decaimento da Similaridade em Classes (Mantel Boxplot)",
subtitle = "Evolucao da dissimilaridade da flora conforme o afastamento geografico",
x = "Intervalos de Distancia Geografica",
y = "Dissimilaridade Floristica (Jaccard)") +
scale_fill_brewer(palette = "Blues") +
theme(legend.position = "none",
plot.title = element_text(face = "bold"),
axis.text.x = element_text(size = 11, face = "bold"))
Anotações: Se o valor for muito baixo (próximo de zero ou negativo) e/ou o p-value não for significativo, então a distância geográfica no mapa não tem poder para explicar a flora, isso prova que as duas elipses distintas que viu na PCoA representam blocos fitogeográficos verdadeiros, e não apenas um gradiente espacial contínuo.
6. Análise dos Grupos (Domínios)
6.1. Caracterização dos Grupos
# 1. Criar um dataframe ordenado com as localidades e seus respectivos grupos
df_lista_grupos <- data.frame(
Localidade = names(my_data_group),
Dominio_Floristico = as.character(my_data_group)
)
# 2. Ordenar pelo grupo para facilitar a visualização
df_lista_grupos <- df_lista_grupos %>% arrange(Dominio_Floristico)
# 3. Exibir no console para conferência imediata
print(df_lista_grupos)## Localidade Dominio_Floristico
## 1 CERDAO_CER_01 Floristic Domain A
## 2 CER.S.ST_CER_01 Floristic Domain A
## 3 CERDAO_CER_02 Floristic Domain A
## 4 CERDAO_CER_03 Floristic Domain A
## 5 CERDAO_CER_04 Floristic Domain A
## 6 CERDAO_CER_05 Floristic Domain A
## 7 CERDAO_CER_06 Floristic Domain A
## 8 CERDAO_CER_07 Floristic Domain A
## 9 CERDAO_CER_08 Floristic Domain A
## 10 CERDAO_CER_09 Floristic Domain A
## 11 CERDAO_CER_10 Floristic Domain A
## 12 CERDAO_CER_11 Floristic Domain A
## 13 CERDAO_CER_23 Floristic Domain A
## 14 CERDAO_CER_24 Floristic Domain A
## 15 CER.S.ST_PANT_01 Floristic Domain A
## 16 CERDAO_CER_12 Floristic Domain A
## 17 CERDAO_CER_13 Floristic Domain A
## 18 CILIAR_CER_01 Floristic Domain A
## 19 CILIAR_CER_02 Floristic Domain A
## 20 CILIAR_CER_03 Floristic Domain A
## 21 CILIAR_CER_04 Floristic Domain A
## 22 CILIAR_CER_05 Floristic Domain A
## 23 CAMP.MUR_CER_01 Floristic Domain A
## 24 CAMP.MUR_CER_02 Floristic Domain A
## 25 CERDAO_CER_14 Floristic Domain A
## 26 CER.RUPES_CER_01 Floristic Domain A
## 27 CILIAR_CER_06 Floristic Domain A
## 28 CER.S.ST_CER_02 Floristic Domain A
## 29 CILIAR_CER_07 Floristic Domain A
## 30 CILIAR_CER_08 Floristic Domain A
## 31 CILIAR_CER_09 Floristic Domain A
## 32 CERDAO_CER_15 Floristic Domain A
## 33 CERDAO_CER_25 Floristic Domain A
## 34 CERDAO_CER_27 Floristic Domain A
## 35 FES_PANT_17 Floristic Domain A
## 36 CILIAR_CER_10 Floristic Domain A
## 37 CILIAR_CER_11 Floristic Domain A
## 38 CERDAO_CER_28 Floristic Domain A
## 39 CERDAO_CER_29 Floristic Domain A
## 40 CERDAO_CER_30 Floristic Domain A
## 41 CERDAO_CER_31 Floristic Domain A
## 42 CILIAR_CER_12 Floristic Domain A
## 43 CERDAO_CER_16 Floristic Domain A
## 44 CERDAO_CER_17 Floristic Domain A
## 45 CERDAO_CER_18 Floristic Domain A
## 46 TRANS_CER_01 Floristic Domain A
## 47 FED_PANT_01 Floristic Domain A
## 48 FED_CER_01 Floristic Domain A
## 49 FED_PANT_02 Floristic Domain A
## 50 FED_PANT_03 Floristic Domain A
## 51 CILIAR_CER_13 Floristic Domain A
## 52 CILIAR_MA_01 Floristic Domain A
## 53 CILIAR_CER_14 Floristic Domain A
## 54 FES_CER_01 Floristic Domain A
## 55 FES_CER_02 Floristic Domain A
## 56 FES_CER_03 Floristic Domain A
## 57 FES_MA_01 Floristic Domain A
## 58 FES_MA_02 Floristic Domain A
## 59 FES_MA_03 Floristic Domain A
## 60 FES_MA_04 Floristic Domain A
## 61 FES_PANT_01 Floristic Domain A
## 62 FES_CHI_01 Floristic Domain A
## 63 CILIAR_MA_02 Floristic Domain A
## 64 FES_CER_04 Floristic Domain A
## 65 FES_CER_05 Floristic Domain A
## 66 FES_CER_06 Floristic Domain A
## 67 FES_CER_07 Floristic Domain A
## 68 FES_PANT_02 Floristic Domain A
## 69 FES_PANT_03 Floristic Domain A
## 70 FES_PANT_04 Floristic Domain A
## 71 FES_PANT_05 Floristic Domain A
## 72 FES_PANT_06 Floristic Domain A
## 73 FES_CER_08 Floristic Domain A
## 74 FES_CER_09 Floristic Domain A
## 75 FES_CER_10 Floristic Domain A
## 76 FES_CER_11 Floristic Domain A
## 77 FES_MA_05 Floristic Domain A
## 78 FES_MA_06 Floristic Domain A
## 79 FES_MA_07 Floristic Domain A
## 80 FES_MA_08 Floristic Domain A
## 81 FED_PANT_04 Floristic Domain A
## 82 PARAT_PANT_03 Floristic Domain A
## 83 CERDAO_PANT_01 Floristic Domain A
## 84 CERDAO_PANT_02 Floristic Domain A
## 85 CERDAO_PANT_03 Floristic Domain A
## 86 CILIAR_PANT_01 Floristic Domain A
## 87 TRANS_CER_02 Floristic Domain A
## 88 CAPAO_PANT_13 Floristic Domain A
## 89 CERDAO_PANT_23 Floristic Domain A
## 90 CAPAO_PANT_07 Floristic Domain A
## 91 CAPAO_PANT_06 Floristic Domain A
## 92 CILIAR_PANT_02 Floristic Domain A
## 93 CILIAR_PANT_03 Floristic Domain A
## 94 CILIAR_PANT_04 Floristic Domain A
## 95 CILIAR_PANT_05 Floristic Domain A
## 96 CILIAR_PANT_06 Floristic Domain A
## 97 CAMP.CERR_PANT_05 Floristic Domain A
## 98 FES_PANT_18 Floristic Domain A
## 99 FED_PANT_05 Floristic Domain A
## 100 CAPAO_PANT_01 Floristic Domain A
## 101 CAPAO_PANT_08 Floristic Domain A
## 102 CERDAO_PANT_04 Floristic Domain A
## 103 CERDAO_PANT_05 Floristic Domain A
## 104 CERDAO_PANT_06 Floristic Domain A
## 105 CERDAO_PANT_07 Floristic Domain A
## 106 CERDAO_PANT_08 Floristic Domain A
## 107 CERDAO_PANT_09 Floristic Domain A
## 108 CERDAO_PANT_10 Floristic Domain A
## 109 CERDAO_PANT_11 Floristic Domain A
## 110 CAPAO_PANT_02 Floristic Domain A
## 111 CERDAO_PANT_20 Floristic Domain A
## 112 CAPAO_PANT_03 Floristic Domain A
## 113 CAMP.CERR_PANT_01 Floristic Domain A
## 114 CERDAO_PANT_12 Floristic Domain A
## 115 CILIAR_PANT_07 Floristic Domain A
## 116 CERDAO_PANT_19 Floristic Domain A
## 117 CERDAO_PANT_21 Floristic Domain A
## 118 FED_PANT_07 Floristic Domain A
## 119 FED_PANT_08 Floristic Domain A
## 120 FED_PANT_09 Floristic Domain A
## 121 FED_PANT_10 Floristic Domain A
## 122 CAMP.CERR_PANT_02 Floristic Domain A
## 123 CAPAO_PANT_14 Floristic Domain A
## 124 PARAT_PANT_02 Floristic Domain A
## 125 CAMP.MUR_PANT_01 Floristic Domain A
## 126 CAPAO_PANT_12 Floristic Domain A
## 127 CAPAO_PANT_09 Floristic Domain A
## 128 CAMP.MUR_PANT_02 Floristic Domain A
## 129 CERDAO_PANT_13 Floristic Domain A
## 130 CAPAO_PANT_04 Floristic Domain A
## 131 CAPAO_PANT_05 Floristic Domain A
## 132 FES_PANT_07 Floristic Domain A
## 133 CAMP.CERR_PANT_03 Floristic Domain A
## 134 CERDAO_PANT_14 Floristic Domain A
## 135 CAPAO_PANT_11 Floristic Domain A
## 136 CILIAR_PANT_08 Floristic Domain A
## 137 FES_PANT_08 Floristic Domain A
## 138 CILIAR_PANT_09 Floristic Domain A
## 139 CILIAR_PANT_10 Floristic Domain A
## 140 CILIAR_PANT_11 Floristic Domain A
## 141 CERDAO_PANT_22 Floristic Domain A
## 142 MAT_ACURI_PANT_01 Floristic Domain A
## 143 CAPAO_PANT_10 Floristic Domain A
## 144 CAMB_PANT_01 Floristic Domain A
## 145 CAPAO_PANT_15 Floristic Domain A
## 146 CERDAO_PANT_15 Floristic Domain A
## 147 CERDAO_CER_19 Floristic Domain A
## 148 CILIAR_PANT_12 Floristic Domain A
## 149 CERDAO_PANT_16 Floristic Domain A
## 150 FES_PANT_09 Floristic Domain A
## 151 FES_PANT_10 Floristic Domain A
## 152 CILIAR_PANT_13 Floristic Domain A
## 153 CILIAR_PANT_14 Floristic Domain A
## 154 FESM_PANT_01 Floristic Domain A
## 155 CILIAR_PANT_15 Floristic Domain A
## 156 FES_PANT_11 Floristic Domain A
## 157 CAMP.CERR_PANT_04 Floristic Domain A
## 158 FES_PANT_12 Floristic Domain A
## 159 CAMP.CERR_CER_01 Floristic Domain A
## 160 CAMP.MUR_CER_03 Floristic Domain A
## 161 CER.S.ST_CER_03 Floristic Domain A
## 162 CERDAO_CER_20 Floristic Domain A
## 163 BABA_CER_01 Floristic Domain A
## 164 CAPAO_CER_01 Floristic Domain A
## 165 CILIAR_CER_18 Floristic Domain A
## 166 CILIAR_MA_03 Floristic Domain A
## 167 CERDAO_CER_21 Floristic Domain A
## 168 FED_PANT_06 Floristic Domain A
## 169 CERDAO_CER_22 Floristic Domain A
## 170 CERDAO_PANT_17 Floristic Domain A
## 171 CERDAO_PANT_18 Floristic Domain A
## 172 FES_PANT_13 Floristic Domain A
## 173 FES_PANT_14 Floristic Domain A
## 174 CER.S.ST_PANT_02 Floristic Domain A
## 175 FES_PANT_15 Floristic Domain A
## 176 FES_PANT_16 Floristic Domain A
## 177 CAMB_PANT_02 Floristic Domain A
## 178 CAMP.MUR_PANT_03 Floristic Domain A
## 179 CHA_CHIQ_14 Floristic Domain A
## 180 CHA_CHIQ_15 Floristic Domain A
## 181 CHA_CHIQ_16 Floristic Domain A
## 182 CHA_CHIQ_17 Floristic Domain A
## 183 CHA_CHIQ_18 Floristic Domain A
## 184 CHA_CHIQ_19 Floristic Domain A
## 185 CERDAO_CER_32 Floristic Domain A
## 186 CERDAO_CER_34 Floristic Domain A
## 187 CERDAO_CER_36 Floristic Domain A
## 188 CER.S.ST_CER_04 Floristic Domain A
## 189 CHA_UM_CHA_01 Floristic Domain B
## 190 CHA_UM_CHA_02 Floristic Domain B
## 191 CHA_UM_CHA_03 Floristic Domain B
## 192 CHA_SEC_01 Floristic Domain B
## 193 CHA_SEC_02 Floristic Domain B
## 194 CHA_SEC_03 Floristic Domain B
## 195 CHA_SEC_04 Floristic Domain B
## 196 CHA_SEC_05 Floristic Domain B
## 197 CHA_SEC_06 Floristic Domain B
## 198 CHA_SEC_07 Floristic Domain B
## 199 CHA_ARID_01 Floristic Domain B
## 200 CHA_SERRA_01 Floristic Domain B
## 201 CHA_BOL_01 Floristic Domain B
## 202 CHA_PAMPA_01 Floristic Domain B
## 203 CHA_PANT_01 Floristic Domain B
## 204 CHA_PANT_02 Floristic Domain B
## 205 CHA_PANT_03 Floristic Domain B
## 206 CHA_PANT_04 Floristic Domain B
## 207 CHA_UM_CHA_04 Floristic Domain B
## 208 CHA_UM_CHA_05 Floristic Domain B
## 209 CHA_UM_CHA_06 Floristic Domain B
## 210 CHA_PANT_05 Floristic Domain B
## 211 CHA_PANT_06 Floristic Domain B
## 212 CHA_UM_CHA_07 Floristic Domain B
## 213 CHA_BOL_02 Floristic Domain B
## 214 CHA_SEM_SAL_01 Floristic Domain B
## 215 CHA_SEM_ARID_01 Floristic Domain B
## 216 CHA_SERRA_02 Floristic Domain B
## 217 CHA_PANT_07 Floristic Domain B
## 218 CHA_PANT_08 Floristic Domain B
## 219 CHA_PANT_09 Floristic Domain B
## 220 CHA_SEM_ARID_02 Floristic Domain B
## 221 CHA_SEM_ARID_03 Floristic Domain B
## 222 CHA_SEM_ARID_04 Floristic Domain B
## 223 CHA_SEM_ARID_05 Floristic Domain B
## 224 CHA_SEM_ARID_06 Floristic Domain B
## 225 CHA_SEM_ARID_07 Floristic Domain B
## 226 CHA_SEM_ARID_08 Floristic Domain B
## 227 CHA_PANT_10 Floristic Domain B
## 228 CHA_AREN_01 Floristic Domain B
## 229 CHA_AREN_02 Floristic Domain B
## 230 CHA_ENC_AREN_02 Floristic Domain B
## 231 CHA_INTERDUN_01 Floristic Domain B
## 232 CHA_INTERDUN_02 Floristic Domain B
## 233 CHA_INTERDUN_03 Floristic Domain B
## 234 CHA_LEQ_ALU_01 Floristic Domain B
## 235 CHA_LEQ_ALU_02 Floristic Domain B
## 236 CHA_LEQ_ALU_03 Floristic Domain B
## 237 CHA_LEQ_ALU_04 Floristic Domain B
## 238 CHA_LEQ_ALU_05 Floristic Domain B
## 239 CHA_LEQ_ALU_06 Floristic Domain B
## 240 CHA_LEQ_ALU_07 Floristic Domain B
## 241 CHA_LEQ_ALU_08 Floristic Domain B
## 242 CHA_LEQ_ALU_09 Floristic Domain B
## 243 CHA_LEQ_ALU_10 Floristic Domain B
## 244 CHA_LEQ_ALU_11 Floristic Domain B
## 245 CHA_LEQ_ALU_12 Floristic Domain B
## 246 CHA_LEQ_ALU_13 Floristic Domain B
## 247 CHA_LEQ_ALU_14 Floristic Domain B
## 248 CHA_LEQ_ALU_15 Floristic Domain B
## 249 CHA_LEQ_ALU_16 Floristic Domain B
## 250 CHA_LEQ_ALU_17 Floristic Domain B
## 251 CHA_LEQ_ALU_18 Floristic Domain B
## 252 CHA_LEQ_ALU_19 Floristic Domain B
## 253 CHA_CHIQ_01 Floristic Domain B
## 254 CHA_CHIQ_02 Floristic Domain B
## 255 CHA_CHIQ_03 Floristic Domain B
## 256 CHA_CHIQ_04 Floristic Domain B
## 257 CHA_CHIQ_05 Floristic Domain B
## 258 CHA_CHIQ_06 Floristic Domain B
## 259 CHA_CHIQ_07 Floristic Domain B
## 260 CHA_CHIQ_08 Floristic Domain B
## 261 CHA_CHIQ_09 Floristic Domain B
## 262 CHA_CHIQ_10 Floristic Domain B
## 263 CHA_CHIQ_11 Floristic Domain B
## 264 CHA_CHIQ_12 Floristic Domain B
## 265 CHA_CHIQ_13 Floristic Domain B
## 266 CHA_EASTERN_01 Floristic Domain B
## 267 CHA_EASTERN_02 Floristic Domain B
## 268 CHA_EASTERN_03 Floristic Domain B
## 269 CHA_EASTERN_04 Floristic Domain B
## 270 CHA_LEQ_ALU_20 Floristic Domain B
## 271 CHA_LEQ_ALU_21 Floristic Domain B
## 272 CHA_LEQ_ALU_22 Floristic Domain B
## 273 CHA_LEQ_ALU_23 Floristic Domain B
## 274 CHA_LEQ_ALU_24 Floristic Domain B
## 275 CHA_LEQ_ALU_25 Floristic Domain B
## 276 CHA_LEQ_ALU_26 Floristic Domain B
## 277 CHA_LEQ_ALU_27 Floristic Domain B
## 278 CHA_LEQ_ALU_28 Floristic Domain B
## 279 CHA_SEM_AR_LEQ_ALU_01 Floristic Domain B
## 280 CHA_EASTERN_05 Floristic Domain B
## 281 CHA_EASTERN_06 Floristic Domain B
## 282 CHA_EASTERN_07 Floristic Domain B
## 283 CHA_HYGRO_01 Floristic Domain B
## 284 CHA_HYGRO_02 Floristic Domain B
## 285 CHA_SEC_08 Floristic Domain B
## 286 CHA_UM_CHA_08 Floristic Domain B
## 287 CHA_SEC_09 Floristic Domain B
## 288 CHA_SEC_10 Floristic Domain B
## 289 CHA_ESPI_01 Floristic Domain B
## 290 CHA_UM_CHA_09 Floristic Domain B
## 291 CHA_UM_CHA_10 Floristic Domain B
## 292 CHA_SEC_12 Floristic Domain B
## 293 CHA_SEC_13 Floristic Domain B
## 294 CHA_SEC_14 Floristic Domain B
## 295 CHA_UM_CHA_11 Floristic Domain B
## 296 CHA_SEC_16 Floristic Domain B# 4. Se quiser salvar em um arquivo CSV para abrir no Excel:
# write.csv(df_lista_grupos, "localidades_por_dominio.csv", row.names = FALSE)
# 5. Opcional: Contagem por grupo para saber quantos locais há em cada lado
contagem <- df_lista_grupos %>% count(Dominio_Floristico)
print(contagem)## Dominio_Floristico n
## 1 Floristic Domain A 188
## 2 Floristic Domain B 108# Instale se necessário: install.packages("ggalluvial")
library(ggalluvial)
# 1. Preparar os dados para o gráfico de fluxo
# Garantimos que estamos usando apenas as localidades presentes na matriz final (matrix_run)
locs_finais <- rownames(matrix_run)
# Filtramos os metadados (domínios originais) para conter apenas as localidades da matriz limpa
df_biome_filtrado <- df_biome_align %>%
filter(locality %in% locs_finais) %>%
arrange(match(locality, locs_finais))
# Agora criamos o dataframe com o mesmo número de linhas
df_flow <- data.frame(
Locality = locs_finais,
Dominio_Original = df_biome_filtrado$domain_biome,
Dominio_Cluster = as.character(my_data_group)
)
library(ggrepel)
# 2. Gerar o Diagrama de Aluviais (Alluvial Plot)
ggplot(df_flow, aes(axis1 = Dominio_Original, axis2 = Dominio_Cluster)) +
geom_alluvium(aes(fill = Dominio_Cluster), width = 1/8, alpha = 0.7, knot.pos = 0.4) +
geom_stratum(width = 1/4, fill = "grey80", color = "black") +
geom_text_repel(stat = "stratum",
aes(label = str_wrap(after_stat(stratum), width = 18)),
size = 3.5,
lineheight = 0.8,
direction = "y", # Força os textos a moverem-se apenas para cima/baixo para não sair da caixa
nudge_x = 0, # Mantém o texto centrado nas caixas
min.segment.length = 0) + # Desenha uma linhazinha se o texto for empurrado para fora da caixa
scale_x_discrete(limits = c("Bioma Original", "Grupo Floristico (k=2)"), expand = c(.05, .05)) +
scale_fill_manual(values = c("Floristic Domain A" = "#d95f02",
"Floristic Domain B" = "#1b9e77")) +
theme_minimal() +
labs(title = "Fluxo de Reclassificacao Floristica",
subtitle = "Comparacao entre a classificacao biogeografica original e o agrupamento multivariado (Ward)",
y = "Numero de Localidades") +
theme(legend.position = "none",
axis.text.x = element_text(size = 11, face = "bold"),
panel.grid.major.x = element_blank()) # Limpa as linhas verticais do fundo
# 3. Se preferir algo mais simples (tabela de contigência) para ver a diferença:
tabela_cruzada <- table(df_flow$Dominio_Original, df_flow$Dominio_Cluster)
print(tabela_cruzada)##
## Floristic Domain A Floristic Domain B
## Cerrado 71 0
## Chaco 6 97
## Chiquitano 1 0
## Mata Atlântica 11 0
## Pampa 0 1
## Pantanal 99 10# ------------------------------------------------------------------------------
# 1. DIAGRAMA DE VENN DOS DOMÍNIOS ESTATÍSTICOS (k=2)
# ------------------------------------------------------------------------------
# Separar as matrizes com base nos grupos gerados pelo Ward
matriz_A <- matrix_run[my_data_group == "Floristic Domain A", ]
matriz_B <- matrix_run[my_data_group == "Floristic Domain B", ]
# Extrair os nomes das espécies que realmente ocorrem em cada domínio (soma > 0)
spp_A <- colnames(matriz_A)[colSums(matriz_A) > 0]
spp_B <- colnames(matriz_B)[colSums(matriz_B) > 0]
# Criar a lista para o Venn
lista_venn_dominios <- list(
"Domain A" = spp_A,
"Domain B" = spp_B
)
# Atualizar nomes com a riqueza total de cada lado
nomes_venn <- names(lista_venn_dominios)
riqueza_venn <- sapply(lista_venn_dominios, length)
names(lista_venn_dominios) <- paste0(nomes_venn, "\n(", riqueza_venn, " spp.)")
# Plotar o Diagrama de Venn Oficial dos Domínios
venn(lista_venn_dominios,
zcolor = c("#d95f02", "#1b9e77"),
opacity = 0.5,
counts = TRUE,
ilcs = 1.5, # Aumenta o tamanho dos números internos
sncs = 1.2, # Aumenta o tamanho do texto dos domínios
box = FALSE)
title("Compartilhamento de Especies entre os Dominios Floristicos")
# ------------------------------------------------------------------------------
# 2. PARTIÇÃO DA DIVERSIDADE BETA (TURNOVER VS NESTEDNESS) POR DOMÍNIO
# ------------------------------------------------------------------------------
# Calcular a partição beta separadamente para o Domínio A
beta_A <- beta.multi(matriz_A, index.family = "jaccard")
# Calcular a partição beta separadamente para o Domínio B
beta_B <- beta.multi(matriz_B, index.family = "jaccard")
# Montar um Data Frame com os resultados
df_beta_comparativo <- data.frame(
Dominio = c("Floristic Domain A", "Floristic Domain B"),
Turnover = c(beta_A$beta.JTU, beta_B$beta.JTU),
Nestedness = c(beta_A$beta.JNE, beta_B$beta.JNE)
)
# Transformar para o formato longo (exigência do ggplot para barras empilhadas)
df_beta_longo <- df_beta_comparativo %>%
pivot_longer(cols = c(Turnover, Nestedness),
names_to = "Componente",
values_to = "Valor_Beta")
# Calcular a proporção (porcentagem) para mostrar dentro das barras
df_beta_longo <- df_beta_longo %>%
group_by(Dominio) %>%
mutate(Total = sum(Valor_Beta),
Proporcao = Valor_Beta / Total * 100,
Label = paste0(round(Proporcao, 1), "%")) %>%
ungroup()
# Gerar o Gráfico de Barras Lado a Lado (Dodged)
ggplot(df_beta_longo, aes(x = Dominio, y = Valor_Beta, fill = Componente)) +
# position_dodge coloca as barras lado a lado em vez de empilhadas
geom_bar(stat = "identity", position = position_dodge(width = 0.8), width = 0.7, color = "black") +
# Adicionar os rótulos de porcentagem flutuando logo acima de cada barra
geom_text(aes(label = Label),
position = position_dodge(width = 0.8),
vjust = -0.5, # Empurra o texto um pouco para cima da barra
color = "black", fontface = "bold", size = 4.5) +
theme_bw() +
labs(title = "Componentes da Diversidade Beta por Dominio",
subtitle = "Substituicao (Turnover) vs. Perda de Especies (Nestedness)",
x = "Dominio Floristico (k=2)",
y = "Valor da Dissimilaridade (Jaccard)",
fill = "Componente da Beta:") +
# Aumenta um pouco o limite superior do eixo Y para os números não cortarem
scale_y_continuous(expand = expansion(mult = c(0, 0.15))) +
scale_fill_manual(values = c("Turnover" = "#2c3e50", "Nestedness" = "#bdc3c7")) +
theme(legend.position = "bottom",
plot.title = element_text(face = "bold"),
axis.text.x = element_text(size = 12, face = "bold"))
Anotações: Aqui foram listadas as localidades que se dividiram em Dominio A e B. No gráfico de Sankey é possível ver que a relação existente entre os dois grandes domínios formados pelo k=2 e os Biomas informados nas literaturas das quais obtivemos os dados.
6.2. Análise de espécies indicadoras
# 1. Rodar o IndVal para os 2 grupos
resultados_indval <- multipatt(matrix_run, my_data_group,
func = "IndVal.g",
duleg = TRUE,
control = how(nperm = 999))
# 2. Extrair significância e tratar os nomes dos grupos de forma dinâmica
res_tabela <- resultados_indval$sign
res_tabela$especie <- rownames(res_tabela)
# Identificar dinamicamente os nomes das colunas de grupo (ex: s.Floristic.Domain.A)
col_grupo_A <- grep("s.Floristic.Domain.A", colnames(res_tabela), value = TRUE)
col_grupo_B <- grep("s.Floristic.Domain.B", colnames(res_tabela), value = TRUE)
res_sig <- res_tabela %>%
filter(p.value <= 0.05) %>%
mutate(dominio = case_when(
get(col_grupo_A) == 1 ~ "Floristic Domain A",
get(col_grupo_B) == 1 ~ "Floristic Domain B",
TRUE ~ NA_character_
)) %>%
filter(!is.na(dominio))
# 3. Criar o Ranking (Top 10 por Domínio)
top_indicadoras <- res_sig %>%
group_by(dominio) %>%
slice_max(stat, n = 10) %>%
arrange(dominio, desc(stat))
# 4. Gráfico de Pontos (Dot Plot)
ggplot(top_indicadoras, aes(x = stat, y = reorder(especie, stat), color = dominio)) +
geom_segment(aes(x = 0, xend = stat, y = reorder(especie, stat), yend = reorder(especie, stat)),
color = "grey60", linetype = "dashed") +
geom_point(size = 4) +
facet_wrap(~dominio, scales = "free_y", ncol = 1) +
theme_bw() +
labs(title = "Top 10 Espécies Indicadoras por Domínio Florístico",
subtitle = "Baseado no método IndVal (stat > 0.5 e p < 0.05)",
x = "Valor de Indicação (IndVal stat)",
y = "Espécies") +
scale_color_manual(values = c("Floristic Domain A" = "#d95f02", "Floristic Domain B" = "#1b9e77")) +
theme(legend.position = "none",
axis.text.y = element_text(face = "italic"),
strip.background = element_rect(fill = "#f0f0f0"),
strip.text = element_text(face = "bold"))
# 1.1. ARMAZENAMENTO AUTOMÁTICO DAS ESPÉCIES E SEUS DOMÍNIOS
df_indicadoras <- top_indicadoras %>% select(especie, dominio)
cat("1. Buscando ocorrencias no GBIF para as especies indicadoras...\n")## 1. Buscando ocorrencias no GBIF para as especies indicadoras...cat("Isso pode levar alguns minutos. Aguarde o status de cada especie...\n\n")## Isso pode levar alguns minutos. Aguarde o status de cada especie...# 2. BUSCA NO GBIF COM FEEDBACK NO CONSOLE
ocorrencias_list <- lapply(df_indicadoras$especie, function(sp) {
cat("Consultando:", sp, "...")
# Busca com filtros de qualidade básicos
dados_gbif <- occ_data(scientificName = sp,
limit = 300,
hasCoordinate = TRUE,
hasGeospatialIssue = FALSE)$data
# Verifica se o GBIF retornou dados E se as colunas de coordenadas existem
if(!is.null(dados_gbif) && is.data.frame(dados_gbif) && nrow(dados_gbif) > 0 && "decimalLongitude" %in% colnames(dados_gbif)) {
dados_filtrados <- dados_gbif %>%
select(decimalLongitude, decimalLatitude) %>%
mutate(especie = sp)
cat(" OK! (", nrow(dados_filtrados), " registros validos)\n", sep="")
return(dados_filtrados)
} else {
cat(" NENHUM DADO ENCONTRADO.\n")
return(NULL)
}
})## Consultando: Astronium_fraxinifolium_Schott ... OK! (300 registros validos)
## Consultando: Casearia_sylvestris_Sw. ... OK! (300 registros validos)
## Consultando: Dipteryx_alata_Vogel ... OK! (300 registros validos)
## Consultando: Tabebuia_aurea_(Silva_Manso)_Benth._&_Hook.f._ex_S.Moore ... OK! (300 registros validos)
## Consultando: Rhamnidium_elaeocarpum_Reissek ... OK! (300 registros validos)
## Consultando: Curatella_americana_L. ... OK! (300 registros validos)
## Consultando: Qualea_grandiflora_Mart. ... OK! (300 registros validos)
## Consultando: Terminalia_argentea_Mart. ... OK! (300 registros validos)
## Consultando: Hymenaea_stigonocarpa_Mart._ex_Hayne ... OK! (300 registros validos)
## Consultando: Alibertia_edulis_(Rich.)_A.Rich._ex_DC. ... OK! (300 registros validos)
## Consultando: Aspidosperma_quebracho-blanco_Schltdl. ... OK! (300 registros validos)
## Consultando: Sarcomphalus_mistol_(Griseb.)_Hauenschild ... OK! (300 registros validos)
## Consultando: Senegalia_praecox_(Griseb.)_Seigler_&_Ebinger ... OK! (300 registros validos)
## Consultando: Tabebuia_nodosa_(Griseb.)_Griseb. ... OK! (300 registros validos)
## Consultando: Castela_coccinea_Griseb. ... OK! (300 registros validos)
## Consultando: Salta_triflora_(Griseb.)_Adr.Sanchez ... OK! (253 registros validos)
## Consultando: Sideroxylon_obtusifolium_subsp._obtusifolium ... OK! (223 registros validos)
## Consultando: Stetsonia_coryne_(Salm-Dyck)_Britton_&_Rose ... OK! (300 registros validos)
## Consultando: Anisocapparis_speciosa_(Griseb.)_Cornejo_&_Iltis ... OK! (300 registros validos)
## Consultando: Libidibia_paraguariensis_(D.Parodi)_G.P.Lewis ... OK! (300 registros validos)# Junta tudo num único Data Frame
df_ocorrencias <- bind_rows(ocorrencias_list)
# 3. VERIFICAÇÃO DE SEGURANÇA E FILTRO NEOTROPICAL
if(nrow(df_ocorrencias) > 0 && "decimalLongitude" %in% colnames(df_ocorrencias)) {
# Mantém apenas pontos dentro do boundary_area (usando os índices do objeto)
df_ocorrencias <- df_ocorrencias %>%
filter(decimalLongitude >= boundary_area[1] & decimalLongitude <= boundary_area[2],
decimalLatitude >= boundary_area[3] & decimalLatitude <= boundary_area[4])
# Trava de Segurança: Sobrou algum ponto depois do filtro?
if(nrow(df_ocorrencias) == 0) {
stop("ERRO: O GBIF encontrou dados, mas NENHUM PONTO caiu dentro das coordenadas do seu 'boundary_area'.")
}
cat("\nTotal de ocorrencias validas retidas para o mapa:", nrow(df_ocorrencias), "\n")
# 4. UNIR O DOMÍNIO (A ou B) ÀS COORDENADAS
df_ocorrencias <- df_ocorrencias %>% left_join(df_indicadoras, by = "especie")
# 5. TRANSFORMAR EM OBJETO ESPACIAL
points_sf <- st_as_sf(df_ocorrencias, coords = c("decimalLongitude", "decimalLatitude"), crs = 4326)
# 6. CARREGAR O SEU SHAPEFILE DE BIOMAS
# st_read costuma imprimir avisos, vamos oculta-los com quiet = TRUE
# IMPORTANTE: Verifique se o nome do seu arquivo é mapa_pontos1.gpkg ou mapa_pontos.gpkg
shape_biomas <- st_read("mapa_pontos.gpkg", quiet = TRUE)
# Força o shapefile a ter o mesmo CRS dos pontos (evita falha na renderização)
shape_biomas <- st_transform(shape_biomas, 4326)
cat("\n2. Gerando o Mapa de Validacao Espacial focado na sua regiao...\n")
# 7. VISUALIZAÇÃO AVANÇADA COM ZOOM NA ÁREA DE INTERESSE
mapa_validacao <- ggplot() +
geom_sf(data = shape_biomas, fill = "grey90", color = "grey50", linewidth = 0.5) +
geom_sf(data = points_sf, aes(color = dominio), size = 1.5, alpha = 0.8) +
# Sintaxe simplificada: pega os itens 1 e 2 para X, e os itens 3 e 4 para Y
coord_sf(xlim = boundary_area[1:2],
ylim = boundary_area[3:4],
expand = FALSE) +
scale_color_manual(values = c("Floristic Domain A" = "#d95f02", "Floristic Domain B" = "#1b9e77")) +
theme_minimal() +
labs(title = "Validacao Espacial das Especies Indicadoras",
subtitle = "Ocorrencias (GBIF) restritas a regiao delimitada",
color = "Dominio Floristico:") +
theme(legend.position = "bottom",
plot.title = element_text(face = "bold"),
panel.grid.major = element_line(color = "grey80", linetype = "dashed"))
print(mapa_validacao)
} else {
stop("ERRO CRITICO: Apos aplicar os filtros, nenhuma especie indicadora retornou ocorrencias do GBIF.")
}##
## Total de ocorrencias validas retidas para o mapa: 4667
##
## 2. Gerando o Mapa de Validacao Espacial focado na sua regiao...
Anotações: A partir da análise de espécies indicadoras, é possível determinar e validar domínios florísticos com base em literatura especializada, ou como fizemos aqui, verificamos as espécies indicadoras a partir da comparação com registros disponíveis no GBIF, o que mostrou o conjunto de indicadoras para o dominio A e B.
6.3. Separação e Eligibilidades do Grupo
# ==============================================================================
# PREPARAÇÃO PARA ETAPA 2: ISOLAMENTO DO DOMÍNIO DE INTERESSE
# ==============================================================================
# 2. DESCOBRIR EM QUAL DOMÍNIO as áreas alvo CAÍRAM
# Criamos um dataframe de conferência
df_conferencia <- data.frame(
Localidade = names(my_data_group),
Dominio_Estatistico = as.character(my_data_group)
)
# Filtramos apenas as suas áreas de interesse
resultado_alvos <- df_conferencia %>%
filter(Localidade %in% local_target) # aqui em local_target são as áreas alvo inseridas no início
print("--- ONDE AS ÁREAS BRASILEIRAS INCÓGNITAS CAÍRAM? ---")## [1] "--- ONDE AS ÁREAS BRASILEIRAS INCÓGNITAS CAÍRAM? ---"print(resultado_alvos)## Localidade Dominio_Estatistico
## 1 CHA_PANT_01 Floristic Domain B
## 2 CHA_PANT_02 Floristic Domain B
## 3 CHA_PANT_03 Floristic Domain B
## 4 CHA_PANT_04 Floristic Domain B
## 5 CHA_PANT_05 Floristic Domain B
## 6 CHA_PANT_07 Floristic Domain B
## 7 CHA_PANT_08 Floristic Domain B
## 8 FES_PANT_01 Floristic Domain A
## 9 CERDAO_CER_19 Floristic Domain A
## 10 CHA_PANT_09 Floristic Domain B
## 11 CHA_PANT_10 Floristic Domain B# Definir automaticamente o "Domínio Alvo" baseado na maioria
# (Para o caso de 99% cair no A e 1% cair no B)
dominio_alvo <- names(which.max(table(resultado_alvos$Dominio_Estatistico)))
cat("\n[!] O domínio que engloba as suas áreas de interesse é o:", dominio_alvo, "\n")##
## [!] O domínio que engloba as suas áreas de interesse é o: Floristic Domain B# 3. RECORTAR A MATRIZ APENAS PARA ESSE GRANDE DOMÍNIO
# Filtramos as linhas (localidades) que pertencem a esse domínio alvo
matrix_dominio_foco <- matrix_run[my_data_group == dominio_alvo, ]
# 4. LIMPEZA DA NOVA MATRIZ (CRÍTICO)
# Espécies exclusivas do domínio rejeitado agora têm soma = 0 nesta nova matriz.
# Precisamos remover essas "espécies fantasmas" para não travar análises futuras.
spp_presentes <- colSums(matrix_dominio_foco) > 0
matrix_alvo_limpa <- matrix_dominio_foco[, spp_presentes]
# 5. RELATÓRIO DO NOVO CONJUNTO DE DADOS
cat("\n=== RESUMO DA NOVA MATRIZ (FOCO NO BIOMA ALVO) ===\n")##
## === RESUMO DA NOVA MATRIZ (FOCO NO BIOMA ALVO) ===cat("Localidades retidas:", nrow(matrix_alvo_limpa), "\n")## Localidades retidas: 108cat("Espécies retidas (que ocorrem neste domínio):", ncol(matrix_alvo_limpa), "\n")## Espécies retidas (que ocorrem neste domínio): 569# Dica de ouro: Salve esta nova matriz caso queira inspecioná-la no Excel
# write.csv(as.data.frame(matrix_alvo_limpa), "matriz_dominio_foco.csv")
##########################
# ==============================================================================
# DENDROGRAMAS DO DOMÍNIO ALVO (FOCADO NAS ÁREAS DE INTERESSE)
# ==============================================================================
# 1. Calcular a matriz de distância Jaccard apenas para o domínio alvo
dissimilarity_alvo <- vegdist(matrix_alvo_limpa, method = "jaccard")
# 2. Gerar o agrupamento Ward
tree_alvo <- hclust(dissimilarity_alvo, method = "ward.D2")
dend_alvo <- as.dendrogram(tree_alvo)
# 3. Definir cores consistentes
# Como isolamos um domínio, todos serão de uma única cor (ou subdivididos, se desejar)
# Vamos colorir pelo grupo original (se ainda houver mistura) ou uma cor fixa
# Aqui usaremos a cor do domínio que o "dominio_alvo" revelou no script anterior
cor_dominio <- ifelse(dominio_alvo == "Floristic Domain A", "#d95f02", "#1b9e77")
dend_alvo <- color_branches(dend_alvo, k = 1, col = cor_dominio)
# ==============================================================================
# OPÇÃO 1: DENDROGRAMA PADRÃO (RETANGULAR)
# ==============================================================================
# 1. Ajustar as margens: c(baixo, esquerda, cima, direita)
# O número '12' na margem direita dá o espaço necessário para os nomes longos não cortarem
par(mar = c(4, 1, 3, 12))
# 2. Reduzir o tamanho da fonte das folhas (labels)
# Um cex de 0.3 ou 0.4 é ideal para tentar espremer 100+ ramos na tela
dend_alvo_tela <- set(dend_alvo, "labels_cex", 0.3)
# 3. Plotar na horizontal
plot(dend_alvo_tela,
main = paste("Estrutura Interna -", dominio_alvo), # <- O segredo está aqui! Vira o gráfico de lado.
xlab = "Distância de Ward")
Anotações: Aqui foi realizado um teste com base nas áreas consideradas Chaco no Brasil. O primeiro passo foi detectar em quais dos Dominios as localidades consideradas chaco no Brasil pertencem. Isso facilitou a escolha do Dominio a ser analisado separadamente.
6.4. Análise do dominio B
# ==============================================================================
# BUSCA AUTOMÁTICA DO 'k' INTERNO (SUBGRUPOS DO DOMÍNIO ALVO) VIA IndVal
# ==============================================================================
cat("Iniciando a busca automatica de subgrupos para o", dominio_alvo, "...\n")## Iniciando a busca automatica de subgrupos para o Floristic Domain B ...# 1. Configurar os parâmetros da Busca Dinâmica
k_atual <- 2
quedas_consecutivas <- 0
limite_quedas <- 3 # Para após 3 quedas sucessivas no total de espécies
max_spp_registrado <- 0
limite_seguranca <- 20 # Trava de segurança para evitar loops infinitos
# Criar um Data Frame vazio para armazenar os resultados
df_resultados_sub <- data.frame(
K = integer(),
Spp_Significativas = integer(),
Soma_IndVal = numeric()
)
# 2. Iniciar o Loop de Busca
set.seed(123) # Para reprodutibilidade das permutações
cat("O algoritmo vai parar sozinho se a quantidade de especies indicadoras cair", limite_quedas, "vezes seguidas.\n\n")## O algoritmo vai parar sozinho se a quantidade de especies indicadoras cair 3 vezes seguidas.while(quedas_consecutivas < limite_quedas && k_atual <= limite_seguranca) {
cat("Testando divisao interna em k =", k_atual, "...")
# Cortar a árvore ALVO
grupos_temp <- cutree(tree_alvo, k = k_atual)
# Rodar o IndVal na MATRIZ ALVO
indval_temp <- multipatt(matrix_alvo_limpa, grupos_temp,
func = "IndVal.g",
duleg = TRUE,
control = how(nperm = 999))
# Extrair tabela e filtrar as significativas (p <= 0.05)
res <- indval_temp$sign
spp_sig <- res[!is.na(res$p.value) & res$p.value <= 0.05, ]
qtd_spp <- nrow(spp_sig)
soma_ind <- sum(spp_sig$stat, na.rm = TRUE)
# Guardar no Data Frame
df_resultados_sub <- rbind(df_resultados_sub, data.frame(
K = k_atual,
Spp_Significativas = qtd_spp,
Soma_IndVal = soma_ind
))
cat(" Encontrou", qtd_spp, "especies indicadoras.\n")
# Avaliar o critério de parada
if(qtd_spp >= max_spp_registrado) {
max_spp_registrado <- qtd_spp
quedas_consecutivas <- 0 # Novo pico alcançado, zera o contador
} else {
quedas_consecutivas <- quedas_consecutivas + 1 # Caiu...
}
# Avançar k
k_atual <- k_atual + 1
}## Testando divisao interna em k = 2 ... Encontrou 171 especies indicadoras.
## Testando divisao interna em k = 3 ... Encontrou 277 especies indicadoras.
## Testando divisao interna em k = 4 ... Encontrou 326 especies indicadoras.
## Testando divisao interna em k = 5 ... Encontrou 287 especies indicadoras.
## Testando divisao interna em k = 6 ... Encontrou 298 especies indicadoras.
## Testando divisao interna em k = 7 ... Encontrou 303 especies indicadoras.cat("\nBusca Concluida! O algoritmo parou apos", quedas_consecutivas, "quedas sucessivas.\n\n")##
## Busca Concluida! O algoritmo parou apos 3 quedas sucessivas.# 3. Exibir a Tabela de Decisão
print("=== TABELA DE DECISAO DO 'K' INTERNO ===")## [1] "=== TABELA DE DECISAO DO 'K' INTERNO ==="print(df_resultados_sub)## K Spp_Significativas Soma_IndVal
## 1 2 171 79.05061
## 2 3 277 127.11454
## 3 4 326 164.32983
## 4 5 287 151.35917
## 5 6 298 158.80157
## 6 7 303 161.40256# ==============================================================================
# VISUALIZAÇÃO: CURVA DE AVALIAÇÃO DE SUBGRUPOS
# ==============================================================================
# Transformar dados para o formato longo do ggplot
df_plot_sub <- df_resultados_sub %>%
pivot_longer(cols = c(Spp_Significativas, Soma_IndVal),
names_to = "Metrica",
values_to = "Valor")
# Ajustar os rótulos para o gráfico
df_plot_sub$Metrica <- factor(df_plot_sub$Metrica,
levels = c("Spp_Significativas", "Soma_IndVal"),
labels = c("Total de Espécies Indicadoras (p < 0.05)",
"Força Cumulativa da Indicação (Soma IndVal)"))
# Identificar o pico absoluto encontrado
pico_sub_k <- df_resultados_sub$K[which.max(df_resultados_sub$Spp_Significativas)]
# Gerar o Gráfico
grafico_otimizacao_sub <- ggplot(df_plot_sub, aes(x = K, y = Valor)) +
geom_line(color = "#2980b9", linewidth = 1.2) +
geom_point(size = 3, color = "#2c3e50") +
# Linha marcando o pico
geom_vline(xintercept = pico_sub_k, linetype = "dashed", color = "#c0392b", linewidth = 1) +
facet_wrap(~Metrica, scales = "free_y", ncol = 1) +
# Adaptar o eixo X dinamicamente aos Ks testados
scale_x_continuous(breaks = min(df_resultados_sub$K):max(df_resultados_sub$K)) +
theme_bw() +
labs(title = paste("Busca Automatica de Subgrupos Internos -", dominio_alvo),
subtitle = paste("O pico biologico absoluto ocorreu em k =", pico_sub_k, "subgrupos"),
x = "Numero de Subgrupos no Dendrograma Alvo (k)",
y = "Valor da Metrica") +
theme(plot.title = element_text(face = "bold"),
strip.background = element_rect(fill = "#ecf0f1"),
strip.text = element_text(face = "bold", size = 11))
print(grafico_otimizacao_sub)
###################################
# ==============================================================================
# VISÃO GERAL: DENDROGRAMA CIRCULAR DOS SUBGRUPOS (SEM ETIQUETAS)
# ==============================================================================
library(dendextend)
library(circlize)
# 1. Definir o k óptimo (utiliza o valor do pico_sub_k calculado no script IndVal)
# Caso não tenha rodado o script anterior, pode definir manualmente (ex: k_sub <- 3)
k_sub <- pico_sub_k
# 2. Criar a paleta de cores (uma cor distinta para cada subgrupo)
# Se houver mais de 6 subgrupos, adicione mais códigos HEX à lista
paleta_sub <- c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00", "#FFFF33")[1:k_sub]
# 3. Preparar o Dendrograma
dend_alvo_circ <- as.dendrogram(tree_alvo)
# Colorir os ramos com base no número de subgrupos e na paleta
dend_alvo_circ <- color_branches(dend_alvo_circ, k = k_sub, col = paleta_sub)
# 4. Ajustar margens do ecrã para garantir que a legenda cabe perfeitamente
# c(baixo, esquerda, cima, direita) - Margem direita maior para a legenda
par(mar = c(2, 2, 2, 8))
# 5. Desenhar o Dendrograma Circular
# labels = FALSE garante que o gráfico fica limpo, apenas focado na topologia
circlize_dendrogram(dend_alvo_circ,
labels = FALSE,
main = paste("Subdivisões Florísticas do", dominio_alvo))
# 6. Adicionar a Legenda Lateral
legend("bottomright",
legend = paste("Agrupamento", 1:k_sub),
fill = paleta_sub,
bty = "n", # Sem caixa ao redor da legenda
cex = 0.9, # Tamanho do texto
title = "Subgrupos (k)")
#############################################
# ==============================================================================
# LUPAS: DENDROGRAMAS INDIVIDUAIS POR AGRUPAMENTO (PARA RMARKDOWN)
# ==============================================================================
# Nota: Removi o pdf() para que o plot seja renderizado diretamente no chunk do RMarkdown
library(dendextend)
# 1. Identificar a qual subgrupo cada localidade pertence
grupos_sub <- cutree(tree_alvo, k = k_sub)
# Garantir que temos a árvore base limpa
dend_base <- as.dendrogram(tree_alvo)
# 2. Ciclo (Loop) para desenhar cada agrupamento individualmente
# O RMarkdown mostrará cada um destes gráficos um após o outro no relatório final
for (i in 1:k_sub) {
# Selecionar apenas os nomes das localidades do grupo 'i'
locs_grupo <- names(grupos_sub[grupos_sub == i])
# Identificar o que podar
locs_remover <- labels(dend_base)[!labels(dend_base) %in% locs_grupo]
# Podar a árvore
dend_individual <- prune(dend_base, locs_remover)
# Aplicar a cor (usa a paleta definida no script anterior)
dend_individual <- color_branches(dend_individual, k = 1, col = paleta_sub[i])
# Ajustar legibilidade
dend_individual <- set(dend_individual, "labels_cex", 0.5)
dend_individual <- set(dend_individual, "branches_lwd", 2)
# Margens ajustadas para os nomes das localidades
# No RMarkdown, ajuste o 'fig.width' e 'fig.height' no cabeçalho do seu chunk
par(mar = c(5, 2, 4, 15))
# Plotar
plot(dend_individual,
horiz = TRUE,
main = paste("Agrupamento", i, ":", dominio_alvo),
xlab = "Distância de Ward")
}
Anotações: Nesta parte foi avaliado a parte do dendrograma que continha as localidades de levantamentos do Chaco brasileiro. Os ramos foram subdivididos de acordo com as espécies indicadoras, que de acordo com o método Early Stopping o valor de k foi 4, ou seja, divisão em 4 subgrupos (dendrograma circular). Na sequencia separamos cada subgrupo em dendrogramas com a localidade indicadas nas extremidades dos ramos.