2023-05-29

Modelo de distribución potencial del colibrí Basilinna xantusii usando las variables ambientales propuestas por Cuervo et.,al 2014



Macho de colibrí de Xantus Basilinna xantusii Tomada: naturalista.mx

Biología de la especie

  • Especie nectarívora endémica de la porción sur de la Península de Baja California

  • Colectada John Xántus 1859

  • Descrita en 1860 por George Lawrence

  • Está presente en: vegetación de costa al nivel de mar, oasis con vegetación mésica, bosques tropicales deciduos (300-800 msnm), y bosques de pino-encino (1400 msnm)

Objetivo

  • Realizar el modelo de distribución potencial del colibri Basilinna xantusii, obtenido con el set de variables ambientales: Propuestos por Cuervo- Robayo et al. 2014 y encontrar climas análogos en México.

Registros de ocurrencias GBIF y Limpieza datos

  • Definir ruta del proyecto
setwd ("C:/Users/Karen Tatiana/Desktop/ProyectoR")
setwd ("C:/Users/Karen Tatiana/Desktop/ProyectoR")
  • Limpiar archivos
library(ntbox)
library(dplyr)
library(raster)
library(rgdal)
library(rio)
dAll_a<-rio::import("data/colibri.csv")
dAll_b <- dAll_a %>% dplyr::filter(year>=1970)
cat("Numero total de datos de presencia para el periodo >=1970:",
    nrow(dAll_b))

Eliminamos datos duplicados en la geografía

dAll_c <- ntbox::clean_dup(dAll_b, longitude = "longitude","latitude",
          threshold = 0)
cat("Numero total de datos de presencia despues de la limpieza 
     de duplicados espaciales:",
     nrow(dAll_c))

write.csv(dAll_c, "colibri_limpieza.csv")

Mapa con los puntos de Basilinna xantusii
  • Se obtuvo una base cruda con 4785 registros

Selección datos finales

colibri<-read.csv("./Colibri_limpieza.csv", sep = ",")
str(colibri)
names(colibri)
colibri.p <- colibri [, 2:4]
 [1] "X"               "species"           "decimalLongitude"             
 [4] "decimalLatitude" "countryCode"       "individualCount"              
 [7] "gbifID"          "family"            "taxonRank"                    
[10] "coordinateUncer" "year"              "basisOfRecord"                
[13] "institutionCode" "datasetName" 

Adelgazamiento datos

library(spThin)
thinned_dataset_full <-
  thin(loc.data = colibri.p, 
  lat.col = "decimalLatitude", long.col = "decimalLongitude", 
  spec.col = "species", 
  thin.par = 5, reps = 10, 
  locs.thinned.list.return = TRUE, 
  write.files = FALSE, 
  write.log.file = FALSE)
write.csv(thinned_dataset_full[[1]],"C:/Users/Karen Tatiana/Desktop/
          ProyectoR/Colibri_joint.csv")

Creación buffer

library(geobuffer)
pts_buf_5km <- geobuffer_pts(xy = colibripoint, dist_m = 5*10^3) 
library(rnaturalearth)
world <- ne_countries(scale = "medium", returnclass = "sf")
puntos <- as.data.frame(colibripoint)
ggplot()+
  geom_sf(data = world,fill= NA) +
  coord_sf(xlim = c(-117.074597, -92.263143), 
  ylim = c(32.469688, 21.598125))+
  geom_polygon(data = pts_buf_5km,aes(x=long,y=lat, group = group),
               colour = "darkgray", fill="grey", alpha=0.2)+
  labs(x = "", y = "",title =paste("M para Basilinna xantusii")+
  geom_point(data=puntos,aes(x=Longitude,y=Latitude),color="purple",
             alpha=0.8, cex=0.3)+
  scale_fill_discrete(drop=FALSE)+
  theme_light()

Puntos con buffer Baja california

Corte de capas ambientales

Variables predictoras 19 superficies climáticas a nivel mensual, con una resolución espacial de 30 arco segundos (~1 km), desarrolladas por Cuervo-Robayo et al. (2014),

Carga y corte de capas ambientales Cuervo et.,al para Baja california

lyCuervo <-stack(list.files("C:/Users/Karen Tatiana/Desktop/
          ProyectoR/Shape/b19802009gw", 
          "*.tif$",full.names = TRUE, recursive = TRUE))
                            
r2 <- crop(lyCuervo, extent(pts_buf_5km))
r3 <- mask(r2, pts_buf_5km)

setwd("C:/Users/Karen Tatiana/Desktop/ProyectoR/VarMColibriCuerA")
writeRaster(r3, filename=names(r3), bylayer=TRUE, format= "ascii")

Corte al neotropico

r4 <- crop(lyCuervo, extent(mascara))
r5 <- mask(r4, mascara)

setwd("C:/Users/Karen Tatiana/Desktop/ProyectoR/VarGColibriCuervo")
writeRaster(r5, filename=names(r5), bylayer=TRUE, format= "ascii")

Correlación variables

r3table<-as.data.frame(r3)
r3table<-na.omit(r3table)
library(corrplot)
corpearson<-cor(r3table)
corrplot(corpearson,method="circle")

Gráfico Correlación variables

Análisis correlación

|   term    | bio01_t3gw  | bio12_t3gw |
|---------- |------------ | -----------|
|bio02_t3gw |   -0.409    |  0.114     |
|bio03_t3gw |   -0.678    |  0.720     |
|bio04_t3gw |    0.404    | -0.620     |
|bio05_t3gw |    0.740    | -0.731     |
|bio07_t3gw |    0.146    | -0.463     |
|bio08_t3gw |    0.723    | -0.299     |
|bio14_t3gw |   -0.628    |  0.310     |
|bio15_t3gw |    0.120    |  0.690     |
|bio17_t3gw |   -0.677    |  0.465     |
|bio19_t3gw |   -0.796    |  0.206     |

Análisis VIF

library(usdm)
vif.res<-vif(x=r3table)
vif.step<-vifstep(x=r3table,th =10)
| Variables  |  VIF   | 
|----------  |------- |
| bio02_t3gw |2.250711|
| bio03_t3gw |3.830482|
| bio08_t3gw |2.798147|
| bio09_t3gw |4.587815|
| bio13_t3gw |4.543518|
| bio14_t3gw |4.799117|
| bio15_t3gw |6.827562|
| bio19_t3gw |5.797698|

Division de datos de entrenamiento y prueba

smp_size <- floor(0.8 * nrow(puntos))
train_ind <- sample(seq_len(nrow(puntos)), size = smp_size)
train <- puntos[train_ind, ]
test <- puntos[-train_ind, ]
dim(train)
## [1] 172   3
dim(test)
## [1] 43  3

Datos Calibración - Entrenamiento

ggplot()+
  geom_sf(data = world,fill= NA) +
  coord_sf(xlim =c(-117.074597, -92.263143), ylim=c(32.469688, 21.598125))+
  geom_polygon(data = pts_buf_5km,aes(x=long,y=lat, group = group),
               colour = "darkgray", fill="grey", alpha=0.2)+
  labs(x = "", y = "",title =paste("Puntos Calibración-entrenamiento"),
       caption = "Trabajo en preparación - Karen")+
  geom_point(data=train,aes(x=Longitude,y=Latitude),color="red",alpha=0.8)+
  geom_point(data=test,aes(x=Longitude,y=Latitude),color="blue",alpha=0.8)+
  scale_fill_discrete(drop=FALSE)+
  theme_light()

Mapa Calibración - Entrenamiento

-Puntos azules Calibración -Puntos rojos Entrenamiento

Guardar archivos para el Modelo

write.csv(train,
file=("C:/Users/Karen Tatiana/Desktop/ProyectoR/Colibri_train.csv"),
quote = FALSE,row.names = FALSE)

write.csv(test,
file=("C:/Users/Karen Tatiana/Desktop/ProyectoR/Colibri_test.csv"),
quote = FALSE,row.names = FALSE)

Modelación de distribución potencial de Basilinna xantusii


Modelos candidatos

library(kuenm)
  • Cargar las variables
occ_joint <- "Colibri_joint.csv"
occ_tra <- "Colibri_train.csv"
M_var_dir <- "VarMColibriCuerA"
batch_cal <- "Candidate_models"
out_dir <- "Candidate_Models"
reg_mult <- c(0.5,1,2)
f_clas <- c("lqpth","lqp")
args <- NULL
maxent_path <- "C:/Users/Karen Tatiana/Downloads/Maxent/programa"
wait <- FALSE
run <- TRUE

kuenm_cal(occ.joint=occ_joint, occ.tra =occ_tra, M.var.dir=M_var_dir, 
          batch = batch_cal, out.dir = out_dir, reg.mult = reg_mult, 
          f.clas = f_clas, args = args, maxent.path = maxent_path, 
          wait = wait, run = run)

Evaluación y selección de los mejores modelos

occ_test <- "Colibri_test.csv"
out_eval <- "Calibration_results"
threshold <- 5
rand_percent <- 50
iterations <- 500
kept <- TRUE
selection <- "OR_AICc"
cal_eval<-kuenm_ceval(path=out_dir,occ.joint=occ_joint,occ.tra=occ_tra, 
          occ.test = occ_test, batch = batch_cal, out.eval=out_eval, 
          threshold = threshold, rand.percent = rand_percent, 
          iterations = iterations, kept = kept, selection = selection)

Modelos Finales

batch_fin <- "Final_models"
mod_dir <- "Final_Models"
rep_n <- 10
rep_type <- "Bootstrap"
jackknife <- TRUE
out_format <- "logistic"
project <- TRUE
G_var_dir <- "VarGColibriCuervo"
ext_type <- "no_ext"
write_mess <- FALSE
write_clamp <- FALSE
wait1 <- FALSE
run1 <- TRUE
args <- NULL

kuenm_mod(occ.joint=occ_joint, M.var.dir M_var_dir, out.eval=out_eval, 
          batch=batch_fin, rep.n = rep_n, rep.type = rep_type, 
          jackknife=jackknife, out.dir = mod_dir, out.format=out_format, 
          project=project, G.var.dir = G_var_dir, ext.type=ext_type,
          write.mess=write_mess, write.clamp=write_clamp, 
          maxent.path=maxent_path, args=args, wait=wait1, run=run1)

Modelo final

occ_ind <- "Sp_ind.csv"
replicates <- TRUE
out_feval <- "Final_Models_evaluation"
fin_eval<- kuenm_feval(path=mod_dir,occ.joint=occ_joint,occ.ind=occ_ind, 
                        replicates=replicates, out.eval=out_feval, 
                        threshold=threshold, rand.percent=rand_percent,
                        iterations=iterations)

Resultados modelos

-Se obtuvieron 26 modelos candidatos

-El mejor fue : M_2_F_lqp_Set_1

Porcentaje de contribución de las variables

Análisis Jackknife

Distribucion Potencial

Distribución Potencial - Climas análogos

Gracias