Skip to content

Commit

Permalink
Reformata os arquivos em ENM/fct/ (issue #1)
Browse files Browse the repository at this point in the history 
Usei o formatR para colocar os códigos mais próximos do estilo recomendado
pelo Wickham.

A função usada foi

tidy_dir('ENM/fct/', width.cutoff=80, indent=2)

Comentários inline e definição de funções foram alteradas manualmente.
  • Loading branch information
@gmgall
gmgall committed Apr 4, 2017
1 parent 7a79bbd commit 6a1378e
Show file tree
Hide file tree
Showing 8 changed files with 1,221 additions and 1,246 deletions.
80 changes: 38 additions & 42 deletions ENM/fct/createBuffer.R
View file
Original file line number Diff line number Diff line change
@@ -1,43 +1,39 @@
createBuffer <- function(coord_ = coord,
sp_ = sp,
occs_ = occs,
seed_ = seed,
n.back_ = n.back,
buffer.type_ = "mean"
){
#Transformando em spatial points
coordinates(coord_) <- ~lon+lat

if (buffer.type_ == "mean") dist.buf <- mean(spDists(x = coord_, longlat = FALSE, segments = TRUE))
if (buffer.type_ == "max") dist.buf <- max(spDists(x = coord_, longlat = FALSE, segments = TRUE))

buffer <- raster::buffer(coord_, width = dist.buf, dissolve = TRUE)

#Transformando coords de novo em matriz para rodar resto script
coord_ <- occs_[occs_$sp == sp_,c('lon','lat')]

#Transformando em spatial polygon data frame
buffer <- SpatialPolygonsDataFrame(buffer,data=as.data.frame(buffer@plotOrder), match.ID = FALSE)
crs(buffer) <- crs(predictors)

#########TENHO CERTEZA DE QUE ISTO PODE FICAR MENOS PESADO
#Reference raster com mesmo extent e resolution que predictors
r_buffer <- crop(predictors, buffer)
r_buffer <- mask(r_buffer, buffer)

#r_buffer <- raster(ext=extent(predictors), resolution=res(predictors))

#Rasterizando o buffer p/ geração dos ptos aleatorios
#r_buffer <- rasterize(buffer, r_buffer, field=buffer@plotOrder)
#Limitando a mascara ambiental
#r_buffer <- r_buffer*(predictors[[1]]!=0)
################


#Gerando pontos aleatorios no buffer
set.seed(seed_+2)
backgr <- randomPoints(r_buffer, n.back_)
rm(buffer)
gc()
return(backgr)
createBuffer <- function(coord_ = coord, sp_ = sp, occs_ = occs, seed_ = seed, n.back_ = n.back,
buffer.type_ = "mean") {
# Transformando em spatial points
coordinates(coord_) <- ~lon + lat

if (buffer.type_ == "mean")
dist.buf <- mean(spDists(x = coord_, longlat = FALSE, segments = TRUE))
if (buffer.type_ == "max")
dist.buf <- max(spDists(x = coord_, longlat = FALSE, segments = TRUE))

buffer <- raster::buffer(coord_, width = dist.buf, dissolve = TRUE)

# Transformando coords de novo em matriz para rodar resto script
coord_ <- occs_[occs_$sp == sp_, c("lon", "lat")]

# Transformando em spatial polygon data frame
buffer <- SpatialPolygonsDataFrame(buffer, data = as.data.frame(buffer@plotOrder),
match.ID = FALSE)
crs(buffer) <- crs(predictors)

######### TENHO CERTEZA DE QUE ISTO PODE FICAR MENOS PESADO Reference raster com mesmo
######### extent e resolution que predictors
r_buffer <- crop(predictors, buffer)
r_buffer <- mask(r_buffer, buffer)

# r_buffer <- raster(ext=extent(predictors), resolution=res(predictors))

# Rasterizando o buffer p/ geração dos ptos aleatorios r_buffer <-
# rasterize(buffer, r_buffer, field=buffer@plotOrder) Limitando a mascara
# ambiental r_buffer <- r_buffer*(predictors[[1]]!=0)


# Gerando pontos aleatorios no buffer
set.seed(seed_ + 2)
backgr <- randomPoints(r_buffer, n.back_)
rm(buffer)
gc()
return(backgr)
}
10 changes: 5 additions & 5 deletions ENM/fct/cropModel.R
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
cropModel <- function(modelo, mascara){
modelo <- crop(modelo, mascara)
modelo <- mask(modelo, mascara)
return(modelo)
}
cropModel <- function(modelo, mascara) {
modelo <- crop(modelo, mascara)
modelo <- mask(modelo, mascara)
return(modelo)
}
57 changes: 24 additions & 33 deletions ENM/fct/eigenvariables.fct.R
View file
Original file line number Diff line number Diff line change
@@ -1,42 +1,33 @@
eigenvariables.fct <- function(vars, name, proportion = 0.95){
eigenvariables.fct <- function(vars, name, proportion = 0.95) {
library("raster")
if (file.exists("./pca") == FALSE) dir.create("./pca")
#Running PCA:
# Counts not NA cels
if (file.exists("./pca") == FALSE)
dir.create("./pca")
# Running PCA: Counts not NA cels
non.na <- sum(!is.na(values(vars[[1]])))
# Sample the study area with n-non.na and creates an environmental table
sr <- sampleRandom(vars, non.na)
# faz o PCA dessa tabela padronizada
pca <- prcomp(scale(sr))
summary.pca <- summary(pca)
#Saving results:
capture.output(pca, file = sprintf('./pca/%s.pca.txt', name))

#saving summary
capture.output(summary.pca, file = sprintf('./pca/%s.summary.pca.txt', name))

#Plotting results
#GGPLOT
#####
#library(ggplot2)
# create data frame with scores
#scores <- as.data.frame(pca$x)
# plot of observations
#ggplot(data = scores, aes(x = PC1, y = PC2, label = rownames(scores))) +
# geom_hline(yintercept = 0, colour = "gray65") +
# geom_vline(xintercept = 0, colour = "gray65") +
# geom_text(colour = "tomato", alpha = 0.8, size = 4) +
# ggtitle("PCA plot of USA States - Crime Rates")
#####
# png(filename = sprintf('./pca/%s.pca.biplot.png',name),
# bg = "white")
# biplot(pca)
# dev.off()

# Saving results:
capture.output(pca, file = sprintf("./pca/%s.pca.txt", name))

# saving summary
capture.output(summary.pca, file = sprintf("./pca/%s.summary.pca.txt", name))

# Plotting results GGPLOT library(ggplot2) create data frame with scores scores
# <- as.data.frame(pca$x) plot of observations ggplot(data = scores, aes(x = PC1,
# y = PC2, label = rownames(scores))) + geom_hline(yintercept = 0, colour =
# 'gray65') + geom_vline(xintercept = 0, colour = 'gray65') + geom_text(colour =
# 'tomato', alpha = 0.8, size = 4) + ggtitle('PCA plot of USA States - Crime
# Rates') png(filename = sprintf('./pca/%s.pca.biplot.png',name), bg = 'white')
# biplot(pca) dev.off()

# Creating eigenvariable in space
axis.nb <- which(summary.pca$importance["Cumulative Proportion",] >= proportion)[1]
axis.nb <- which(summary.pca$importance["Cumulative Proportion", ] >= proportion)[1]
eigenvariables <- predict(vars, pca, index = 1:axis.nb)

if (file.exists("./env") == FALSE) dir.create("./env")
writeRaster(eigenvariables,sprintf('./env/%s.eigenvariables.tif',name),overwrite=T)
}

if (file.exists("./env") == FALSE)
dir.create("./env")
writeRaster(eigenvariables, sprintf("./env/%s.eigenvariables.tif", name), overwrite = T)
}
139 changes: 73 additions & 66 deletions ENM/fct/ensemble.R
View file
Original file line number Diff line number Diff line change
@@ -1,71 +1,78 @@
ensemble <- function(sp,
models.dir = "./models",##onde estao os modelos em geral ("models")
final.dir = "presfinal", ##onde estao os modelos finais ("presfinal")
ensemble.dir = "ensemble",
occs = spp.filt,
which.models = c("Final.bin.mean3","Final.mean.bin7"),
consensus = F,
consensus.level = 0.5#cuanto de los modelos sea retenido: 0.5majority
){
## onde estao os modelos em geral ('models') onde estao os modelos finais
## ('presfinal') cuanto de los modelos sea retenido: 0.5majority

##pasta de output
if (file.exists(paste0(models.dir,"/",sp,"/",ensemble.dir,"/")) == FALSE){
dir.create(paste0(models.dir,"/",sp,"/",ensemble.dir,"/"))
}#
library(raster)
library(scales)
library(maps)

## para cada tipo de modelo
for (whi in which.models){

cat(paste(whi,"-",sp,"\n")) #lê os arquivos
tif.files <- list.files(paste0(models.dir,"/",sp,"/",final.dir),full.names=T,pattern=paste0(whi,'.*tif$'))

if(length(tif.files)==0) {
cat(paste("No models to ensemble from for",sp,"\n"))
} else {
cat(paste(length(tif.files),"models to ensemble from for",sp,"\n"))
mod2 <- raster::stack(tif.files)
if(length(tif.files)==1){
ensemble.m <- mod2
} else {
#plot(mod2)
ensemble <- function(sp, models.dir = "./models", final.dir = "presfinal", ensemble.dir = "ensemble",
occs = spp.filt, which.models = c("Final.bin.mean3", "Final.mean.bin7"), consensus = F,
consensus.level = 0.5) {

## pasta de output
if (file.exists(paste0(models.dir, "/", sp, "/", ensemble.dir, "/")) == FALSE)
{
dir.create(paste0(models.dir, "/", sp, "/", ensemble.dir, "/"))
} #
library(raster)
library(scales)
library(maps)

## para cada tipo de modelo
for (whi in which.models) {

cat(paste(whi, "-", sp, "\n")) #lê os arquivos
tif.files <- list.files(paste0(models.dir, "/", sp, "/", final.dir), full.names = T,
pattern = paste0(whi, ".*tif$"))

if (length(tif.files) == 0) {
cat(paste("No models to ensemble from for", sp, "\n"))
} else {
cat(paste(length(tif.files), "models to ensemble from for", sp, "\n"))
mod2 <- raster::stack(tif.files)
if (length(tif.files) == 1) {
ensemble.m <- mod2
} else {
# plot(mod2)
ensemble.m <- mean(mod2)
ensemble.sd <- raster::overlay(mod2,fun=function(x){return(sd(x,na.rm=T))})
}
coord <- occs[occs$sp==sp,c('lon','lat')]

#par(mar=c(5,4,1,1))
#plot(ensemble.m,main=paste(sp,whi,"ensemble"),font.main=3)
#points(coord,pch=19,col=alpha("grey60",0.6))
#map('world',c('',"South America"),add=T,col="grey")

png(filename=paste0(models.dir,"/",sp,"/",ensemble.dir,"/",sp,"_",whi,"_ensemble.png"),res=300,width=410*300/72,height=480*300/72)
par(mfrow=c(1,1),mar=c(3,4,4,0))
plot(ensemble.m,main=paste(sp,whi),legend=F,
cex.main=1,font.main=3)
map('world',c('',"South America"),add=T,col="grey")
points(coord,pch=21,cex=0.6,bg=scales::alpha("cyan",0.6))
ensemble.sd <- raster::overlay(mod2, fun = function(x) {
return(sd(x, na.rm = T))
})
}
coord <- occs[occs$sp == sp, c("lon", "lat")]

# par(mar=c(5,4,1,1)) plot(ensemble.m,main=paste(sp,whi,'ensemble'),font.main=3)
# points(coord,pch=19,col=alpha('grey60',0.6)) map('world',c('','South
# America'),add=T,col='grey')

png(filename = paste0(models.dir, "/", sp, "/", ensemble.dir, "/", sp,
"_", whi, "_ensemble.png"), res = 300, width = 410 * 300/72, height = 480 *
300/72)
par(mfrow = c(1, 1), mar = c(3, 4, 4, 0))
plot(ensemble.m, main = paste(sp, whi), legend = F, cex.main = 1, font.main = 3)
map("world", c("", "South America"), add = T, col = "grey")
points(coord, pch = 21, cex = 0.6, bg = scales::alpha("cyan", 0.6))
dev.off()

# o ensemble cru
writeRaster(ensemble.m, filename = paste0(models.dir, "/", sp, "/", ensemble.dir,
"/", sp, "_", whi, "_ensemble.tif"), overwrite = T)

#### Consensus models
if (consensus == TRUE) {
ensemble.consensus <- ensemble.m >= consensus.level
writeRaster(ensemble.consensus, filename = paste0(models.dir, "/",
sp, "/", ensemble.dir, "/", sp, "_", whi, "_ensemble", consensus.level *
100, ".tif"), overwrite = T)


png(filename = paste0(models.dir, "/", sp, "/", ensemble.dir, "/",
sp, "_", whi, "_ensemble", consensus.level * 100, ".png"), res = 300,
width = 410 * 300/72, height = 480 * 300/72)
par(mfrow = c(1, 1), mar = c(3, 4, 4, 0))
plot(ensemble.consensus, main = paste(whi, consensus.level * 100),
legend = F, cex.main = 1, font.main = 3)
map("world", c("", "South America"), add = T, col = "grey")
points(coord, pch = 19, cex = 0.3, col = scales::alpha("cyan", 0.6))
dev.off()

# o ensemble cru
writeRaster(ensemble.m,filename=paste0(models.dir,"/",sp,"/",ensemble.dir,"/",sp,"_",whi,"_ensemble.tif"),overwrite=T)

####Consensus models
if (consensus == TRUE){
ensemble.consensus <- ensemble.m >= consensus.level
writeRaster(ensemble.consensus,filename=paste0(models.dir,"/",sp,"/",ensemble.dir,"/",sp,"_",whi,"_ensemble",consensus.level*100,".tif"),overwrite=T)


png(filename=paste0(models.dir,"/",sp,"/",ensemble.dir,"/",sp,"_",whi,"_ensemble",consensus.level*100,".png"),res=300,width=410*300/72,height=480*300/72)
par(mfrow=c(1,1),mar=c(3,4,4,0))
plot(ensemble.consensus,main=paste(whi,consensus.level*100),legend=F,cex.main=1,font.main=3)
map('world',c('',"South America"),add=T,col="grey")
points(coord,pch=19,cex=0.3,col=scales::alpha("cyan",0.6))
dev.off()
}
}
}
}
#return(ensemble.m)
}
# return(ensemble.m)
}
Loading

0 comments on commit 6a1378e

Please sign in to comment.