R/Precipitacion.R

Defines functions Precipitacion

Documented in Precipitacion

#' @title Datos de precipitación
#' @description Descarga datos de worldclim.org.
#' @details Descarga datos geoespaciales de precipitación del portal worldclim.org, posteriormente es procesado a la zona de estudio.
#' @param Zona Es el archivo vectorial cargado anteriormente con la función ZOna_estudio
#' @return Devuelve un raster stack de datos de precipitación.
#' @export
Precipitacion<-function(Zona){


  if(dir.exists("~/_Descarga_Datos/Precipitacion/Datos/") == FALSE){
    dir.create("~/_Descarga_Datos/Precipitacion/Datos/", recursive=TRUE)
  }
  if(dir.exists(paste0("~/_Descarga_Datos/Precipitacion/Procesamiento/",Sys.Date(),"/raster/", sep=" ")) == FALSE){
    dir.create(paste0("~/_Descarga_Datos/Precipitacion/Procesamiento/",Sys.Date(),"/raster/", sep=" "), recursive=TRUE)
  }
  if(dir.exists(paste0("~/_Descarga_Datos/Precipitacion/Procesamiento/",Sys.Date(),"/mapas/", sep=" ")) == FALSE){
    dir.create(paste0("~/_Descarga_Datos/Precipitacion/Procesamiento/",Sys.Date(),"/mapas/", sep=" "), recursive=TRUE)
  }

  cat("\nCargando un vectorial de la zona de estudio... ***\n")

  cat("\nProcesando datos mundiales de precipitación...\n")

  setwd("~/_Descarga_Datos/Precipitacion/Datos/")

  Archivo<-file.exists("wc2.1_30s_prec_01.tif")
  if(Archivo==FALSE){
    Archivo<-file.exists("Precipitacion.zip")
    if(Archivo==TRUE){
      Prec_datos<- list.files(pattern="*.zip")
      cat("\nDescomprimiendo archivo...\n")
      utils::unzip(Prec_datos[1], overwrite = TRUE)
    }else{
      cat("\nDescargando archivo...\n")
      utils::download.file("http://biogeo.ucdavis.edu/data/worldclim/v2.1/base/wc2.1_30s_prec.zip", dest="Precipitacion.zip")
      Prec_datos<- "Precipitacion.zip"
      cat("\nDescomprimiendo archivo...\n")
      utils::unzip(Prec_datos, overwrite = TRUE)
    }
  }


  cat("\nCargando datos de precipitación a R...\n")
  Prec_datos<- list.files(pattern = "tif")
  Prec_datos<- raster::stack(Prec_datos)
  #Prec_datos
  #names(Prec_datos)
  Meses<-(c("Enero", "Febrero", "Marzo", "Abril",
            "Mayo", "Junio", "Julio", "Agosto",
            "Septiembre", "Octubre", "Noviembre", "Diciembre"))
  names(Prec_datos)<-Meses
  #Prec_datos
  col_RB<-grDevices::colorRampPalette(c("Red", "Yellow", "Blue"))
  cat("\nDelimitando la precipitación...\n")
  Dimen<-dim(Prec_datos)
  Prec_datos<-raster::crop(Prec_datos,raster::extent(Zona))
  if(Dimen[1] & Dimen[2] != 1){
    Prec_datos<-raster::mask(Prec_datos, Zona)
  }
  Area_extension<-raster::extent(raster::bbox(Zona))
  Prec_datos@extent<-raster::extent(Area_extension)
  setwd(paste0("~/_Descarga_Datos/Precipitacion/Procesamiento/",Sys.Date()))
  #col_RB<-colorRampPalette(c("Red", "Yellow", "Blue"))
  i=0
  while(i <= raster::nlayers(Prec_datos)){
    i<-i+1
    if(i <= raster::nlayers(Prec_datos)){
      cat("Datos restantes: ",(raster::nlayers(Prec_datos)-i), "\n")
      raster::writeRaster(Prec_datos[[i]], filename = paste0("~/_Descarga_Datos/Precipitacion/Procesamiento/",Sys.Date(),"/raster/","P_",i,"_", Meses[i]), suffix=Meses[i], format="GTiff", overwrite=TRUE)
      grDevices::png(filename=paste0("~/_Descarga_Datos/Precipitacion/Procesamiento/",Sys.Date(),"/mapas/",i,"_",Meses[i],"_Precipitacion.png"), width = 1200, height=1200, units="px")
      raster::plot(Prec_datos[[i]], col=col_RB(raster::maxValue(Prec_datos[[i]])), main="Precipitación", sub=paste0(Meses[i]),
           cex.main=3, cex.sub=2, cex.lab=4)
      grDevices::dev.off()
    }
  }
  return(Prec_datos)
}
Leugimxw9/GeoReqHid documentation built on June 16, 2021, 12:11 a.m.