R/plot.lu.ecors.R

In fredtaka/ecors: Remote Sensing data acquisition and processing for ecology with Google Earth Engine

#' Plot lu.ecors object
#'
#' Plot MapBiomas images processed by get.lu.ecors along with site and sample polygons.
#'
#' @param x lu.ecors object (from get.lu.ecors).
#' @param comp lu.ecors object generated by focal.lu.ecors or convert.lu ecors functions or ecors object (remote sensing) used for comparison (optional).
#' @param zoom initial zoom value.
#' @param legend choose to show the legend or not.
#'
#' @return
#' Google Earth Engine containers objects are exported to .GlobalEnv to be used in rgee functions and avoid errors (elapsed time limit):
#' \itemize{
#' \item map.samples: sample polygons (evaluation carried out in the surroundings of these polygons),
#' \item map.site: site polygon (evaluation carried out in the surroundings of this polygon),
#' \item map.polygons: polygon for land use evaluation (evaluation carried out inside these polygons),
#' \item map.buffer(i): polygons of buffer areas (if selected in get.lu.ecors);
#' \item map.lu(i): plot object of a raster image (one object per image),
#' \item leg.lu: legend.}
#'
#' @export
#' @import rgee
#' @import googledrive
#' @import sf
#' @import dplyr
#'
#' @examples
#' # Get a lu.ecors class object
#' FAL.IBGE.JBB<-sf::st_read(system.file("extdata/FAL.IBGE.JBB.gpkg", package="ecors"))
#' test.points<-sf::st_read(system.file("extdata/Points_tests.gpkg", package="ecors"))
#' test.plots<-sf::st_read(system.file("extdata/Plots_tests.gpkg", package="ecors"))
#'
#' # Get data (projecting to UTM 32S zone to performe buffer operations)
#' lu2000_2010<-get.lu.ecors(site=FAL.IBGE.JBB, points=test.points, plots=test.plots,
#'      polygons=NULL, id.column=1, projected=F, custom.crs=32723,
#'      collection.lu="mapbiomas6", years=c(2000,2010), resolution=30, evaluate="surroundings.site",
#'      buffer1=5000, buffer2=10000, buffer3=15000, cumulative.surroundings=F)
#'
#' # Plotting
#' plot(x=lu2000_2010)
#'
#' # Focal post-processing and visually checking
#' f_lu2000_2010<-focal.lu.ecors(x=lu2000_2010,window.radius=80)
#' plot(x=lu2000_2010, comp=f_lu2000_2010)
#'
#' # Grouping several native land use classes and visually checking
#' converted<-convert.lu.ecors(x=lu2000_2010,old.value = c(1,3,4,10,11,12,13),new.value = rep(1,times=7), new.lu.class = rep("Native",times=7))
#' plot(x=lu2000_2010, comp=converted)


plot.lu.ecors<-function(x,comp=NULL,zoom=12,legend=T){

  if(class(x)!="lu.ecors"){stop("Argument x must be a lu.ecors class object.")}

  lu.prov<-eval(parse(text=x$object.name))


  if(is.null(comp)==F){if(class(comp)!="lu.ecors" & class(comp)!="ecors"){stop("Argument comp must be a ecors or lu.ecors class object.")}
    if(class(comp)=="lu.ecors"){
      if(comp$post.processing=="none"){stop("Argument comp with a lu.ecors class object needs to be generated by focal.lu.ecors or convert.lu.ecors functions.")}
    }
  }

  #To get center
  if(x$evaluate=="surroundings.site"){center.poly.transf<-x$site.gee$geometry(1)$transform(maxError=10)}#convert to WG84 (default); maxError value is mandatory (since 2022)
  if(x$evaluate=="surroundings.samples"){center.poly.transf<-x$samples.gee$geometry(1)$transform(maxError=10)}
  if(x$evaluate=="inside.polygons"){center.poly.transf<-x$polygons.gee$geometry(1)$transform(maxError=10)}
  if(x$evaluate=="distance.samples"){center.poly.transf<-x$samples.gee$geometry(1)$transform(maxError=10)}


  center<-center.poly.transf$centroid()$getInfo()$coordinates #esse comando é incompatível com UTM

  Map$setCenter(center[1],center[2],zoom)
  comando.visuali<-c()
  comando.visualiB<-c()

  for (i in 1:length(x$years)){
    par.vis.lu<-list(palette=x$palette.lu$color,values=x$palette.lu$lu.class,bands=paste0("classification_",x$years[i]),min=0,max=max(x$palette.lu$pixel.value))
    prov<-Map$addLayer(lu.prov,par.vis.lu,paste0(x$years[i]))
    assign(paste0("map.lu",i),prov,envir=.GlobalEnv)
    if(length(comando.visuali)==0){comando.visuali<-c("map.lu1")} else {
      comando.visuali<-paste0(comando.visuali,"+map.lu",i)}

    if(is.null(comp)==F){
      if(class(comp)=="lu.ecors"){
        lu.f<-eval(parse(text=comp$object.name))
        prov.f<-Map$addLayer(lu.f,par.vis.lu,paste0(x$years[i],comp$post.processing[length(comp$post.processing)]))
        assign(paste0("map.lu.f",i),prov.f,envir=.GlobalEnv)
        if(length(comando.visualiB)==0){comando.visualiB<-c("map.lu.f1")} else {
          comando.visualiB<-paste0(comando.visualiB,"+map.lu.f",i)}
      }
    }
  }

  #different number of images here (separated loop)
  if(is.null(comp)==F){
    if(class(comp)=="ecors"){
      vpar<-comp$d.vpar
      colle.plot<-colle.filt

      if(is.null(comp$d.vpar$reescalonar)==F){
        multiplica<-comp$vpar$reescalonar$multiplica #list '$' is incompatible with map functions
        soma<-comp$vpar$reescalonar$soma
        vpar<-within(comp$vpar,rm(reescalonar))
        FUNreescalonar<-function(imagem){imagem$multiply(multiplica)$add(soma)}
        colle.plot<-colle.plot$map(FUNreescalonar)
      }

      for (i in 1:nrow(comp$images.table)){
        prov.sat<-Map$addLayer(colle.plot[[i]],comp$vpar,as.character(comp$images.table$OKdates[i]))
        assign(paste0("img",i),prov.sat,envir=.GlobalEnv)
        if(length(comando.visualiB)==0){comando.visualiB<-c("img1")} else {
          comando.visualiB<-paste0(comando.visualiB,"+img",i)}
      }
    }
  }

  if(legend==T){
    leg.lu<<-Map$addLegend(par.vis.lu,name="Legend",color_mapping="character",position="topright")
    comando.visuali<-paste0(comando.visuali,"+leg.lu")
  }
  if(is.null(x$site.gee)==F){
    map.site<<-Map$addLayer(x$site.gee,name="site")
    comando.visuali<-paste0(comando.visuali,"+map.site")
  }
  if(is.null(x$samples.gee)==F){
    map.samples<<-Map$addLayer(x$samples.gee,name="samples")
    comando.visuali<-paste0(comando.visuali,"+map.samples")
  }
  if(is.null(x$polygons.gee)==F){
    map.polygons<<-Map$addLayer(x$polygons.gee,name="polygons")
    comando.visuali<-paste0(comando.visuali,"+map.polygons")
  }
  if(is.null(x$polig.lu1.gee)==F){
    map.buffer1<<-Map$addLayer(x$polig.lu1.gee,name="buffer1")
    comando.visuali<-paste0(comando.visuali,"+map.buffer1")
  }
  if(is.null(x$polig.lu2.gee)==F){
    map.buffer2<<-Map$addLayer(x$polig.lu2.gee,name="buffer2")
    comando.visuali<-paste0(comando.visuali,"+map.buffer2")
  }
  if(is.null(x$polig.lu3.gee)==F){
    map.buffer3<<-Map$addLayer(x$polig.lu3.gee,name="buffer3")
    comando.visuali<-paste0(comando.visuali,"+map.buffer3")
  }

  #comparing with focal
  if(is.null(comp)==F){
    comando.visuali<-paste0(comando.visuali,"|",comando.visualiB)

  }
  cat(comando.visuali)


  cat("\nOpening map in new window (eg browser) can improve visualization.\n")

  return(eval(parse(text=comando.visuali),envir=.GlobalEnv))
}