Skip to content

Instantly share code, notes, and snippets.

@pecard

pecard/MAP Species distribution using censuses data using GGPLOT

Created March 11, 2010 00:50
Show Gist options
  • Save pecard/328673 to your computer and use it in GitHub Desktop.
Save pecard/328673 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
MAP Species distribution using censuses data using GGPLOT
#! Cartografia de dados distribuição aves - LOOP GGPLOT
#! Paulo E. Cardoso
#! Código Cores Hexadecimais - Normas Strix
#! Verde claro (#7FC31C), Verde escuro (#292F19), Laranja (#FF7F00), Azul claro (#80CECF)
#! OBJECTOS IMPORTANTES
#! tabAtlasT - Sumario Abundancias totais das especies por Quadricula/Epoca/Area
#!== Packages necessários:
#! check for packages available on disk or istall it from internet cran repository
#if (!require(sp)) install.packages("sp",r epos = "http://cran.r-project.org");library(sp)
#if (!require(maptools)) install.packages("maptools", repos = "http://cran.r-project.org");library(maptools)
if (!require(ggplot2)) install.packages("ggplot2", repos = "http://cran.r-project.org"); library(ggplot2)
if (!require(grDevices)) install.packages("grDevices", repos = "http://cran.r-project.org"); library(grDevices)
if (!require(RColorBrewer)) install.packages("RColorBrewer", repos = "http://cran.r-project.org");library(RColorBrewer)
if (!require(methods)) install.packages("methods", repos = "http://cran.r-project.org");library(methods)
#if (!require(vegan)) install.packages("vegan", repos = "http://cran.r-project.org"); library(vegan)
#if (!require(maps)) install.packages("maps", repos = "http://cran.r-project.org"); library(maps)
if (!require(grid)) install.packages("grid", repos = "http://cran.r-project.org"); library(grid)
if (!require(Hmisc)) install.packages("Hmisc", repos = "http://cran.r-project.org"); library(Hmisc)
#if (!require(gdata)) install.packages("gdata",repos = "http://cran.r-project.org");library(gdata)
#! drop.levels(x, reorder=TRUE, ...) do package gdata - TESTAR
#!=======================================================================================================
#! ==================================== Abrir Workspace =================================================
load('D:/...Rdata')
#!=========================== Criar objecto para directorio de trabalho =================================
wd<-file.path(chartr("\\", "/", "D:\\..."))
#!=======================================================================================================
#! =============================== ELEMENTOS DE BASE PARA AS ANÁLISES ===================================
#!=======================================================================================================
#! =================================== Leitura das Shapefiles ===========================================
#! As grelhas APENAS devem conter a coluna Quad: código da quadrícula
#! ==== Grelha completa ==============
#! shapefile
grelha <- readShapeSpatial('D:/Strix/EdiaAlvitoMNovoPisao/Shp/grelha_total_montenovo_alvito_pisao.shp')
grelhaCentroide <- data.frame(coordinates(grelha)) #1 Centroides dos polígonos
#! Dataframe com a ordem das quadículas na shapefile e o respectivo ID (código)
grelhaID <- data.frame(grelha@data, idI = seq(1 : nrow(grelha@data)))
grelhaID <- cbind(grelhaID, grelhaCentroide)
levels(grelhaID$Bloco)[3] <- "PI" # apenas nesta função para corrigir o código
win.graph(); plot(grelhaID$X1, grelhaID$X2, asp = 1, pch = 19); text(grelhaID$X1, grelhaID$X2 + 300,
labels = grelhaID$Quad, cex = 0.8)
#! ==== Monte Novo ===================
grelhaMN <- readShapeSpatial(paste(wd, "Shp\\grelha_mte-nov.shp",sep=''))
grelhaMNCentr <- data.frame(coordinates(grelhaMN)) #! Centroide da grelha
#! Dataframe com a ordem ads quadículas na shapefile e o respectivo ID (código)
grelhaMNID <- data.frame(grelhaMN@data, idI = seq(1 : nrow(grelhaMN@data)))
grelhaMNID <- cbind(grelhaMNID, grelhaMNCentr)
win.graph(); plot(grelhaMNID$X1, grelhaMNID$X2, asp = 1, pch = 19); text(grelhaMNID$X1, grelhaMNID$X2 + 200,
labels = grelhaMNID$Quad, cex = 0.7)
#! ==== Alvito Pisao =================
grelhaAP <- readShapeSpatial('D:/Strix/EdiaAlvitoMNovoPisao/Shp/grelha_alvito-pisao.shp')
grelhaAPCentr <- data.frame(coordinates(grelhaAP)) #! Centroide da grelha
#! Dataframe com a ordem ads quadículas na shapefile e o respectivo ID (código)
grelhaAPID <- data.frame(grelhaAP@data, idI = seq(1 : nrow(grelhaAP@data)))
grelhaAPID <- cbind(grelhaAPID, grelhaAPCentr)
win.graph(); plot(grelhaAPID$X1, grelhaAPID$X2, asp = 1, pch = 19); text(grelhaAPID$X1, grelhaAPID$X2 + 200,
labels = grelhaAPID$Quad, cex = 0.7)
#! ==== Pisao ========================
grelhaP <- readShapeSpatial(paste(wd, "Shp\\grelha_pisao.shp", sep = ''))
grelhaPCentr <- data.frame(coordinates(grelhaP)) #! Centroide da grelha
#! Dataframe com a ordem das quadículas na shapefile e o respectivo ID (código)
grelhaPID <- data.frame(grelhaP@data, idI = seq(1 : nrow(grelhaP@data)))
grelhaPID <- cbind(grelhaPID, grelhaPCentr); grelhaPID
win.graph(); plot(grelhaPID$X1, grelhaPID$X2, asp = 1, pch = 19); text(grelhaPID$X1, grelhaPID$X2 + 200,
labels = grelhaPID$Quad, cex = 0.7)
#!=======================================================================================================
#!============================ Leitura dos ficheiros txt tab delimited ==================================
#!=======================================================================================================
#! === Tabela completa com os dados dos censos de aves 2008 =============================================
tab <- read.table(paste(wd, "R\\Dados_Atlas_MN_Pisao_R.txt", sep=''), sep = "\t", dec = ".", header = T)
tab$Esp <- as.character(tab$Esp)
tab$Area <- as.character(tab$Area)
#tab$calendario <- as.POSIXct(strptime(tab$Data,"%d-%m-%Y")) #! Neste caso não ha dados de calendario
#tab$HoraH <- cut(tab$calendario,"hour", include.lowest=T)
#tab$HoraH <- substring(tab$HoraH,12,16)
#! Corrigir o nome da área do Pisao para PI
tab$Area[tab$Area == "P"] <- "PI"
#!=======================================================================================================
#! === Tabela com dados de Nidificação da Primavera de 2008
tab_Nid <- read.table(paste(wd, "/Analise/Nidificacao_2008_R.txt", sep=''), sep = "\t", dec = ".", header = T)
tab_Nid$Epoca <- "Primavera"
tab_Nid_ctd <- merge(tab_Nid, grelhaID, by = "Quad", all.x = T)
names(tab_Nid_ctd)[8:9] <- c("Xctd", "Yctd")
#!=======================================================================================================
#!=======================================================================================================
#! === Tabela completa com os dados dos censos de aves 2007 MATOS e FONSECA
tab2007 <- read.table(paste(wd, "R/Tabelas/BD_2007_Matos_Associados_Primav.txt", sep=''), sep = "\t", dec = ".",
stringsAsFactors = F, header = T)
#! Retirar observações que nao sejam Sistematicas e remover duplas entradas, se existentes
tab2007 <- tab2007[tab2007$Tipo_de_visita == "Sistemática", ]
#! Teste à tabela
#as.data.frame(table(paste(tab2007$Quad,tab2007$Species,sep=""))) #! se Freq > 1 == Erro!
#! Correcção da tabela para analise de presenças / ausencias
tab2007 <- ddply(tab2007[ ,c(8, 9, 3)], c("Quad", "Species"), summarize, "Presenca" = length(N_indiv))
tab2007$Presenca[tab2007$Presenca > 1] <- 1
tab2007$Ano <- 2007
#!=======================================================================================================
#! ========== Tabela com a Ordem (taxonómica) e Ecologia (Esteparias/Não estepária) e Rapinas ===========
Tax_Ecol <- read.csv(paste(wd, "R/Dados_Atlas_MN_Pisao_Taxon_R.csv", sep = ''),sep = ';', header = T, as.is = T)
Tax_Ecol <- Tax_Ecol[order(Tax_Ecol$ID_sistematica), ]
#! ======================================================================================================
#! ===================================== ANÁLISES DE DADOS ==============================================
#! ======================================================================================================
#! =============================== Função para contagem de factores =====================================
func <- function(x = x)length(unique(x))
#! ======================== Tabela sem os dados suplementares - tabAtlas ================================
tabAtlas <- tab[tab$Tipo.info < 6, ] #! Tabela sem os dados onde Tipo.info < 6
#tabAtlas$Quad <- tabAtlas$Quad[,drop = T] #! Elimina factores não utilizados
#! Remove quadrículas não amostradas - Neste caso Quadrícula 6
tabAtlas <- tabAtlas[!is.na(tabAtlas$Quad == T), ]
#! ======================================================================================================
#! ==== Abundancia total das especie por Quadricula/Epoca/Area - somatorio das bandas de observação =====
#! ======================================================================================================
#! Sumario Quadricula/Epoca/Area/Ntotal
tabAtlasT <- ddply(tabAtlas, c("Quad", "Epoca", "Area", "Esp"), summarize, NTot = sum(N))
tabAtlasT$Esp <- as.character(tabAtlasT$Esp)
#tabAtlasT$AreaEpoca <- paste(tabAtlasT$Area, substr(tabAtlasT$Epoca, 1, 3),sep = '')
#! ==== Analise das distribuiçoes de NTot nas diferentes areas de estudo ================================
ddply(tabAtlasT, c("Area","Epoca"), summarize, "Media" = mean(NTot), "Mediana" = median(NTot, na.rm = T),"Max" = max(NTot))
win.graph(20, 20)
boxplot(tabAtlasT$NTot[tabAtlasT$Area == "MN" & tabAtlasT$Epoca == "Primavera" ], main = "MN Primavera", xlab = "Abundância (N)", outline = F)
hist(tabAtlasT$NTot[tabAtlasT$Area == "PI" & tabAtlasT$Epoca == "Inverno"], breaks = 100, main = "P Inverno", xlab = "Abundância (N)")
#! ======================================================================================================
#! ======================================================================================================
#! ================================ Cartografias com os elementos SIG ===================================
#! ======================================================================================================
#! Código Cores Hexadecimais - Normas Strix
#! Verde claro (#7FC31C), Verde escuro (#292F19), Laranja (#FF7F00), Azul claro (#80CECF)
#! ==================================== Converte SPolyDF em List ========================================
#! grelha[grelha@data$Bloco=="P",] tambem gera um SPDFrame para um loop - Testar
#! Converte SPDF em List
grelhamapAP <- lapply(slot(grelhaAP, "polygons"), function(x) lapply(slot(x, "Polygons"), function(y) slot(y, "coords")))
grelhamapMN <- lapply(slot(grelhaMN, "polygons"), function(x) lapply(slot(x, "Polygons"), function(y) slot(y, "coords")))
grelhamapP <- lapply(slot(grelhaP, "polygons"), function(x) lapply(slot(x, "Polygons"), function(y) slot(y, "coords")))
#! ========================= Construcao do objecto legível pelo gpackage ggplot2 =========================
#! ==== Alvito Pisao =================
dfTmp <- list()
for (i in 1 : dim(summary(grelhamapAP))[1])
{
#! Adiciona o código e a ordem das coordenadas à cada linha
dfTmp[[i]] <- data.frame(grelhamapAP[i], "Id" = i-1, "Ordem" = seq(1 : 5), "Quad" = grelhaAP@data[[1]][i])
}
dfGridAP <- do.call(rbind, dfTmp) #! Obtem-se um Dataframe para o ggplot2 a partir do objecto List
dfGridAP$id <- as.numeric(row.names(dfGridAP))
win.graph(); ggplot(dfGridAP, aes(x = X1,y = X2)) +
geom_polygon(aes(group = Id, fill = Id), colour = "black") +
coord_equal()
#! ==== Monten Novo ==================
dfTmp <- list()
for (i in 1 : dim(summary(grelhamapMN))[1])
{
#! Adiciona o código e a ordem das coordenadas à cada linha
dfTmp[[i]] <- data.frame(grelhamapMN[i], "Id" = i-1, "Ordem" = seq(1 : 5), "Quad" = grelhaMN@data[[1]][i])
}
dfGridMN <- do.call(rbind, dfTmp) #! Obtem-se um Dataframe para o ggplot2 a partir do objecto List
dfGridMN$id <- as.numeric(row.names(dfGridMN))
win.graph(); ggplot(dfGridMN, aes(x = X1,y = X2)) +
geom_polygon(aes(group = Id, fill = Id), colour = "black") +
coord_equal()
#! ==== Pisao ========================
dfTmp <- list()
for (i in 1 : dim(summary(grelhamapP))[1])
{
#! Adiciona o código e a ordem das coordenadas à cada linha
dfTmp[[i]] <- data.frame(grelhamapP[i], "Id" = i-1, "Ordem" = seq(1 : 5), "Quad" = grelhaP@data[[1]][i])
}
dfGridP <- do.call(rbind, dfTmp) #! Obtem-se um Dataframe para o ggplot2 a partir do objecto List
dfGridP$id <- as.numeric(row.names(dfGridP))
win.graph(); ggplot(dfGridP, aes(x = X1,y = X2)) +
geom_polygon(aes(group = Id, fill = Id), colour = "black") +
coord_equal()
#! ======================================================================================================
#! =========================================== MAPAS DE DISTRIBUIÇÃO ====================================
#! ======================================================================================================
#! Localidades na área de estudo
Loc <- data.frame(Area = c("MN", "PI", "AP"),
Local = c("São Manços", "Beringel", "Cuba"),
X1 = c(233351.3, 213003.0, 221160.4),
X2 = c(165741.6, 121132.0, 133166.3))
#! Lista das dataframes das quadriculas das areas
grelhas <- list("MN" = as.list(dfGridMN), "AP" = as.list(dfGridAP), "PI" = as.list(dfGridP))
#! Paleta de Cores para cada Area
win.graph(); RColorBrewer::display.brewer.all() #! Escolha do espaço de cores
#paleta <- as.factor(c("#FFFFFF",brewer.pal(6,"YlOrRd")))
#! ================================ LOOP para MAPA Area/Especie/Epoca ========================
#! Contrução das classes de abundancia para cada area (totalmente arbitrario)
classes <- read.table(paste(wd, "R/Tabelas/classes abundancias MNAP2009.txt", sep=""),
header=T, sep="\t",stringsAsFactors=F)
#! Opção legenda com inicio e fim iguais
nomes_classes_abundancias <- c("0", "[1, 3)", "[3, 5)", "[5, 10)", "[10, 25)", "[25, 50)", "> 50")
#! Preparar tabela tabAtlas para a conjugaçao das paletas de cores distintas para as areas/epocas
for(aa in unique(tabAtlasT$Area)) #! 1 Áreas de estudo
{
#! === 1 - Reconstroi o data.frame a partir da lista com as grelhas separadas
gridArea_a_e <- as.data.frame(grelhas[[substr(aa, 1, 2)]])
#for(ee in unique(tabAtlasT$Epoca)) #! 2 Época de amostragem
for(ee in "Primavera") #! 2 Época de amostragem
{
#! === 2 - Isolar a grelha para cada uma das áreas tres de estudo
tabAtlasT_ae <- subset(tabAtlasT, Area == aa & Epoca == ee) #! Cria o subset de dados para a Area hh
#! === 3 - Cria classe de abundancia com base nos quantis de distribuiçao de NTot
tabAtlasT_ae$classeN <- as.factor(cut2(tabAtlasT_ae$NTot, cuts = subset(classes, Area == aa & Epoca == ee)$Classe, digits = 4, onlycuts = F))
#! === 4 - Associa o nome à paleta criada
paleta <- as.factor(c("#FFFFFF", brewer.pal((length(levels(tabAtlasT_ae$classeN))) - 1, "YlOrRd")))
names(paleta)[1 : length(paleta)] <- levels(tabAtlasT_ae$classeN)
#! === 5 - Associa a informação taxonomica à tabela com a subamostra
tabAtlasT_ae_tax <- merge(tabAtlasT_ae, Tax_Ecol, by.x = "Esp",by.y = "Esp", all.x = T)
tabAtlasT_ae_tax <- tabAtlasT_ae_tax[order(tabAtlasT_ae_tax$ID_sistematica), ]
#! === 6- Classes de Abundancias totais para as especies observadas em cada bloco
espList <- unique(tabAtlasT_ae_tax$Esp) #! Espécies ordenadas por ordem taxonómica (filogenética) espList<-espList[1:2]
espList <- espList[15 : 17] #! subgrupo para teste
for(i in espList) #! 3 Especie
{
#! === 7 - Subset da tabela de dados apenas para a espécie i
spi<-tabAtlasT_ae_tax[tabAtlasT_ae_tax$Esp==i, ]
#! === 8 - Abundancias minima e maxima para a especie i
min_spi <- min(spi$NTot); max_spi <- max(spi$NTot)
#! === 9 - Merge da dataframe com os dados da espécie na dataframe com a Grelha da área aa
gridArea_a_e_esp <- merge(gridArea_a_e, spi, by.x = "Quad", by.y = "Quad", all.x = T)
gridArea_a_e_esp$NTot[is.na(gridArea_a_e_esp$NTot)] <- 0
gridArea_a_e_esp$classeN[is.na(gridArea_a_e_esp$classeN == T)] <- levels(gridArea_a_e_esp$classeN)[1]
gridArea_a_e_esp <- gridArea_a_e_esp[order(gridArea_a_e_esp$id, gridArea_a_e_esp$Id), ]
#! === 10 - Subset da tabela de dados de nidificação apenas para a espécie i
tab_Nid_ae <- subset(tab_Nid_ctd, Esp == i & Bloco == aa)
tab_Nid_ae <- tab_Nid_ae[tab_Nid_ae$Quad %in% gridArea_a_e_esp$Quad[gridArea_a_e_esp$NTot != 0], ]
#gridArea_a_e_esp_Nid <- merge(gridArea_a_e_esp, tab_Nid_ae, by.x = "Quad", by.y = "Quad", all.x = T)
#gridArea_a_e_esp_Nid <- gridArea_a_e_esp_Nid[order(gridArea_a_e_esp_Nid$id, gridArea_a_e_esp_Nid$Id), ]
#gridArea_a_e_esp_Nid[is.na(gridArea_a_e_esp_Nid$Nidific) == F, ]
#! === 11 - Titulos do gráfico - não consigo alterar a formataçção da fonte no titulo
nomeComum_esp <- paste(Tax_Ecol$Nomecomum[Tax_Ecol$Esp == i], " ", sep = "")
nomeCient_esp <- Tax_Ecol$Nome[Tax_Ecol$Esp == i]
#! === 11 - Construção do gráfico para a espécie i
graph <- ggplot(gridArea_a_e_esp, aes(x = X1,y = X2)) +
geom_polygon(aes(group = Id, fill = as.factor(classeN)), colour = "grey80") +
coord_equal() +
scale_fill_manual(paste("Estação: ", ee, "\nAbundâncias", "\nIntervalo: ", min_spi, " - ", max_spi, sep = ""),
values = paleta, labels = c("0", "[1, 3)", "[3, 5)", "[5, 10)", "[10, 25)", "[25, 50)", "> 50")) +
scale_y_continuous("Coordenada Y") +
scale_x_continuous("Coordenada X") +
#! Opçoes de formataçao
opts(#!legend.position = "none", - Para eliminar a legenda, se necessario
title = paste(nomeComum_esp, nomeCient_esp), #! Titulo do grafico
plot.title = theme_text(size = 12,face = "italic"), #! Formataçao do titulo do grafico
axis.text.x = theme_text(hjust = 0.5,vjust = 1.2, size = 10,col = "grey50"), #! altera a formataçao do png (?)
axis.text.y = theme_text(hjust = 0.5, vjust = 0, size = 10,col = "grey50", angle = 90),
axis.title.x = theme_text(size = 10),
axis.title.y = theme_text(size = 10, angle = 90),
legend.title = theme_text(hjust = 0,size = 10, face = "bold"),
legend.text = theme_text(hjust = -0.2, size = 10)) +
#! Sobrepor pontos com código de nidificação
geom_point(aes(x = Xctd, y = Yctd, shape = Nidific), colour = "grey30", data = tab_Nid_ae, size = 2) +
scale_shape(name="Nidificação", solid = F, labels = c("Confirmada", "Possível", "Provável"))
#! Adicionar pontos que podem representar localidades, outras referencias
#geom_point(aes(x = X1, y = X2), colour = "black",data =
# data.frame(X1 = Loc$X1[Loc$Area == substr(aa, 1, 2)],
# X2 = Loc$X2[Loc$Area == substr(aa, 1, 2)]), size = 2.5) +
#geom_text(aes(x = X1, y = X2, label = Loc$Local[Loc$Area == substr(aa, 1, 2)]), colour = "black",
# data = data.frame(X1 = Loc$X1[Loc$Area == substr(aa, 1, 2)] + 900,
# X2 = Loc$X2[Loc$Area == substr(aa, 1, 2)] - 0), size = 3)
#! Exportar o grafico como imagem - neste caso um png com 500x430px (arbitrario e ajustado manualmente)
#! Calcular a dimensão: X cm / 0.03527 = Y dpi
#! As ordem das imagens produzidas será pela ordem taxonomica.
#! === 12 - Exporta o gráfico para a espécie i para um ficheiro
png(bg = "transparent", width = 425, height = 335, file = paste("D:\\...",
Tax_Ecol$ID_sistematica[Tax_Ecol$Esp == i], "-",Tax_Ecol$Nome[Tax_Ecol$Esp == i], "-EDIA_MNAP_", aa,"_",ee,".png", sep = ""))
print(graph) #! Um objecto tipo trellis necessita de ser recuperado com print()
dev.off() #! Encerra o png
graphics.off() #! Encerra qualquer graphical device que possa estar aberto
} #! 3
} #! 2
} #!1
graphics.off()
#!=======================================================================================================
#! Comparaçao entre os diferentes anos de amostragem para a PRIMAVERA
#! Não houve uma metodologia comum entre os anos
#! A metodologia de 2007 considerou 20min de censos
#! Enquanto em 2008 os censos tiveram apenas 15 min
#! Por esta razao so serao comparaveis as presenças/ausencias nas quadriculas.
#!=======================================================================================================
tab2008 <- tabAtlasT[tabAtlasT$Epoca == "Primavera", ]
tab2008$Epoca <- tab2008$Epoca[,drop = T]
#! === Tabela para presenças ausências dos dados de 2008 - Strix
tab2008pa <- tab2008[ ,c(1, 4)]
tab2008pa$Presenca <- 2
tab2008pa$Ano <- 2008
#! === Tabela para presenças ausências dos dados de 2007
tab2007pa <- tab2007
names(tab2007pa) <- names(tab2008pa) #! Apenas porqie diferiam na tabela original. Garantir que a ordem é a mesma
#! === Combina as tabelas dos dois anos
tab_pa <- rbind(tab2008pa, tab2007pa)
tab_Anos <- melt(cast(tab_pa[ ,-4],Quad ~ Esp, sum), id = c("Quad", "Esp"))
tab_Anos$value <- as.factor(tab_Anos$value)
#! Adiciona o código da área de estudo
tab_compara_Anos <- merge(tab_Anos,grelhaID[ ,1:2],by = "Quad")
#! Corrige a discrepancia no código do Bloco do Pisao (P vs PI)
tab_compara_Anos$Bloco <- as.character(tab_compara_Anos$Bloco)
tab_compara_Anos$Bloco[tab_compara_Anos$Bloco=="P"] <- "PI"
#! =================================== LOOP para Comparação Anos/Primavera ==============================
#! Paleta de cores para os mapas
paleta_compara_Anos <- as.factor(c("#FFFFFF", "#66CCCC", "#2E5C8A", "#B87A3D"))
names(paleta_compara_Anos) <- c("0","1","2","3")
for(hh in c("MN", "AP", "PI")) #! 1
{
#! === 1 - Isolar a grelha para cada uma das áreas tres de estudo
tab_cAnos_subArea <- subset(tab_compara_Anos, Bloco == hh) #! Cria o subset de dados para a Area hh
#! === 2 - Associa a informação taxonomica à tabela com a subamostra
tab_cAnos_subArea <- merge(tab_cAnos_subArea, Tax_Ecol, by.x = "Esp",by.y = "Esp", all.x = T)
tab_cAnos_subArea <- tab_cAnos_subArea[order(tab_cAnos_subArea$ID_sistematica), ] #! Ordena pela Taxonomia
#! === 4 - Classes de Abundancias totais para as especies observadas em cada bloco
espList_compara_Anos <- unique(tab_cAnos_subArea$Esp) #! Espécies ordenadas por ordem taxonómica (filogenética) espList<-espList[1:2]
#espList_compara_Anos <- espList[10 : 15] #! subgrupo para teste
for(i in espList_compara_Anos) #! 2
{
spi <- tab_cAnos_subArea[tab_cAnos_subArea$Esp == i, ] # spi<-spQuad[spQuad$Esp==espList[i],]
#! === 7 - Merge da dataframe com os dados da espécie na dataframe com a ordem da grelha
gridsubArea_ca <- as.data.frame(grelhas[[hh]]) #! Reconstroi o data.frame a partir da lista com as grelhas separadas
fillAb_ca <- merge(gridsubArea_ca, spi, by.x = "Quad", by.y = "Quad", all.x = T)
fillAb_ca$value[is.na(fillAb_ca$value)] <- 0
fillAb_ca <- fillAb_ca[order(fillAb_ca$id, fillAb_ca$Id), ]
#! === 8 - Titulos do gráfico - não consigo alterar a formataçção da fonte no titulo
nomeComum_i <- paste(Tax_Ecol$Nomecomum[Tax_Ecol$Esp == i], " ", sep = "")
nomeCient_i <- Tax_Ecol$Nome[Tax_Ecol$Esp == i]
#! === 9 - Construção do gráfico para a espécie i
graph <- ggplot(fillAb_ca, aes(x = X1,y = X2)) +
geom_polygon(aes(group = Id, fill = as.factor(value)), colour = "grey80") +
coord_equal() +
scale_fill_manual(paste("Estação: ", jj, "\nComparação anual\nda presença na área", sep = ""), values = paleta_compara_Anos, labels = c("Não detectada", "Apenas em 2007", "Apenas em 2008", "Em 2007 e 2008")) +
scale_y_continuous("Coordenada Y") +
scale_x_continuous("Coordenada X") +
#! Opçoes de formataçao
opts(#!legend.position = "none", - Para eliminar a legenda, se necessario
title = paste(nomeComum_i, nomeCient_i), #! Titulo do grafico
plot.title = theme_text(size = 12,face = "italic"), #! Formataçao do titulo do grafico
axis.text.x = theme_text(hjust = 0.5,vjust = 1.2, size = 10,col = "grey50"), #! altera a formataçao do png (?)
axis.text.y = theme_text(hjust = 0.5, vjust = 0, size = 10,col = "grey50", angle = 90),
axis.title.x = theme_text(size = 10),
axis.title.y = theme_text(size = 10, angle = 90),
legend.title = theme_text(hjust = 0,size = 10, face = "bold"),
legend.text = theme_text(hjust = -0.2, size = 10)) +
#! Adicionar pontos que podem representar localidades, outras referencias
geom_point(aes(x = X1,y = X2), colour = "black",data = data.frame(X1 = Loc$X1[Loc$Area == substr(hh, 1, 2)], X2 = Loc$X2[Loc$Area == substr(hh, 1, 2)]), size = 2.5) +
geom_text(aes(x = X1,y = X2,label = Loc$Local[Loc$Area == substr(hh, 1, 2)]), colour = "black",data = data.frame(X1 = Loc$X1[Loc$Area == substr(hh, 1, 2)] + 900, X2 = Loc$X2[Loc$Area == substr(hh, 1, 2)] - 400), size = 4)
#! Exportar o grafico como imagem - neste caso um png com 500x430px (arbitrario e ajustado manualmente)
png(bg = "transparent", width = 540, height = 440, file = paste("D:/... ".png", sep = "")) #! Ordena tanto por ordem taxominoma como pela epoca-ordem taxonomica.
print(graph) #! Um objecto tipo trellis necessita de ser recuperado com print()
dev.off() #! Encerra o png
graphics.off() #! Encerra qualquer graphical device que possa estar aberto
}#!2
}#!1
graphics.off()
#! ===================================== Exportar Workspace =============================================
save.image('D:...
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment