# Author: Babak Naimi, naimi.b@gmail.com
# Date :  July 2016
# Version 1.1
# Licence GPL v3 

setClassUnion('data.frameORmatrix',c("data.frame","matrix"))
setClassUnion('matrixORnull',c("NULL","matrix"))

setClass("Entrogram",
         representation(width="numeric",
                        cutoff="numeric",
                        entrogramCloud='matrixORnull',
                        entrogram="data.frame"
                        ),
         prototype(
           entrogramCloud=NULL
           )
)
#-------

setClass("Variogram",
         representation(width="numeric",
                        cutoff="numeric",
                        variogramCloud="matrix",
                        variogram="data.frame")
)
#-------

setClass("Correlogram",
         representation(width="numeric",
                        cutoff="numeric",
                        correlogram="data.frame")
)
#-------
setClass("neighbours",
         representation(distance1="numeric",
                        distance2="numeric",
                        neighbours='list'
         )
)



# Author: Babak Naimi, naimi.b@gmail.com
# Date :  August 2016
# Last Update: Nov. 2022
# Version 1.3
# Licence GPL v3 
#----------------

if (!isGeneric("moran")) {
  setGeneric("moran", function(x, d1, d2,...)
    standardGeneric("moran"))
}


setMethod('moran', signature(x='RasterLayer'), 
          function(x, d1, d2,verbose=TRUE,...) {
            
            if (missing(d1)) d1 <- 0
            
            if (missing(verbose)) verbose <- TRUE 
            
            if (missing(d2)) {
              d2 <- res(x)[1]
              if (verbose) cat("Moran's I is calculated based on d1=",d1," & d2 =",d2,"(eual to ONE cell)\n")
            }
            w <-.Filter(r=res(x)[1],d1=d1,d2=d2)[[2]]
            
            .Call('moran',x[],as.integer(ncol(x)),as.integer(nrow(x)),as.integer(w[,1]),as.integer(w[,2]), PACKAGE='elsa')
          }
)
#-----

setMethod('moran', signature(x='SpatRaster'), 
          function(x, d1, d2,verbose=TRUE,...) {
            
            if (missing(d1)) d1 <- 0
            
            if (missing(verbose)) verbose <- TRUE 
            
            if (missing(d2)) {
              d2 <- res(x)[1]
              if (verbose) cat("Moran's I is calculated based on d1=",d1," & d2 =",d2,"(eual to ONE cell)\n")
            }
            w <-.Filter(r=res(x)[1],d1=d1,d2=d2)[[2]]
            if (nlyr(x) > 1) {
              out <- c()
              for (i in 1:nlyr(x)) {
                out <- c(out,.Call('moran',x[[i]][][,1],as.integer(ncol(x)),as.integer(nrow(x)),as.integer(w[,1]),as.integer(w[,2]), PACKAGE='elsa'))
              }
              
            } else {
              out <- .Call('moran',x[][,1],as.integer(ncol(x)),as.integer(nrow(x)),as.integer(w[,1]),as.integer(w[,2]), PACKAGE='elsa')
            }
            names(out) <- names(x)
            out
          }
)
#-----
setMethod('moran', signature(x='Spatial'), 
          function(x, d1, d2,zcol,longlat,verbose=TRUE,...) {
            
            if (missing(verbose)) verbose <- TRUE 
            
            if (missing(d1)) d1 <- 0
            if (missing(d2) && !inherits(d1,'neighbours')) stop('d2 should be specified, or alternatively, put an object in d1 created by dneigh')
            if (missing(longlat)) longlat <- NULL
            
            if (!inherits(d1,'neighbours')) d <- dneigh(x, d1, d2,longlat = longlat)@neighbours
            else d <- d1@neighbours
            
            if (missing(zcol)) {
              if (ncol(x@data) > 1) stop("zcol should be specified!")
              else zcol <- 1
            } else if (is.character(zcol)) {
              w <- which(colnames(x@data) == zcol[1])
              if (w == 0) stop('the specified variable in zcol does not exist in the data')
              zcol <- w
            } else if (is.numeric(zcol)) {
              zcol <- zcol[1]
              if (zcol > ncol(x@data)) stop('the zcol number is greater than the number of columns in data!')
            } else stop("zcol should be a character or a number!")
            
            x <- x@data[,zcol]
            
            if (!is.numeric(x) && !is.integer(x)) stop('the variable specified through zcol is not a numeric variable')
            
            .Call('moran_vector',x,d, PACKAGE='elsa')
          }
)
#-----
setMethod('moran', signature(x='SpatVector'), 
          function(x, d1, d2,zcol,longlat,verbose=TRUE,...) {
            
            if (missing(verbose)) verbose <- TRUE 
            
            if (missing(d1)) d1 <- 0
            if (missing(d2) && !inherits(d1,'neighbours')) stop('d2 should be specified, or alternatively, put an object in d1 created by dneigh')
            if (missing(longlat)) longlat <- NULL
            
            if (!inherits(d1,'neighbours')) d <- dneigh(x, d1, d2,longlat = longlat)@neighbours
            else d <- d1@neighbours
            
            if (missing(zcol)) {
              if (ncol(x) > 1) stop("zcol should be specified!")
              else zcol <- 1
            } else if (is.character(zcol)) {
              w <- which(names(x) == zcol[1])
              if (w == 0) stop('the specified variable in zcol does not exist in the data')
              zcol <- w
            } else if (is.numeric(zcol)) {
              zcol <- zcol[1]
              if (zcol > ncol(x)) stop('the zcol number is greater than the number of columns in data!')
            } else stop("zcol should be a character or a number!")
            
            x <- data.frame(x)[,zcol]
            
            if (!is.numeric(x) && !is.integer(x)) stop('the variable specified through zcol is not a numeric variable')
            
            .Call('moran_vector',x,d, PACKAGE='elsa')
          }
)

#---------

if (!isGeneric("geary")) {
  setGeneric("geary", function(x, d1, d2,...)
    standardGeneric("geary"))
}


setMethod('geary', signature(x='RasterLayer'), 
          function(x, d1, d2,verbose=TRUE,...) {
            
            if (missing(verbose)) verbose <- TRUE 
            
            if (missing(d1)) d1 <- 0
            if (missing(d2)) {
              d2 <- res(x)[1]
              if (verbose) cat("Geary's c is calculated based on d1=",d1," & d2 =",d2,"(eual to ONE cell)\n")
            }
            w <-.Filter(r=res(x)[1],d1=d1,d2=d2)[[2]]
            
            .Call('geary',x[],as.integer(ncol(x)),as.integer(nrow(x)),as.integer(w[,1]),as.integer(w[,2]), PACKAGE='elsa')
          }
)
#-----

setMethod('geary', signature(x='SpatRaster'), 
          function(x, d1, d2,verbose=TRUE,...) {
            
            if (missing(verbose)) verbose <- TRUE 
            
            if (missing(d1)) d1 <- 0
            if (missing(d2)) {
              d2 <- res(x)[1]
              if (verbose) cat("Geary's c is calculated based on d1=",d1," & d2 =",d2,"(eual to ONE cell)\n")
            }
            w <-.Filter(r=res(x)[1],d1=d1,d2=d2)[[2]]
            
            if (nlyr(x) > 1) {
              out <- c()
              for (i in 1:nlyr(x)) {
                out <- c(out,.Call('geary',x[[i]][][,1],as.integer(ncol(x)),as.integer(nrow(x)),as.integer(w[,1]),as.integer(w[,2]), PACKAGE='elsa'))
              }
              
            } else {
              out <- .Call('geary',x[][,1],as.integer(ncol(x)),as.integer(nrow(x)),as.integer(w[,1]),as.integer(w[,2]), PACKAGE='elsa')
            }
            names(out) <- names(x)
            out
            
          }
)
#-----
setMethod('geary', signature(x='Spatial'), 
          function(x, d1, d2,zcol,longlat,...) {
            
            if (missing(d1)) d1 <- 0
            if (missing(d2) && !inherits(d1,'neighbours')) stop('d2 should be specified, or alternatively, put an object in d1 created by dneigh')
            if (missing(longlat)) longlat <- NULL
            
            if (!inherits(d1,'neighbours')) d <- dneigh(x, d1, d2,longlat = longlat)@neighbours
            else d <- d1@neighbours
            
            if (missing(zcol)) {
              if (ncol(x@data) > 1) stop("zcol should be specified!")
              else zcol <- 1
            } else if (is.character(zcol)) {
              w <- which(colnames(x@data) == zcol[1])
              if (w == 0) stop('the specified variable in zcol does not exist in the data')
              zcol <- w
            } else if (is.numeric(zcol)) {
              zcol <- zcol[1]
              if (zcol > ncol(x@data)) stop('the specified number in zcol is greater than the number of columns in data!')
            } else stop("zcol should be a character or a number!")
            
            x <- x@data[,zcol,drop=TRUE]
            if (!is.numeric(x) && !is.integer(x)) stop('the variable specified through zcol is not a numeric variable')
            
            .Call('geary_vector',x,d, PACKAGE='elsa')
          }
)
#-----
setMethod('geary', signature(x='SpatVector'), 
          function(x, d1, d2,zcol,longlat,...) {
            
            if (missing(d1)) d1 <- 0
            if (missing(d2) && !inherits(d1,'neighbours')) stop('d2 should be specified, or alternatively, put an object in d1 created by dneigh')
            if (missing(longlat)) longlat <- NULL
            
            if (!inherits(d1,'neighbours')) d <- dneigh(x, d1, d2,longlat = longlat)@neighbours
            else d <- d1@neighbours
            
            if (missing(zcol)) {
              if (ncol(x) > 1) stop("zcol should be specified!")
              else zcol <- 1
            } else if (is.character(zcol)) {
              w <- which(names(x) == zcol[1])
              if (w == 0) stop('the specified variable in zcol does not exist in the data')
              zcol <- w
            } else if (is.numeric(zcol)) {
              zcol <- zcol[1]
              if (zcol > ncol(x)) stop('the specified number in zcol is greater than the number of columns in data!')
            } else stop("zcol should be a character or a number!")
            
            x <- data.frame(x)[,zcol,drop=TRUE]
            if (!is.numeric(x) && !is.integer(x)) stop('the variable specified through zcol is not a numeric variable')
            
            .Call('geary_vector',x,d, PACKAGE='elsa')
          }
)



# Author: Babak Naimi, naimi.b@gmail.com
# Date :  July 2016
# Last Update : March 2023
# Version 1.8
# Licence GPL v3 
#-----------



if (!isGeneric("categorize")) {
  setGeneric("categorize", function(x,nc,probs,...)
    standardGeneric("categorize"))
}	

setMethod('categorize', signature(x='RasterLayer'), 
          function(x,nc,probs,filename='',verbose=TRUE,...)  {
            if (missing(verbose)) verbose <- TRUE
            
            if (missing(nc)) {
              nc <- nclass(x)
              if (verbose) cat(paste("the optimum number of class has been identified as ",nc,"!\n"))
            }
            
            if (missing(probs)) probs <- FALSE
            else if (is.null(probs) || (is.logical(probs) && !probs)) probs <- FALSE
            else {
              if (is.numeric(probs) && length(probs) == 2 && all(probs <= 1) && all(probs >= 0) && probs[2] > probs[1]) {
                probs <- probs
              } else {
                warning('probs is not appropriately specified, e.g. c(0.025,0.975); NULL is considered')
                probs <- FALSE
              }
            }
            #-----
            if (length(nc) == 1) {
              if (nc < 2) stop("nclass should be 2 or greater!")
              r <- cellStats(x,'range')
              if (is.numeric(probs)) {
                # the quantile is used to avoid the effect of outlier on binning!
                .rq <- quantile(x,probs=probs)
                n <- (.rq[2] - .rq[1])/ nc
                nc <- seq(.rq[1],.rq[2],n)
                nc[1] <- r[1]
              } else {
                n <- (r[2] - r[1])/ nc
                nc <- seq(r[1],r[2],n)
              }
              
              nc[1] <- nc[1] - n
              if (nc[length(nc)] < r[2]) nc[length(nc)] <- r[2]
            }
            out <- raster(x)
            #-----
            if (canProcessInMemory(out)) {
              out[] <- .Call('categorize', as.vector(x[]), as.vector(nc), PACKAGE='elsa')
              if (filename != '') out <- writeRaster(out, filename, ...)
            } else {
              out <- writeStart(out, filename,...)
              tr <- blockSize(out, minblocks=3)
              pb <- pbCreate(tr$n, label='categorize',...)
              
              for (i in 1:tr$n) {
                v <- getValues(x, row=tr$row[i], nrows=tr$nrows[i])
                v <- .Call('categorize', v, as.vector(nc), PACKAGE='elsa')
                out <- writeValues(out, v, 1)
                pbStep(pb)
              }
              out <- writeStop(out)      
              pbClose(pb)
            }
            return(out)
          }
)
            

# in the following, we assume the layers in RasterStackBrick are the same variables in different times,
# therefore, the categorization should use the same base (class-number) for all layers (i.e., range of classes are specified based on the rangle of all values/layers together)
setMethod('categorize', signature(x='RasterStackBrick'), 
          function(x,nc,probs,filename='',verbose=TRUE,...)  {
            
            if (missing(verbose)) verbose <- TRUE
            
            if (missing(nc)) {
              nc <- nclass(x)
              if (verbose) cat(paste("the optimum number of class has been identified as ",nc,"!\n"))
            }
            
            
            if (missing(probs)) probs <- FALSE
            else if (is.null(probs) || (is.logical(probs) && !probs)) probs <- FALSE
            else {
              if (is.numeric(probs) && length(probs) == 2 && all(probs <= 1) && all(probs >= 0) && probs[2] > probs[1]) {
                probs <- probs
              } else {
                warning('probs is not appropriately specified, e.g. c(0.025,0.975); NULL is considered')
                probs <- FALSE
              }
            }
            #-----
            if (length(nc) == 1) {
              if (nc < 2) stop("nclass should be 2 or greater!")
              r <- cellStats(x,'range')
              
              if (nlayers(x) > 1) {
                rr <- list()
                for (i in 1:nlayers(x)) {
                  rr[[i]] <- r[,i]
                }
              } else rr <- list(r[,1])
              
              
              if (is.numeric(probs)) {
                # the quantile is used to avoid the effect of outliers on binning!
                .rq <- t(quantile(x,probs=probs))
                ncl <- list()
                for (i in 1:ncol(.rq)) {
                  n <- (.rq[2,i] - .rq[1,i]) / nc
                  ncl[[i]] <- seq(.rq[1,i],.rq[2,i],n)
                  ncl[[i]][1] <- rr[[i]][1] - n
                  ncl[[i]][length(ncl[[i]])] <- rr[[i]][1]
                }
                
              } else {
                ncl <- list()
                for (i in 1:length(rr)) {
                  n <- (rr[[i]][2] - rr[[i]][1]) / nc
                  ncl[[i]] <- seq(rr[[i]][1],rr[[i]][2],n)
                  ncl[[i]][1] <- rr[[i]][1] - n
                }
              }
            }  else {
              if (is.numeric(nc)) {
                ncl <- vector('list',nlayers(x))
                for (i in 1:nlayers(x)) ncl[[i]] <- nc
              } else if (is.list(nc)) {
                if (length(nc) == nlayers(x)) ncl <- nc
                else stop('The provided list in nc has a different length than the number of layers in x!')
              } else stop('nc should be either a single number (number of class) or a numeric vector (list for multiple layers) specifying the categorisation thresholds!')
              
            }
            
            if (nlayers(x) > 1) {
              out <- brick(x,values=FALSE)
              for (i in 1:nlayers(x)) {
                out[[i]][] <- .Call('categorize', as.vector(x[[i]][]), as.vector(ncl[[i]]), PACKAGE='elsa')
              }
            } else {
              out <- raster(x)
              out[] <- .Call('categorize', as.vector(x[]), as.vector(ncl[[1]]), PACKAGE='elsa')
            }
            #-----
            names(out) <- names(x)
            
            if (filename != '') {
              writeRaster(out,filename=filename,...)
            }
            
            return(out)
          }
)


#-----------

setMethod('categorize', signature(x='SpatRaster'), 
          function(x,nc,probs,filename='',verbose=TRUE,...)  {
            
            if (missing(verbose)) verbose <- TRUE
            
            if (missing(nc)) {
              nc <- nclass(x[[1]])
              if (nlyr(x) > 1) {
                if (verbose) cat(paste("the optimum number of class has been identified as ",nc," (ONLY the first layer is considered)!\n"))
              } else {
                if (verbose) cat(paste("the optimum number of class has been identified as ",nc,"!\n"))
              }
            }
            
            
            if (missing(probs)) probs <- FALSE
            else if (is.null(probs) || (is.logical(probs) && !probs)) probs <- FALSE
            else {
              if (is.numeric(probs) && length(probs) == 2 && all(probs <= 1) && all(probs >= 0) && probs[2] > probs[1]) {
                probs <- probs
              } else {
                warning('probs is not appropriately specified, e.g. c(0.025,0.975); NULL is considered')
                probs <- FALSE
              }
            }
            #-----
            if (length(nc) == 1) {
              if (nc < 2) stop("nclass should be 2 or greater!")
              r <- global(x,'range',na.rm=TRUE)
              if (nlyr(x) > 1) {
                rr <- list()
                for (i in 1:nlyr(x)) {
                  rr[[i]] <- t(r)[,i]
                }
              } else rr <- list(t(r)[,1])
              
              #---
              if (is.numeric(probs)) {
                # the quantile is used to avoid the effect of outliers on binning!
                .rq <- t(global(x,fun=quantile,probs=probs,na.rm=TRUE))
                ncl <- list()
                for (i in 1:ncol(.rq)) {
                  n <- (.rq[2,i] - .rq[1,i]) / nc
                  ncl[[i]] <- seq(.rq[1,i],.rq[2,i],n)
                  ncl[[i]][1] <- rr[[i]][1] - n
                  ncl[[i]][length(ncl[[i]])] <- rr[[i]][1]
                }
                
              } else {
                ncl <- list()
                for (i in 1:length(rr)) {
                  n <- (rr[[i]][2] - rr[[i]][1]) / nc
                  ncl[[i]] <- seq(rr[[i]][1],rr[[i]][2],n)
                  ncl[[i]][1] <- rr[[i]][1] - n
                }
              }
              
              # nc[1] <- nc[1] - n
              # if (nc[length(nc)] < r[2]) nc[length(nc)] <- r[2]
            } else {
              if (is.numeric(nc)) {
                ncl <- vector('list',nlyr(x))
                for (i in 1:nlyr(x)) ncl[[i]] <- nc
              } else if (is.list(nc)) {
                if (length(nc) == nlyr(x)) ncl <- nc
                else stop('The provided list in nc has a different length than the number of layers in x!')
              } else stop('nc should be either a single number (number of class) or a numeric vector (list for multiple layers) specifying the categorisation thresholds!')
              
            }
            
            out <- rast(x)
            #-----
            
            for (i in 1:nlyr(x)) {
              out[[i]][] <- .Call('categorize', as.vector(x[[i]][]), as.vector(ncl[[i]]), PACKAGE='elsa')
            }
            names(out) <- names(x)
            
            if (filename != '') writeRaster(out,filename = filename,...)
            
            
            return(out)
          }
)


#-----------
setMethod('categorize', signature(x='numeric'), 
          function(x,nc,probs)  {
            if (missing(nc)) {
              stop("number of classes or a verctor including the break values should be specified...!")
            }
            
            if (missing(probs)) probs <- FALSE
            else if (is.null(probs) || (is.logical(probs) && !probs)) probs <- FALSE
            else {
              if (is.numeric(probs) && length(probs) == 2 && all(probs <= 1) && all(probs >= 0) && probs[2] > probs[1]) {
                probs <- probs
              } else {
                warning('probs is not appropriately specified, e.g. c(0.025,0.975); NULL is considered')
                probs <- FALSE
              }
            }
            #-----
            if (length(nc) == 1) {
              if (nc < 2) stop("nclass should be 2 or greater!")
              r <- range(x,na.rm=TRUE)
              if (is.numeric(probs)) {
                # the quantile is used to avoid the effect of outlier on binning!
                .rq <- quantile(x,probs=probs,na.rm = TRUE)
                n <- (.rq[2] - .rq[1])/ nc
                nc <- seq(.rq[1],.rq[2],n)
                nc[1] <- r[1]
              } else {
                n <- (r[2] - r[1])/ nc
                nc <- seq(r[1],r[2],n)
              }
              
              nc[1] <- nc[1] - n
              if (nc[length(nc)] < r[2]) nc[length(nc)] <- r[2]
            }
            
            .Call('categorize', as.vector(x), as.vector(nc), PACKAGE='elsa')
          }
)



setMethod('categorize', signature(x='list'), 
          function(x,nc,probs)  {
            if (missing(nc)) {
              stop("number of classes or a verctor including the break values should be specified...!")
            }
            
            if (missing(probs)) probs <- FALSE
            else if (is.null(probs) || (is.logical(probs) && !probs)) probs <- FALSE
            else {
              if (is.numeric(probs) && length(probs) == 2 && all(probs <= 1) && all(probs >= 0) && probs[2] > probs[1]) {
                probs <- probs
              } else {
                warning('probs is not appropriately specified, e.g. c(0.025,0.975); NULL is considered')
                probs <- FALSE
              }
            }
            #-----
            
            if (length(nc) == 1) {
              if (nc < 2) stop("nclass should be 2 or greater!")
              r <- lapply(x,range,na.rm=TRUE)
              r <- c(min(sapply(r,function(x) x[1]),na.rm=TRUE),max(sapply(r,function(x) x[2]),na.rm=TRUE))
              if (is.numeric(probs)) {
                # the quantile is used to avoid the effect of outlier on binning!
                .rq <- lapply(x,quantile,probs=probs,na.rm=TRUE)
                .rq <- c(min(sapply(.rq,function(x) x[1]),na.rm=TRUE),max(sapply(.rq,function(x) x[2]),na.rm=TRUE))
                n <- (.rq[2] - .rq[1])/ nc
                nc <- seq(.rq[1],.rq[2],n)
                nc[1] <- r[1]
              } else {
                n <- (r[2] - r[1]) / nc
                nc <- seq(r[1],r[2],n)
              }
              
              nc[1] <- nc[1] - n
              if (nc[length(nc)] < r[2]) nc[length(nc)] <- r[2]
            }
            
            o <- list()
            for (i in 1:length(x)) {
              o[[i]] <- .Call('categorize', as.vector(x[[i]]), as.vector(nc), PACKAGE='elsa')
            }
            o
          }
)


# Author: Babak Naimi, naimi.b@gmail.com
# Date :  August 2016
# Version 1.2
# Licence GPL v3 

if (!isGeneric("correlogram")) {
  setGeneric("correlogram", function(x,width,cutoff,...)
    standardGeneric("correlogram"))
}


setMethod('correlogram', signature(x='RasterLayer'), 
          function(x, width, cutoff, ...) {
            re <- res(x)[1]
            if (missing(cutoff)) cutoff<- sqrt((xmin(x)-xmax(x))^2+(ymin(x)-ymax(x))^2) / 3
            if (missing(width)) width <- re
            else if (width < re) width <- re
            if (cutoff < width) stop("cutoff should be greater than width size")
            nlag <- ceiling(cutoff / width)
            
            n <- ncell(x) - cellStats(x,'countNA')
            #---
            # if (is.null(s)) {
            #   if (!.checkrasterMemory(n,nlag)) {
            #     s <- c()
            #     for (i in (nlag-1):1) s <- c(s,.checkrasterMemory(n,i))
            #     s <- which(s)
            #     if (length(s) > 0) {
            #       s <- (nlag - s[1]) / (2*nlag)
            #       s <- ceiling(n * s)
            #       s <- sampleRandom(x,s,cells=TRUE)[,1]
            #     } else {
            #       s <- 1 / (2 * nlag)
            #       s <- ceiling(n * s)
            #       while (!.checkrasterMemory(s,1)) s <- ceiling(s / 2)
            #       s <- sampleRandom(x,s,cells=TRUE)[,1]
            #     }
            #   } else {
            #     s <- (1:ncell(x))[which(!is.na(x[]))]
            #   }
            # } else {
            #   if (!is.numeric(s)) stop("s argument should be an integer number or NULL!")
            #   while (!.checkrasterMemory(s[1],1)) s <- ceiling(s[1] * 0.8)
            #   if (s > n) s <- n
            #   s <- sampleRandom(x,s,cells=TRUE)[,1]
            # }
            
            #######---------------------
            out <- new("Correlogram")
            out@width <- width
            out@cutoff <- cutoff
            d <- seq(width,width*nlag,width) - (width/2)
            out@correlogram <- data.frame(distance=d,moran=rep(NA,length(d)))
            for (i in 1:nlag) {
              d1 <- (i -1) * width
              d2 <- d1 + width
              w <-.Filter(r=res(x)[1],d1=d1,d2=d2)[[2]]
              w <- .Call('moran',as.vector(x[]),as.integer(ncol(x)),as.integer(nrow(x)),as.integer(w[,1]),as.integer(w[,2]), PACKAGE='elsa')
              w <- w[!is.infinite(w)]
              w <- w[!is.na(w)]
              out@correlogram [i,2] <- mean(w)
            }
            out
          }
)
##########

setMethod('correlogram', signature(x='Spatial'), 
          function(x, width, cutoff, zcol, longlat,s=NULL,...) {
            if (!class(x) %in% c('SpatialPolygonsDataFrame','SpatialPointsDataFrame')) stop('x can only be either of RasterLayer, SpatialPointsDataFrame, SpatialPolygonsDataFrame')
            
            n <- nrow(x)
            
            if (missing(longlat)) longlat <- NULL
            
            if (missing(cutoff)) cutoff<- sqrt((xmin(x)-xmax(x))^2+(ymin(x)-ymax(x))^2) / 3
            if (missing(width)) width <- cutoff / 15
            
            if (cutoff < width) stop("cutoff should be greater than width size")
            
            nlag <- ceiling(cutoff / width)
            
            if (missing(zcol)) {
              if (ncol(x@data) > 1) stop("zcol should be specified!")
              else zcol <- 1
            } else if (is.character(zcol)) {
              w <- which(colnames(x@data) == zcol[1])
              if (w == 0) stop('the specified variable in zcol does not exist in the data')
              zcol <- w
            } else if (is.numeric(zcol)) {
              zcol <- zcol[1]
              if (zcol > ncol(x@data)) stop('the zcol number is greater than the number of columns in data!')
            } else stop("zcol should be a character or a number!")
            
            xy <- coordinates(x)
            x <- x@data[,zcol]
            #---
            if (!is.null(s) && is.numeric(s) && s < n) {
              s <- sample(n,s)
              x <- x[s]
              n <- length(x)
              xy <- xy[s,]
            }
            #######---------------
            out <- new("Correlogram")
            out@width <- width
            out@cutoff <- cutoff
            d <- seq(width,width*nlag,width) - (width/2)
            out@correlogram <- data.frame(distance=d,moran=rep(NA,length(d)))
            for (i in 1:nlag) {
              d1 <- (i -1) * width
              d2 <- d1 + width
              d <- dneigh(xy,d1=d1, d2=d2,longlat = longlat)@neighbours
              w <- .Call('moran_vector', x, d, PACKAGE='elsa')
              w <- w[!is.infinite(w)]
              w <- w[!is.na(w)]
              out@correlogram [i,2] <- mean(w)
            }
            out
          }
)



# Author: Babak Naimi, naimi.b@gmail.com
# Date :  August 2014
# Last Update :  April 2019
# Version 1.1
# Licence GPL v3 

if (!isGeneric("dif2list")) {
  setGeneric("dif2list", function(x, pattern, fact=1)
    standardGeneric("dif2list"))
}



setMethod('dif2list', signature(x='data.frameORmatrix'), 
          function(x, pattern, fact=1) {
            
            x <- x[,1:2]
            
            if (missing(fact)) fact <- 1
            
            .f <- function(code,d) {
              d <- t(apply(d,1,function(x) {abs(x - code)}))
              nc <- ncol(d)
              ss <- rep(0,nrow(d))
              for (i in 1:nrow(d)) {
                j <- 1
                while (j <= nc) {
                  if (d[i,j] != 0) {
                    ss[i] <-(nc - j + 1)
                    j <- nc + 1
                  } else j <- j + 1
                }
              }
              ss
            }
            
            if (missing(pattern)) {
              u <- unlist(strsplit(as.character(x[1,2]),''))
              pattern <- rep(1,length(u))
            }
            
            p <- list()
            o <- 1
            for (j in 1:length(pattern)) {
              p[[j]] <- c(o:(o+pattern[j]-1))
              o <- (j+pattern[j])
            }
            
            s <- sapply(x[,2],function(x) {strsplit(as.character(x),'')})
            if (!all(sapply(s,function(x) {length(x) == sum(pattern)}))) stop("the provided codes does not match the pattern or have inconsistency!")
            
            d <- data.frame(matrix(nrow=length(s),ncol=length(pattern)))
            for (i in 1:length(s)) {
              for (j in 1:length(pattern)) {
                d[i,j] <- as.numeric(paste(s[[i]][p[[j]]],collapse=''))
              }
            }
            gc <- x[,1]
            dT <- list()
            for (i in 1:length(gc)) {
              n <- .f(as.numeric(d[i,]),d) * fact
              names(n) <- gc
              dT[[as.character(gc[i])]] <- n
            }
            dT
          }
)


# Author: Babak Naimi, naimi.b@gmail.com
# Date :  July 2016
# Last Update :  Nov. 2022
# Version 1.4
# Licence GPL v3 

# based on the functions poly2nb and dnearneigh in spdep package (Roger Bivand):

.qintersect <- function (x, y) {
  as.integer(y[match(x, y, 0L)])
}


.findInbox <- function (i, sp, bigger = TRUE) {
  n <- dim(sp$bb)[1]
  tmp <- vector(mode = "list", length = 4)
  tmp[[1]] <- sp$rbxv[sp$mbxv[i]:(n * 2)]
  tmp[[1]] <- tmp[[1]][which(tmp[[1]] > n)] - n
  tmp[[2]] <- sp$rbyv[sp$mbyv[i]:(n * 2)]
  tmp[[2]] <- tmp[[2]][which(tmp[[2]] > n)] - n
  tmp[[3]] <- sp$rbxv[1:sp$mbxv[i + n]]
  tmp[[3]] <- tmp[[3]][which(tmp[[3]] <= n)]
  tmp[[4]] <- sp$rbyv[1:sp$mbyv[i + n]]
  tmp[[4]] <- tmp[[4]][which(tmp[[4]] <= n)]
  lentmp <- order(sapply(tmp, length))
  result <- .qintersect(tmp[[lentmp[2]]], tmp[[lentmp[1]]])
  result <- .qintersect(tmp[[lentmp[3]]], result)
  result <- .qintersect(tmp[[lentmp[4]]], result)
  if (bigger) {
    result <- result[which(result > i)]
  }
  return(sort(result))
}

.dnn.poly <- function(x,d,queen=TRUE) {
  n <- length(x)
  if (n < 1) stop("non-positive number of entities")
  regid <- row.names(x)
  if (is.null(regid)) regid <- as.character(1:n)
  
  xpl <- x@ptr$polygonsList()
  xxpl <- vector(mode = "list", length = length(xpl))
  
  for (i in 1:length(xpl)) {
    xxpl[[i]] <- data.frame(xpl[[i]])
    names(xxpl[[i]]) <- c('x','y')
  }
  nrs <- sapply(xxpl, nrow)
  vbsnap <- c(-d, d)
  dsnap <- as.double(d)
  bb <- t(sapply(xxpl, function(x) {
    rx <- range(x[, 1]) + vbsnap
    ry <- range(x[, 2]) + vbsnap
    c(rbind(rx, ry))
  }))
  genBBIndex <- function(bb) {
    n <- nrow(bb)
    bxv <- as.vector(bb[, c(1, 3)])
    byv <- as.vector(bb[, c(2, 4)])
    obxv <- order(bxv)
    rbxv <- c(1:(n * 2))[obxv]
    mbxv <- match(1:(n * 2), obxv)
    obyv <- order(byv)
    rbyv <- c(1:(n * 2))[obyv]
    mbyv <- match(1:(n * 2), obyv)
    return(list(bb = bb, bxv = bxv, byv = byv, obxv = obxv,obyv = obyv, mbxv = mbxv, mbyv = mbyv, rbyv = rbyv, rbxv = rbxv))
  }
  BBindex <- genBBIndex(bb)
  foundInBox <- lapply(1:(n - 1), function(i) .findInbox(i, BBindex))
  nfIBB <- sum(sapply(foundInBox, length))
  criterion <- ifelse(queen, 0, 1)
  ans <- .Call("poly_loop2", as.integer(n), foundInBox, bb, xxpl, as.integer(nrs), as.double(dsnap), as.integer(criterion), as.integer(nfIBB), PACKAGE = "elsa")
  ans
}
#------
.dnn.xy <- function(x,d1,d2,longlat) {
  .Call("dnn", x[,1], x[,2], d1, d2, as.integer(longlat), PACKAGE = "elsa")
}

.distance.xy <- function(x,d1,d2,longlat) {
  .Call("dist", x[,1], x[,2], d1, d2, as.integer(longlat), PACKAGE = "elsa")
}

######################################



if (!isGeneric("dneigh")) {
  setGeneric("dneigh", function(x, d1, d2, longlat,method,...)
    standardGeneric("dneigh"))
}



setMethod('dneigh', signature(x='SpatialPoints'), 
          function(x, d1, d2, longlat,...) {
            if (missing(longlat) || is.null(longlat) || !is.logical(longlat)) longlat <- .is.projected(x)
            
            if (missing(d1) || is.null(d1) || !is.numeric(d1)) d1 <- 0
            
            if (missing(d2)) stop('d2 should be provided')
            
            if (d2 <= d1) stop('d2 should be greater than d1')
            
            x <- coordinates(x)
            if (nrow(x) < 1) stop("no records in x")
            if (ncol(x) > 2) stop("Only 2D data accepted")
            z <- .dnn.xy(x,d1,d2,longlat)
            if (all(sapply(z,is.null))) stop('There is no links within the specified distance!')
            z <- new('neighbours',distance1=d1,distance2=d2,neighbours=z)
            return(z)
          }
)



setMethod('dneigh', signature(x='SpatialPolygons'), 
          function(x, d1, d2, longlat,method,...) {
            if (missing(longlat) || is.null(longlat) || !is.logical(longlat)) longlat <- .is.projected(x)
            
            if (missing(d1) || is.null(d1) || !is.numeric(d1)) d1 <- 0
            
            if (missing(d2)) stop('d2 should be provided')
            
            if (d2 <= d1) stop('d2 should be greater than d1')
            
            if (missing(method) || is.null(method)) method <- 'centroid'
            else {
              if (tolower(method)[1] %in% c('bnd','bound','boundary','bond','b')) method <- 'bound'
              else if (tolower(method)[1] %in% c('center','centre','cent','cnt','c','centroid','centriod','ce','cen')) method <- 'centroid'
              else {
                warning('method is not recognized; the default (centroid) is used!')
                method <- 'centroid'
              }
            }
            
            if (method == 'bound') {
              dot <- list(...)
              if ('queen' %in% names(dot) && is.logical(dot[['queen']])) queen <- dot[['queen']]
              else queen <- TRUE
              if (d1 > 0) warning('with method="bound", d1 should be 0. So, it is changed to 0!')
              d1 <- 0
              z <- .dnn.poly(x,d=d2,queen=queen)
              attributes(z) <- NULL
            } else {
              x <- coordinates(x)
              if (nrow(x) < 1) stop("no records in x")
              z <- .dnn.xy(x,d1,d2,longlat)
            }
            if (all(sapply(z,is.null))) stop('There is no links within the specified distance!')
            z <- new('neighbours',distance1=d1,distance2=d2,neighbours=z)
            return(z)
          }
)
#---------

setMethod('dneigh', signature(x='SpatVector'), 
          function(x, d1, d2, longlat,method,...) {
            if (missing(longlat) || is.null(longlat) || !is.logical(longlat)) longlat <- .is.projected(x)
            
            if (missing(d1) || is.null(d1) || !is.numeric(d1)) d1 <- 0
            
            if (missing(d2)) stop('d2 should be provided')
            
            if (d2 <= d1) stop('d2 should be greater than d1')
            
            .type <- x@ptr$type()
            
            if (!.type %in% c('points','polygons')) stop('SpatVector can be either of points or polygons')
            
            
            if (.type == "polygons") {
              if (missing(method) || is.null(method)) method <- 'centroid'
              else {
                if (tolower(method)[1] %in% c('bnd','bound','boundary','bond','b')) method <- 'bound'
                else if (tolower(method)[1] %in% c('center','centre','cent','cnt','c','centroid','centriod','ce','cen')) method <- 'centroid'
                else {
                  warning('method is not recognized; the default (centroid) is used!')
                  method <- 'centroid'
                }
              }
              
              if (method == 'bound') {
                dot <- list(...)
                if ('queen' %in% names(dot) && is.logical(dot[['queen']])) queen <- dot[['queen']]
                else queen <- TRUE
                if (d1 > 0) warning('with method="bound", d1 should be 0. So, it is changed to 0!')
                d1 <- 0
                z <- .dnn.poly(x,d=d2,queen=queen)
                attributes(z) <- NULL
              } else {
                x <- geom(centroids(x,TRUE))
                if (nrow(x) < 1) stop("no records in x")
                z <- .dnn.xy(x,d1,d2,longlat)
              }
              if (all(sapply(z,is.null))) stop('There is no links within the specified distance!')
              z <- new('neighbours',distance1=d1,distance2=d2,neighbours=z)
            } else {
              
              x <- geom(x)[,c('x','y')]
              if (nrow(x) < 1) stop("no records in x")
              #if (ncol(x) > 2) stop("Only 2D data accepted")
              z <- .dnn.xy(x,d1,d2,longlat)
              if (all(sapply(z,is.null))) stop('There is no links within the specified distance!')
              z <- new('neighbours',distance1=d1,distance2=d2,neighbours=z)
            }
            
            
            return(z)
          }
)
#-------

setMethod('dneigh', signature(x='data.frameORmatrix'), 
          function(x, d1, d2, longlat,...) {
            if (nrow(x) < 1) stop("no records in x")
            if (missing(longlat) || is.null(longlat) || !is.logical(longlat)) longlat <- .is.projected(x)
            if (missing(d1) || is.null(d1) || !is.numeric(d1)) d1 <- 0
            
            if (missing(d2)) stop('d2 should be provided')
            
            if (d2 <= d1) stop('d2 should be greater than d1')
            z <- .dnn.xy(as.matrix(x),d1,d2,longlat)
            
            if (all(sapply(z,is.null))) stop('There is no links within the specified distance!')
            z <- new('neighbours',distance1=d1,distance2=d2,neighbours=z)
            return(z)
          }
)
###########################

if (!isGeneric("neighd")) {
  setGeneric("neighd", function(x, d1, d2, longlat,...)
    standardGeneric("neighd"))
}



setMethod('neighd', signature(x='SpatialPoints'), 
          function(x, d1, d2, longlat,...) {
            if (missing(longlat) || is.null(longlat) || !is.logical(longlat)) longlat <- .is.projected(x)
            
            if (missing(d1) || is.null(d1) || !is.numeric(d1)) d1 <- 0
            
            if (missing(d2)) stop('d2 should be provided')
            
            if (d2 <= d1) stop('d2 should be greater than d1')
            
            x <- coordinates(x)
            if (nrow(x) < 1) stop("no records in x")
            if (ncol(x) > 2) stop("Only 2D data accepted")
            z <- .distance.xy(x,d1,d2,longlat)
            if (all(sapply(z,is.null))) stop('There is no links within the specified distance!')
            return(z)
          }
)


setMethod('neighd', signature(x='data.frameORmatrix'), 
          function(x, d1, d2, longlat,...) {
            if (nrow(x) < 1) stop("no records in x")
            if (missing(longlat) || is.null(longlat) || !is.logical(longlat)) longlat <- .is.projected(x)
            if (missing(d1) || is.null(d1) || !is.numeric(d1)) d1 <- 0
            
            if (missing(d2)) stop('d2 should be provided')
            
            if (d2 <= d1) stop('d2 should be greater than d1')
            z <- .distance.xy(as.matrix(x),d1,d2,longlat)
            if (all(sapply(z,is.null))) stop('There is no links within the specified distance!')
            return(z)
          }
)




setMethod('neighd', signature(x='SpatialPolygons'), 
          function(x, d1, d2, longlat,...) {
            if (missing(longlat) || is.null(longlat) || !is.logical(longlat)) longlat <- .is.projected(x)
            
            if (missing(d1) || is.null(d1) || !is.numeric(d1)) d1 <- 0
            
            if (missing(d2)) stop('d2 should be provided')
            
            if (d2 <= d1) stop('d2 should be greater than d1')
            
            x <- coordinates(x)
            
            if (nrow(x) < 1) stop("no records in x")
            
            z <- .distance.xy(x,d1,d2,longlat)
            
            if (all(sapply(z,is.null))) stop('There is no links within the specified distance!')
            return(z)
          }
)
#-----

setMethod('neighd', signature(x='SpatVector'), 
          function(x, d1, d2, longlat,...) {
            if (missing(longlat) || is.null(longlat) || !is.logical(longlat)) longlat <- .is.projected(x)
            
            if (missing(d1) || is.null(d1) || !is.numeric(d1)) d1 <- 0
            
            if (missing(d2)) stop('d2 should be provided')
            
            if (d2 <= d1) stop('d2 should be greater than d1')
            
            x <- geom(centroids(x))[,c('x','y')]
            
            if (nrow(x) < 1) stop("no records in x")
            
            z <- .distance.xy(x,d1,d2,longlat)
            
            if (all(sapply(z,is.null))) stop('There is no links within the specified distance!')
            return(z)
          }
)

# Author: Babak Naimi, naimi.b@gmail.com
# Date :  August 2016
# last update: December 2023
# Version 3.6
# Licence GPL v3 


.Filter<-function(r,d1=0,d2) {
  c<- d2%/%r
  x<- y<- seq(-c,c,1)
  eg<- expand.grid(x,y)
  eg[1]<- -eg[1]
  eg[3]<- sqrt(eg[1]^2+eg[2]^2)
  ndim<- c*2+1
  m<-matrix(eg[,3],ncol=ndim,nrow=ndim)*r
  mw<- which(m > d1 & m <= d2)
  m[mw] = 1 
  m[-mw] = NA
  mw <- trunc(length(m)/2)+1
  m[mw]<- 1
  
  w <- ncol(m)
  mr <- matrix(ncol=w,nrow=w) 
  tr <- trunc(w/2)
  
  for (i in 1:w) {
    mr[i,] <-tr 
    tr <- tr - 1
  }
  
  rc = cbind(r=as.vector(m * mr),c=as.vector(m * t(mr)))
  rc=rc[apply(rc,1,function(x) (all(!is.na(x)))),]
  
  return (list(w,rc))
}

#----------
.is.categorical <- function(x) {
  (length(unique(x - round(x))) == 1) && length(unique(x)) < 50
}
#----------
.is.categoricalRaster <- function(x) {
  if (ncell(x) > 1.3e6) {
    x <- sampleRandom(x,1e6)
  }
  (length(unique(x - round(x))) == 1) && length(unique(x)) < 50
}
#----------
.is.categoricalNumeric <- function(x) {
  x <- x[!is.na(x)]
  if (length(x) > 1e6) {
    x <- x[sample(length(x),1e6)]
  }
  (length(unique(x - round(x))) == 1) && length(unique(x)) < 50
}
#----------
.is.categoricalSpatRaster <- function(x) {
  if (nlyr(x) > 1) {
    x <- x[[1]]
  }
  if (ncell(x) > 1.3e6) {
    x <- spatSample(x,1e6,na.rm=TRUE)[,1]
  }
  (length(unique(x - round(x))[,1]) == 1) && length(unique(x)[,1]) < 50
}


.checkDif <- function(dif,classes) {
  classes <- classes[!is.na(classes)]
  nc <- length(classes)
  classes <- as.character(classes)
  if(is.list(dif)) {
    if(!is.null(names(dif))) {
      if (!all(classes %in% names(dif))) stop("categories in the dif argument do not match with the categories in the input layer!")
      dif <- dif[classes]
    } else {
      if (length(dif) == nc) names(dif) <- classes
      else stop("dif content does not match with the categories in the input layer!")
    }
    
    if (!all(unlist(lapply(classes,function(x) {all(classes %in% names(dif[[x]]))})))) stop("Each item in the dif list should be a named vector with all the classes to which the dissimilarities are specified. It seems that something is wrong with the structure (either some classes are missed in the items, or the vectors are not named appropriately)!")
    
    for (i in 1:length(dif)) dif[[i]] <- dif[[i]][classes]
    
    #if (!all(unlist(lapply(classes,function(x) {length(dif[[x]]) == nc})))) stop("the length of categories' differences in the dif argument does not match with the number of categories!")
    dif <- as.vector(as.matrix(as.data.frame(dif)))
  } else if (is.matrix(dif) || is.data.frame(dif)) {
    #if (ncol(dif) != nrow(dif) || ncol != nc) stop("number of rows and columns in dif should be the same, equal to the number of categories!")
    if (ncol(dif) != nrow(dif)) stop("number of rows and columns in dif should be the same!")
    if (colnames(dif) %in% row.names(dif)) stop("names of columns and rows should be the same, corresponding to classes!")
    if (!all(classes %in% colnames(dif))) stop("Some classes do not exist in dif data.frame/matrix!")
    dif <- dif[classes,classes]
    dif <- as.vector(as.matrix(as.data.frame(dif)))
    
  } else if (is.vector(dif)) {
    if (length(dif) != nc*nc) stop("dif argument does not have an appropriate structure!")
  } else stop("dif argument does not have an appropriate structure!")
  return(dif)
}
########################################
########################################
########################################
if (!isGeneric("elsa")) {
  setGeneric("elsa", function(x,d,nc,categorical,dif,classes,stat,...)
    standardGeneric("elsa"))
}


setMethod('elsa', signature(x='RasterLayer'), 
          function(x,d,nc,categorical,dif,classes,stat,cells,filename,verbose=TRUE,...) {
            if (missing(classes)) classes <- NULL
            
            if (missing(verbose)) verbose <- TRUE
            
            if (missing(stat) || is.null(stat)) stat <- 'elsa'
            else {
              stat <- tolower(stat)
              if (length(stat) == 1) {
                if (!stat %in% c('elsa','ec','ea')) {
                  stat <- 'elsa'
                  warning('stat should be either of "ELSA", "Ec", "Ea"; the default "ELSA" is considered!')
                }
              } else {
                if (!all(tolower(stat) %in% c('elsa','ec','ea'))) stop('stat should be selected from "ELSA", "Ea", "Ec"')
              }
            }
            #----
            if (missing(d)) d <- res(x)[1] * sqrt(2)
            
            if (missing(filename)) filename <- ''
            
            if (!missing(nc) && !is.null(nc)) {
              if (missing(categorical)) {
                if (missing(dif) && is.null(classes)) categorical <- FALSE
                else {
                  if (!missing(dif) && !is.null(dif) && !is.null(classes) && .is.categoricalRaster(x)) categorical <- TRUE
                  else {
                    if (verbose) cat("the input data seems continues (if not, use categorical=TRUE)!.... dif/classes is ignored!\n")
                  } 
                }
              } 
            } else {
              if (missing(categorical) && !missing(dif) && !is.null(dif) && !is.null(classes)) categorical <- TRUE
            }
            #----
            if (missing(categorical) || !is.logical(categorical)) {
              # guessing whether the layer is categorical:
              if (.is.categoricalRaster(x)) {
                categorical <- TRUE
                if (verbose) cat("the input is considered as a categorical variable...\n")
              } else {
                categorical <- FALSE
                if (verbose) cat("the input is considered as a continuous variable...\n")
              }
            }
            #----
            if (!categorical && missing(nc)) {
              nc <- nclass(x)
            } else if (categorical) {
              if (is.null(classes)) {
                if (missing(dif) || is.null(classes) ) {
                  classes <- unique(x)
                } else {
                  if (length(names(dif)) > 1) {
                    classes <- names(dif)
                    .ux <- as.character(unique(x))
                    if (!all(.ux %in% classes)) classes <- .ux
                  } else classes <- unique(x)
                }
              } else {
                .ux <- unique(x)
                if (is.character(classes)) .ux <- as.character(.ux)
                if (!all(.ux %in% classes)) stop('the specified "classes" does not cover all or some of values in the input raster!')
              }
              nc <- length(classes)
            }
            #-----
            
            if (categorical) {
              if (missing(dif)) {
                dif <- rep(1,nc*nc)
                for (i in 1:nc) dif[(i-1)*nc+i] <-0
              } else {
                dif <- .checkDif(dif,classes)
              }
            }
            #-----
            w <-.Filter(r=res(x)[1],d1=0,d2=d)
            fdim <- w[[1]]
            w <- w[[2]]
            
            if (fdim < 3) stop("d must be at least equal to the input raster resolution!")
            
            if (!categorical) x <- categorize(x,nc)
            
            out <- raster(x)
            ncl <- ncol(out)
            nrw <- nrow(out)
            filename=trim(filename)
            
            if (canProcessInMemory(out)) {
              if (categorical) {
                if (missing(cells)) {
                  if (length(stat) == 1 && stat == 'elsa') {
                    out[] <- .Call('v_elsac', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                    names(out) <- 'ELSA'
                  } else {
                  xx <- .Call('elsac', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                  if (length(stat) > 1) {
                    nnn <- c()
                    if ('ea' %in% stat) {
                      outx <- raster(out)
                      outx[] <- xx[[2]]
                      out <- addLayer(out,outx)
                      nnn <- c(nnn,'Ea')
                    }
                    if ('ec' %in% stat) {
                      outx <- raster(out)
                      outx[] <- xx[[1]]
                      out <- addLayer(out,outx)
                      nnn <- c(nnn,'Ec')
                    }
                    if ('elsa' %in% stat) {
                      outx <- raster(out)
                      outx[] <- xx[[2]] * xx[[1]]
                      out <- addLayer(out,outx)
                      nnn <- c(nnn,'ELSA')
                    }
                    names(out) <- nnn
                    
                  } else {
                    if (stat == 'ea') {
                      out[] <- xx[[2]]
                      names(out) <- 'Ea'
                    } else {
                      out[] <- xx[[1]]
                      names(out) <- 'Ec'
                    }
                   }
                  }
                  if (filename != '') out <- writeRaster(out, filename, ...)
                } else {
                  if (length(stat) == 1) {
                    if (stat == 'elsa') out <- .Call('v_elsac_cell', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                    else if (stat == 'ec') out <- .Call('v_elsac_cell_Ec', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                    else if (stat == 'ea') out <- .Call('v_elsac_cell_Ea', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                  } else {
                    xx <- .Call('elsac_cell', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                    out <- list()
                    if ('ea' %in% stat) {
                      out[['Ea']] <- xx[[2]]
                    }
                    if ('ec' %in% stat) {
                      out[['Ec']] <- xx[[1]]
                    }
                    if ('elsa' %in% stat) {
                      out[['ELSA']] <-  xx[[2]] * xx[[1]]
                    }
                  }
                }
              } else {
                if (missing(cells)) {
                  
                  if (length(stat) == 1 && stat == 'elsa') {
                    out[] <- .Call('v_elsa', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                    names(out) <- 'ELSA'
                  } else {
                    xx <- .Call('elsa', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                    if (length(stat) > 1) {
                      nnn <- c()
                      if ('ea' %in% stat) {
                        outx <- raster(out)
                        outx[] <- xx[[2]]
                        out <- addLayer(out,outx)
                        nnn <- c(nnn,'Ea')
                      }
                      if ('ec' %in% stat) {
                        outx <- raster(out)
                        outx[] <- xx[[1]]
                        out <- addLayer(out,outx)
                        nnn <- c(nnn,'Ec')
                      }
                      if ('elsa' %in% stat) {
                        outx <- raster(out)
                        outx[] <- xx[[2]] * xx[[1]]
                        out <- addLayer(out,outx)
                        nnn <- c(nnn,'ELSA')
                      }
                      names(out) <- nnn
                      
                    } else {
                      if (stat == 'ea') {
                        out[] <- xx[[2]]
                        names(out) <- 'Ea'
                      } else {
                        out[] <- xx[[1]]
                        names(out) <- 'Ec'
                      }
                    }
                  }
                  if (filename != '') out <- writeRaster(out, filename, ...)
                  
                } else {
                  if (length(stat) == 1) {
                    if (stat == 'elsa') out <- .Call('v_elsa_cell', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells), PACKAGE='elsa')
                    else if (stat == 'ec') out <- .Call('v_elsa_cell_Ec', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells), PACKAGE='elsa')
                    else if (stat == 'ea') out <- .Call('v_elsa_cell_Ea', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells), PACKAGE='elsa')
                  } else {
                    xx <- .Call('elsa_cell', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells), PACKAGE='elsa')
                    out <- list()
                    if ('ea' %in% stat) {
                      out[['Ea']] <- xx[[2]]
                    }
                    if ('ec' %in% stat) {
                      out[['Ec']] <- xx[[1]]
                    }
                    if ('elsa' %in% stat) {
                      out[['ELSA']] <-  xx[[2]] * xx[[1]]
                    }
                  }
                }
              }
            } else {
              if (verbose) cat("\nThe input dataset is considered as a big raster dataset that will be handled out of memory (on the disk), but if you have enough memory on your machine, you can change the settings for maxmemory, and chuncksize, in the rasterOptions function, then the process may be handled in memory that would be much faster...")
              
              tr <- blockSize(out, minblocks=3, minrows=fdim)
              pb <- pbCreate(tr$n, label='ELSA',...)
              addr <- floor(fdim / 2)
              
              if (length(stat) > 1) warning(paste('for big rasters, stat can only have one value, so stat = "',toupper(stat[1]),'", is considered!\n',sep=''))
              stat <- stat[1]
              
              if (missing(cells)) {
                out <- writeStart(out, filename)
                v <- getValues(x, row=1, nrows=tr$nrows[1]+addr)
                if (!categorical) {
                  v <- .Call('elsa', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                } else {
                  v <- .Call('elsac', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                }
                
                if (stat == 'elsa') v <- v[[1]] * v[[2]]
                else if (stat == 'ea') v <- v[[2]]
                else v <- v[[1]]
                
                ex <- length(v) - (addr * ncl)
                out <- writeValues(out, v[1:ex], 1)
                
                for (i in 2:(tr$n-1)) {
                  v <- getValues(x, row=tr$row[i]-addr, nrows=tr$nrows[i]+(2*addr))
                  if (!categorical) {
                    v <- .Call('elsa', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                  } else {
                    v <- .Call('elsac', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                  }
                  
                  if (stat == 'elsa') v <- v[[1]] * v[[2]]
                  else if (stat == 'ea') v <- v[[2]]
                  else v <- v[[1]]
                  
                  st <- (addr * ncl)+1
                  ex <- length(v) - (addr * ncl)
                  out <- writeValues(out, v[st:ex], tr$row[i])
                  pbStep(pb)
                }
                
                i <- tr$n
                v <- getValues(x, row=tr$row[i]-addr, nrows=tr$nrows[i]+addr)
                if (!categorical) {
                  v <- .Call('elsa', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                } else {
                  v <- .Call('elsac', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                }
                
                if (stat == 'elsa') v <- v[[1]] * v[[2]]
                else if (stat == 'ea') v <- v[[2]]
                else v <- v[[1]]
                
                st <- (addr * ncl)+1
                ex <- length(v)
                out <- writeValues(out, v[st:ex], tr$row[i])
                pbStep(pb)
                out <- writeStop(out)      
                pbClose(pb)  
              } else {
                v <- getValues(x, row=1, nrows=tr$nrows[1]+addr)
                cls <- cells[which(cells <= (tr$nrows[1]) * ncl)]
                if (length(cls) > 0) {
                  if (!categorical) {
                    v <- .Call('elsa_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), as.integer(cls), PACKAGE='elsa')
                  } else {
                    v <- .Call('elsac_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cls), PACKAGE='elsa')
                  }
                  
                  if (length(stat) > 1) {
                    out <- list()
                    if ('ea' %in% stat) {
                      out[['Ea']] <- c(out[['L']],v[[2]])
                    }
                    if ('ec' %in% stat) {
                      out[['Ec']] <- c(out[['R']],v[[1]])
                    }
                    if ('elsa' %in% stat) {
                      out[['ELSA']] <-  c(out[['ELSA']],v[[2]] * v[[1]])
                    }
                  } else {
                    out <- c()
                    if (stat == 'ea') {
                      out <- c(out, v[[2]])
                    } else if (stat == 'ec') {
                      out <- c(out, v[[1]])
                    } else out <- c(out, v[[1]]*v[[2]])
                  }
                }
                
                for (i in 2:(tr$n-1)) {
                  cls <- cells[which(cells > ((tr$nrow[i] - 1) * ncl) & cells <= ((tr$nrows[i]+ tr$nrows[i] - 1) * ncl))]
                  if (length(cls) > 0) {
                    cls <- cls - ((tr$row[i]-addr-1)*ncl)
                    v <- getValues(x, row=tr$row[i]-addr, nrows=tr$nrows[i]+(2*addr))
                    if (!categorical) {
                      v <- .Call('elsa_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), as.integer(cls), PACKAGE='elsa')
                    } else {
                      v <- .Call('elsac_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cls), PACKAGE='elsa')
                    }
                    if (length(stat) > 1) {
                      if ('ea' %in% stat) {
                        out[['Ea']] <- c(out[['L']],v[[2]])
                      }
                      if ('ec' %in% stat) {
                        out[['Ec']] <- c(out[['R']],v[[1]])
                      }
                      if ('elsa' %in% stat) {
                        out[['ELSA']] <-  c(out[['ELSA']],v[[2]] * v[[1]])
                      }
                    } else {
                      if (stat == 'ea') {
                        out <- c(out, v[[2]])
                      } else if (stat == 'ec') {
                        out <- c(out, v[[1]])
                      } else out <- c(out, v[[1]]*v[[2]])
                    }
                    pbStep(pb)
                  }
                }
                
                i <- tr$n
                cls <- cells[which(cells > ((tr$nrow[i] - 1) * ncl) & cells <= ((tr$nrows[i]+ tr$nrows[i] - 1) * ncl))]
                cls <- cls - ((tr$row[i]-addr-1)*ncl)
                if (length(cls) > 0) {
                  v <- getValues(x, row=tr$row[i]-addr, nrows=tr$nrows[i]+addr)
                  if (!categorical) {
                    v <- .Call('v_elsa_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), as.integer(cls), PACKAGE='elsa')
                  } else {
                    v <- .Call('v_elsac_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cls), PACKAGE='elsa')
                  }
                  if (length(stat) > 1) {
                    if ('ea' %in% stat) {
                      out[['Ea']] <- c(out[['Ea']],v[[2]])
                    }
                    if ('ec' %in% stat) {
                      out[['Ec']] <- c(out[['Ec']],v[[1]])
                    }
                    if ('elsa' %in% stat) {
                      out[['ELSA']] <-  c(out[['ELSA']],v[[2]] * v[[1]])
                    }
                  } else {
                    if (stat == 'ea') {
                      out <- c(out, v[[2]])
                    } else if (stat == 'ec') {
                      out <- c(out, v[[1]])
                    } else out <- c(out, v[[1]]*v[[2]])
                  }
                  pbStep(pb)
                  pbClose(pb)  
                }
              }
            }
            return(out)
          }
)  

#---------------

setMethod('elsa', signature(x='SpatialPointsDataFrame'), 
          function(x,d,nc,categorical,dif,classes,stat,zcol,drop,verbose=TRUE,...) {
            if (missing(classes)) classes <- NULL
            
            if (missing(verbose)) verbose <- TRUE
            
            if (missing(d)) stop('d is missed!')
            else if (!class(d) %in% c('numeric','integer','neighbours')) stop('d should be either a number (distance) or an object of class neighbours (created by dneigh function')
            
            if (!inherits(d,'neighbours')) d <- dneigh(x, 0, d[1])
            d <- d@neighbours
            
            if (missing(drop) || !is.logical(drop[1])) drop <- FALSE
            else drop <- drop[1]
            
            if (missing(zcol)) {
              if (ncol(x@data) > 1) stop("zcol should be specified!")
              else zcol <- 1
            } else if (is.character(zcol)) {
              w <- which(colnames(x@data) == zcol[1])
              if (w == 0) stop('the specified variable in zcol does not exist in the data')
              zcol <- w
            } else if (is.numeric(zcol)) {
              zcol <- zcol[1]
              if (zcol > ncol(x@data)) stop('the zcol number is greater than the number of columns in data!')
            } else stop("zcol should be a character or a number!")
            
            xx <- x
            
            x <- x@data[,zcol]
            
            if (is.character(x) || is.factor(x)) {
              x <- as.character(x)
              if (!missing(categorical) && !categorical) warning("you specified a categorical variable, so categorical changed to TRUE!")
              categorical <- TRUE
            }
            
            if (!missing(nc)) {
              if (missing(categorical)) {
                if (missing(dif)) categorical <- FALSE
                else {
                  categorical <- TRUE
                  if (verbose) cat("input data is considered categorical, and nc is ignored!\n")
                }
              } 
            } else {
              if (missing(categorical) && !missing(dif) && !is.null(classes)) categorical <- TRUE
            }
            #----
            if (missing(categorical) || !is.logical(categorical)) {
              # guessing whether the layer is categorical:
              if (.is.categorical(x)) {
                categorical <- TRUE
                if (verbose) cat("the specified variable is considered as categorical...\n")
              } else {
                categorical <- FALSE
                if (verbose) cat("the specified variable is considered continuous...\n")
              }
            }
            #----
            if (!categorical && missing(nc)) {
              nc <- nclass(x)
            } else if (categorical) {
              if (is.null(classes)) {
                if (missing(dif) || is.null(classes)) {
                  classes <- unique(x)
                } else {
                  if (length(names(dif)) > 1) {
                    classes <- names(dif)
                    .ux <- as.character(unique(x))
                    if (!all(.ux %in% classes)) classes <- .ux
                  } else classes <- unique(x)
                }
              } else {
                .ux <- unique(x)
                if (is.character(classes)) .ux <- as.character(.ux)
                if (!all(.ux %in% classes)) stop('the specified "classes" does not cover all or some of values in the input raster!')
              }
              nc <- length(classes)
            }
            #-----
            
            if (categorical) {
              if (missing(dif)) {
                dif <- rep(1,nc*nc)
                for (i in 1:nc) dif[(i-1)*nc+i] <-0
              } else {
                dif <- .checkDif(dif,classes)
              }
            }
            #-----
            
            if (!categorical) x <- categorize(x,nc)
            
            
            if (categorical) {
              x <- .Call('elsac_vector', x, d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa')
            } else {
              x <- .Call('elsa_vector', x, d, as.integer(nc), PACKAGE='elsa')
            }
            
            xx@data$Ea <- x[[2]]
            xx@data$Ec <- x[[1]]
            xx@data$ELSA <- x[[1]] * x[[2]]
            xx@data <- xx@data[,c('Ea','Ec','ELSA')]
            
            if (!drop) xx
            else xx@data
            
          }
)  


setMethod('elsa', signature(x='SpatialPolygonsDataFrame'), 
          function(x,d,nc,categorical,dif,classes,stat,zcol,drop,method,verbose=TRUE,...) {
            if (missing(classes)) classes <- NULL
            
            if (missing(verbose)) verbose <- TRUE
            
            if (missing(d)) stop('d is missed!')
            else if (!class(d) %in% c('numeric','integer','neighbours')) stop('d should be either a number (distance) or an object of class neighbours (created by dneigh function')
            
            if (missing(method)) method <- 'centroid'
            
            if (!inherits(d,'neighbours')) d <- dneigh(x, 0, d[1],method = method)
            d <- d@neighbours
            if (missing(drop) || !is.logical(drop[1])) drop <- FALSE
            else drop <- drop[1]
            
            
            
            if (missing(zcol)) {
              if (ncol(x@data) > 1) stop("zcol should be specified!")
              else zcol <- 1
            } else if (is.character(zcol)) {
              w <- which(colnames(x@data) == zcol[1])
              if (w == 0) stop('the specified variable in zcol does not exist in the data')
              zcol <- w
            } else if (is.numeric(zcol)) {
              zcol <- zcol[1]
              if (zcol > ncol(x@data)) stop('the zcol number is greater than the number of columns in data!')
            } else stop("zcol should be a character or a number!")
            
            xx <- x
            
            x <- x@data[,zcol]
            
            if (is.character(x) || is.factor(x)) {
              x <- as.character(x)
              if (!missing(categorical) && !categorical) warning("you specified a categorical variable, so categorical changed to TRUE!")
              categorical <- TRUE
            }
            
            if (!missing(nc)) {
              if (missing(categorical)) {
                if (missing(dif)) categorical <- FALSE
                else {
                  categorical <- TRUE
                  if (verbose) cat("input data is considered categorical, and nc is ignored!\n")
                }
              } 
            } else {
              if (missing(categorical) && !missing(dif)) categorical <- TRUE
            }
            #----
            if (missing(categorical) || !is.logical(categorical)) {
              # guessing whether the layer is categorical:
              if (.is.categorical(x)) {
                categorical <- TRUE
                if (verbose) cat("the specified variable is considered as categorical...\n")
              } else {
                categorical <- FALSE
                if (verbose) cat("the specified variable is considered continuous...\n")
              }
            }
            #----
            if (!categorical && missing(nc)) {
              nc <- nclass(x)
            } else if (categorical) {
              if (is.null(classes)) {
                if (missing(dif) || is.null(classes)) {
                  classes <- unique(x)
                } else {
                  if (length(names(dif)) > 1) {
                    classes <- names(dif)
                    .ux <- as.character(unique(x))
                    if (!all(.ux %in% classes)) classes <- .ux
                  } else classes <- unique(x)
                }
              } else {
                .ux <- unique(x)
                if (is.character(classes)) .ux <- as.character(.ux)
                if (!all(.ux %in% classes)) stop('the specified "classes" does not cover all or some of values in the input raster!')
              }
              nc <- length(classes)
            }
            #-----
            
            if (categorical) {
              if (missing(dif)) {
                dif <- rep(1,nc*nc)
                for (i in 1:nc) dif[(i-1)*nc+i] <-0
              } else {
                dif <- .checkDif(dif,classes)
              }
            }
            #-----
            
            if (!categorical) x <- categorize(x,nc)
            
            if (categorical) {
              x <- .Call('elsac_vector', as.integer(x), d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa')
            } else {
              x <-.Call('elsa_vector', as.integer(x), d, as.integer(nc), PACKAGE='elsa')
            }
            
            xx@data$Ea <- x[[2]]
            xx@data$Ec <- x[[1]]
            xx@data$ELSA <- x[[1]] * x[[2]]
            xx@data <- xx@data[,c('Ea','Ec','ELSA')]
            
            if (!drop) xx
            else xx@data
            
          }
)  
###########################
###########################
#------------ Adding functions to support input from the terra package (SpatRaster and SpatVector) ----
###########################
###########################


setMethod('elsa', signature(x='SpatRaster'), 
          function(x,d,nc,categorical,dif,classes,stat,cells,filename,verbose=TRUE,...) {
            if (missing(classes)) classes <- NULL
            
            if (missing(verbose)) verbose <- TRUE
            
            if (missing(stat) || is.null(stat)) stat <- 'elsa'
            else {
              stat <- tolower(stat)
              if (length(stat) == 1) {
                if (!stat %in% c('elsa','ec','ea')) {
                  stat <- 'elsa'
                  warning('stat should be either of "ELSA", "Ec", "Ea"; the default "ELSA" is considered!')
                }
              } else {
                if (!all(tolower(stat) %in% c('elsa','ec','ea'))) stop('stat should be selected from "ELSA", "Ea", "Ec"')
              }
            }
            #----
            if (missing(d)) d <- res(x)[1] * sqrt(2)
            
            if (missing(filename)) filename <- ''
            
            if (!missing(nc) && !is.null(nc)) {
              if (missing(categorical)) {
                if (missing(dif) && is.null(classes)) categorical <- FALSE
                else {
                  if (!missing(dif) && !is.null(dif) && !is.null(classes) && .is.categoricalSpatRaster(x)) categorical <- TRUE
                  else {
                    if (verbose) cat("the input data seems continues (if not, use categorical=TRUE)!.... dif/classes is ignored!\n")
                  } 
                }
              } 
            } else {
              if (missing(categorical) && !missing(dif) && !is.null(dif) && !is.null(classes)) categorical <- TRUE
            }
            #----
            if (missing(categorical) || !is.logical(categorical)) {
              # guessing whether the layer is categorical:
              if (.is.categoricalSpatRaster(x)) {
                categorical <- TRUE
                if (verbose) cat("the input is considered as a categorical variable...\n")
              } else {
                categorical <- FALSE
                if (verbose) cat("the input is considered as a continuous variable...\n")
              }
            }
            #----
            if (!categorical && missing(nc)) {
              nc <- nclass(x[[1]])
            } else if (categorical) {
              if (is.null(classes)) {
                if (missing(dif) || is.null(classes)) {
                  classes <- unique(x[[1]],incomparables = TRUE)[[1]]
                  if (nlyr(x) > 1) warning('since multiple categorical layers are in the SpatRaster object and "classes" is not specified, the classes are extracted from the first layer!')
                } else {
                  if (length(names(dif)) > 1) {
                    classes <- names(dif)
                    .ux <- as.character(unique(x[[1]],incomparables = TRUE)[[1]])
                    #.ux <- lapply(.ux,as.character)
                    # if (!all(sapply(.ux,function(x) all(x %in% classes)))) {
                    #   if (ncol(.ux) > 1) classes <- .ux
                    #   else classes <- .ux[[1]]
                    #   #if (any(sapply(.ux,function(x) length(unique(x))) / length(unique(unlist(.ux))) > 0.5)) stop('It seems that the classes in different layers ')
                    # }
                    if (!all(.ux %in% classes)) classes <- .ux
                  } else {
                    #.ux <- unique(x[[1]],incomparables = TRUE)[[1]]
                    classes <- unique(x[[1]],incomparables = TRUE)[[1]]
                    if (nlyr(x) > 1) warning('since multiple categorical layers are in the SpatRaster and "classes" is not specified, the classes are extracted from the first layer!')
                  }
                }
              } else {
                .ux <- unique(x,incomparables = TRUE)
                if (is.character(classes)) .ux <- lapply(.ux,as.character)
                # if (is.list(classes) && length(classes) == length(.ux)) {
                #   for (i in 1:length(classes)) {
                #     if (!all(sapply(.ux,function(x) all(x %in% classes[[i]])))) stop('the specified "classes" does not cover all or some of values in the input raster!')
                #   }
                # } else {
                #   if (!all(sapply(.ux,function(x) all(x %in% classes)))) stop('the specified "classes" does not cover all or some of values in the input raster!')
                # }
                if (!all(sapply(.ux,function(x) all(x %in% classes)))) stop('the specified "classes" does not cover all or some of values in the input raster!')
              }
              # if (is.list(classes)) {
              #   nc <- sapply(classes,length)
              # } else nc <- length(classes)
              nc <- length(classes)
            }
            #-----
            
            if (categorical) {
              if (missing(dif)) {
                dif <- rep(1,nc*nc)
                for (i in 1:nc) dif[(i-1)*nc+i] <-0
              } else {
                dif <- .checkDif(dif,classes)
              }
            }
            #-----
            w <-.Filter(r=res(x)[1],d1=0,d2=d)
            fdim <- w[[1]]
            w <- w[[2]]
            
            if (fdim < 3) stop("d must be at least equal to the input raster resolution!")
            
            if (!categorical) {
              x <- categorize(x,nc)
              if (length(nc) > 1) nc <- length(nc) - 1
            }
            
            out <- rast(x)
            ncl <- ncol(out)
            nrw <- nrow(out)
            filename=trim(filename)
            gc()
            #---------------
            if (.canProcessInMemory(out,n=3)) {
              
              if (categorical) {
                if (missing(cells)) {
                  if (length(stat) == 1 && stat == 'elsa') {
                    for (i in 1:nlyr(x)) {
                      out[[i]][] <- .Call('v_elsac', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                    }
                    names(out) <- paste0(names(x),'_ELSA')
                  } else {
                    
                    if (nlyr(x) > 1) {
                      if (length(stat) > 1) out <- rast(x[[1]])
                      for (i in 1:nlyr(x)) {
                        xx <- .Call('elsac', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                        if (length(stat) > 1) {
                          .lyrnames <- names(x)
                          nnn <- c()
                          if ('ea' %in% stat) {
                            outx <- rast(out[[1]])
                            outx[] <- xx[[2]]
                            out <- c(out,outx)
                            nnn <- c(nnn,paste0(.lyrnames[i],'_Ea'))
                          }
                          if ('ec' %in% stat) {
                            outx <- rast(out[[1]])
                            outx[] <- xx[[1]]
                            out <- c(out,outx)
                            nnn <- c(nnn,paste0(.lyrnames[i],'_Ec'))
                          }
                          if ('elsa' %in% stat) {
                            outx <- rast(out[[1]])
                            outx[] <- xx[[2]] * xx[[1]]
                            out <- c(out,outx)
                            nnn <- c(nnn,paste0(.lyrnames[i],'_ELSA'))
                          }
                          names(out) <- nnn
                          
                        } else {
                          if (stat == 'ea') {
                            out[[i]][] <- xx[[2]]
                            names(out) <- 'Ea'
                          } else {
                            out[[i]][] <- xx[[1]]
                            names(out) <- 'Ec'
                          }
                        }
                      }
                      
                    } else {
                      xx <- .Call('elsac', x[][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                      if (length(stat) > 1) {
                        nnn <- c()
                        if ('ea' %in% stat) {
                          outx <- rast(out)
                          outx[] <- xx[[2]]
                          out <- c(out,outx)
                          nnn <- c(nnn,'Ea')
                        }
                        if ('ec' %in% stat) {
                          outx <- rast(out)
                          outx[] <- xx[[1]]
                          out <- c(out,outx)
                          nnn <- c(nnn,'Ec')
                        }
                        if ('elsa' %in% stat) {
                          outx <- rast(out)
                          outx[] <- xx[[2]] * xx[[1]]
                          out <- c(out,outx)
                          nnn <- c(nnn,'ELSA')
                        }
                        names(out) <- nnn
                        
                      } else {
                        if (stat == 'ea') {
                          out[] <- xx[[2]]
                          names(out) <- 'Ea'
                        } else {
                          out[] <- xx[[1]]
                          names(out) <- 'Ec'
                        }
                      }
                    }
                    
                  }
                  if (filename != '') out <- writeRaster(out, filename, ...)
                } else {
                  if (nlyr(x) > 1) {
                    out <- matrix(NA,nrow=length(cells),ncol=nlyr(x)*length(stat))
                    .layernames <- names(x)
                    colnames(out) <- paste0(.layernames,'_',stat)
                    for (i in 1:nlyr(x)) {
                      if (length(stat) == 1) {
                        if (stat == 'elsa') out[,i] <- .Call('v_elsac_cell', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                        else if (stat == 'ec') out[,i] <- .Call('v_elsac_cell_Ec', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                        else if (stat == 'ea') out[,i] <- .Call('v_elsac_cell_Ea', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                      } else {
                        xx <- .Call('elsac_cell', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                        
                        if ('ea' %in% stat) {
                          out[,paste0(.layernames[i],'_','ea')] <- xx[[2]]
                        }
                        if ('ec' %in% stat) {
                          out[,paste0(.layernames[i],'_','ec')] <- xx[[1]]
                        }
                        if ('elsa' %in% stat) {
                          out[,paste0(.layernames[i],'_','elsa')] <- xx[[2]] * xx[[1]]
                        }
                      }
                    }
                  } else {
                    if (length(stat) == 1) {
                      if (stat == 'elsa') out <- .Call('v_elsac_cell', x[][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                      else if (stat == 'ec') out <- .Call('v_elsac_cell_Ec', x[][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                      else if (stat == 'ea') out <- .Call('v_elsac_cell_Ea', x[][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                    } else {
                      xx <- .Call('elsac_cell', x[][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                      out <- list()
                      if ('ea' %in% stat) {
                        out[['Ea']] <- xx[[2]]
                      }
                      if ('ec' %in% stat) {
                        out[['Ec']] <- xx[[1]]
                      }
                      if ('elsa' %in% stat) {
                        out[['ELSA']] <-  xx[[2]] * xx[[1]]
                      }
                    }
                  }
                  
                }
              } else {
                if (missing(cells)) {
                  
                  if (length(stat) == 1 && stat == 'elsa') {
                    for (i in 1:nlyr(x)) {
                      out[[i]][] <- .Call('v_elsa', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                    }
                    
                    names(out) <- paste0(names(x),'_ELSA')
                  } else {
                    
                    out <- rast(x[[1]])
                    for (i in 1:nlyr(x)) {
                      xx <- .Call('elsa', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                      if ('ea' %in% stat) {
                        outx <- rast(x[[1]])
                        outx[] <- xx[[2]]
                        names(outx) <- paste0(names(x[[i]]),'_Ea')
                        out <- c(out,outx)
                      }
                      
                      if ('ec' %in% stat) {
                        outx <- rast(x[[1]])
                        outx[] <- xx[[1]]
                        names(outx) <- paste0(names(x[[i]]),'_Ec')
                        out <- c(out,outx)
                      }
                      
                      if ('elsa' %in% stat) {
                        outx <- rast(x[[1]])
                        outx[] <- xx[[2]] * xx[[1]]
                        names(outx) <- paste0(names(x[[i]]),'_ELSA')
                        out <- c(out,outx)
                      }
                    }
                  }
                  if (filename != '') out <- writeRaster(out, filename, ...)
                  
                } else {
                  out <- list()
                  for (i in 1:nlyr(x)) {
                    if (length(stat) == 1) {
                      if (stat == 'elsa') out[[paste0(names(x[[i]]),'_ELSA')]] <- .Call('v_elsa_cell', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells), PACKAGE='elsa')
                      else if (stat == 'ec') out[[paste0(names(x[[i]]),'Ec')]] <- .Call('v_elsa_cell_Ec', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells), PACKAGE='elsa')
                      else if (stat == 'ea') out[[paste0(names(x[[i]]),'_Ea')]] <- .Call('v_elsa_cell_Ea', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells), PACKAGE='elsa')
                    } else {
                      xx <- .Call('elsa_cell', x[[i]][][,i], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells), PACKAGE='elsa')
                      if ('ea' %in% stat) {
                        out[[paste0(names(x[[i]]),'_Ea')]] <- xx[[2]]
                      }
                      if ('ec' %in% stat) {
                        out[[paste0(names(x[[i]]),'_Ec')]] <- xx[[1]]
                      }
                      if ('elsa' %in% stat) {
                        out[[paste0(names(x[[i]]),'_ELSA')]] <-  xx[[2]] * xx[[1]]
                      }
                    }
                  }
                }
              }
            } else {
              if (verbose) cat("\nThe input dataset is considered as a big raster dataset that will be handled out of memory (on the disk)...")
              
              if (nlyr(x) > 1) {
                warning("Since the raster dataset cannot handled in memory, the function is applied only to the first layer!")
                x <- x[[1]]
                out <- rast(x[[1]])
              }
              tr <- blocks(out,n=3)
              
              addr <- floor(fdim / 2)
              
              if (missing(cells)) {
                
                if (length(stat) > 1) warning(paste('for big rasters, stat can only have one value, so stat = "',toupper(stat[1]),'", is considered!\n',sep=''))
                stat <- stat[1]
                
                
                readStart(x)
                b <- writeStart(out, filename=filename,...)
                v <- readValues(x, row=1, nrows=b$nrows[1]+addr)
                if (!categorical) {
                  v <- .Call('elsa', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                } else {
                  v <- .Call('elsac', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                }
                
                if (stat == 'elsa') v <- v[[1]] * v[[2]]
                else if (stat == 'ea') v <- v[[2]]
                else v <- v[[1]]
                
                ex <- length(v) - (addr * ncl)
                writeValues(out, v[1:ex], 1, nrows=b$nrows[1])
                
                for (i in 2:(b$n-1)) {
                  v <- readValues(x, row=tr$row[i]-addr, nrows=b$nrows[i]+(2*addr))
                  if (!categorical) {
                    v <- .Call('elsa', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                  } else {
                    v <- .Call('elsac', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                  }
                  
                  if (stat == 'elsa') v <- v[[1]] * v[[2]]
                  else if (stat == 'ea') v <- v[[2]]
                  else v <- v[[1]]
                  
                  st <- (addr * ncl)+1
                  ex <- length(v) - (addr * ncl)
                  writeValues(out, v[st:ex], b$row[i],nrows=b$nrows[i])
                }
                
                i <- b$n
                v <- readValues(x, row=b$row[i]-addr, nrows=b$nrows[i])
                if (!categorical) {
                  v <- .Call('elsa', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                } else {
                  v <- .Call('elsac', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                }
                
                if (stat == 'elsa') v <- v[[1]] * v[[2]]
                else if (stat == 'ea') v <- v[[2]]
                else v <- v[[1]]
                
                st <- (addr * ncl)+1
                ex <- length(v)
                writeValues(out, v[st:ex], tr$row[i])
                
                writeStop(out)      
                readStop(x)
              } else {
                readStart(x)
                v <- readValues(x, row=1, nrows=tr$nrows[1]+addr)
                cls <- cells[which(cells <= (tr$nrows[1]) * ncl)]
                if (length(cls) > 0) {
                  if (!categorical) {
                    v <- .Call('elsa_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), as.integer(cls), PACKAGE='elsa')
                  } else {
                    v <- .Call('elsac_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cls), PACKAGE='elsa')
                  }
                  
                  if (length(stat) > 1) {
                    out <- list()
                    if ('ea' %in% stat) {
                      out[['Ea']] <- c(out[['L']],v[[2]])
                    }
                    if ('ec' %in% stat) {
                      out[['Ec']] <- c(out[['R']],v[[1]])
                    }
                    if ('elsa' %in% stat) {
                      out[['ELSA']] <-  c(out[['ELSA']],v[[2]] * v[[1]])
                    }
                  } else {
                    out <- c()
                    if (stat == 'ea') {
                      out <- c(out, v[[2]])
                    } else if (stat == 'ec') {
                      out <- c(out, v[[1]])
                    } else out <- c(out, v[[1]]*v[[2]])
                  }
                }
                
                for (i in 2:(tr$n-1)) {
                  
                  cls <- cells[which((cells > ((tr$row[i] - 1) * ncl)) & (cells <= ((tr$row[i]+ tr$nrows[i] - 1) * ncl)))]
                  if (length(cls) > 0) {
                    cls <- cls - ((tr$row[i]-addr-1)*ncl)
                    v <- readValues(x, row=tr$row[i]-addr, nrows=tr$nrows[i]+(2*addr))
                    if (!categorical) {
                      v <- .Call('elsa_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), as.integer(cls), PACKAGE='elsa')
                    } else {
                      v <- .Call('elsac_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cls), PACKAGE='elsa')
                    }
                    if (length(stat) > 1) {
                      if ('ea' %in% stat) {
                        out[['Ea']] <- c(out[['L']],v[[2]])
                      }
                      if ('ec' %in% stat) {
                        out[['Ec']] <- c(out[['R']],v[[1]])
                      }
                      if ('elsa' %in% stat) {
                        out[['ELSA']] <-  c(out[['ELSA']],v[[2]] * v[[1]])
                      }
                    } else {
                      if (stat == 'ea') {
                        out <- c(out, v[[2]])
                      } else if (stat == 'ec') {
                        out <- c(out, v[[1]])
                      } else out <- c(out, v[[1]]*v[[2]])
                    }
                  }
                }
                
                i <- tr$n
                cls <- cells[which(cells > ((tr$row[i] - 1) * ncl) & cells <= ((tr$row[i]+ tr$nrows[i] - 1) * ncl))]
                cls <- cls - ((tr$row[i]-addr-1)*ncl)
                if (length(cls) > 0) {
                  v <- readValues(x, row=tr$row[i]-addr, nrows=tr$nrows[i])
                  if (!categorical) {
                    v <- .Call('v_elsa_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), as.integer(cls), PACKAGE='elsa')
                  } else {
                    v <- .Call('v_elsac_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cls), PACKAGE='elsa')
                  }
                  if (length(stat) > 1) {
                    if ('ea' %in% stat) {
                      out[['Ea']] <- c(out[['Ea']],v[[2]])
                    }
                    if ('ec' %in% stat) {
                      out[['Ec']] <- c(out[['Ec']],v[[1]])
                    }
                    if ('elsa' %in% stat) {
                      out[['ELSA']] <-  c(out[['ELSA']],v[[2]] * v[[1]])
                    }
                  } else {
                    if (stat == 'ea') {
                      out <- c(out, v[[2]])
                    } else if (stat == 'ec') {
                      out <- c(out, v[[1]])
                    } else out <- c(out, v[[1]]*v[[2]])
                  }
                  
                }
                readStop(x)
              }
            }
            return(out)
          }
)  


#---------------

setMethod('elsa', signature(x='SpatVector'), 
          function(x,d,nc,categorical,dif,classes,stat,zcol,drop,verbose=TRUE,...) {
            if (missing(classes)) classes <- NULL
            
            if (missing(verbose)) verbose <- TRUE
            
            if (missing(d)) stop('d is missed!')
            else if (!class(d) %in% c('numeric','integer','neighbours')) stop('d should be either a number (distance) or an object of class neighbours (created by dneigh function')
            
            if (!inherits(d,'neighbours')) d <- dneigh(x, 0, d[1],longlat = FALSE)
              
            d <- d@neighbours
            
            if (missing(drop) || !is.logical(drop[1])) drop <- FALSE
            else drop <- drop[1]
            
            if (missing(zcol)) {
              if (ncol(x) > 1) stop("zcol should be specified!")
              else zcol <- 1
            } else if (is.character(zcol)) {
              w <- which(names(x) == zcol[1])
              if (w == 0) stop('the specified variable in zcol does not exist in the data')
              zcol <- w
            } else if (is.numeric(zcol)) {
              zcol <- zcol[1]
              if (zcol > ncol(x)) stop('the zcol number is greater than the number of columns in data!')
            } else stop("zcol should be a character or a number!")
            
            xx <- x
            
            x <- data.frame(x)[,zcol]
            
            if (is.character(x) || is.factor(x)) {
              x <- as.character(x)
              if (!missing(categorical) && !categorical) warning("you specified a categorical variable, so categorical changed to TRUE!")
              categorical <- TRUE
            }
            
            if (!missing(nc)) {
              if (missing(categorical)) {
                if (missing(dif)) categorical <- FALSE
                else {
                  categorical <- TRUE
                  if (verbose) cat("input data is considered categorical, and nc is ignored!\n")
                }
              } 
            } else {
              if (missing(categorical) && !missing(dif) && !is.null(classes)) categorical <- TRUE
            }
            #----
            if (missing(categorical) || !is.logical(categorical)) {
              # guessing whether the layer is categorical:
              if (.is.categorical(x)) {
                categorical <- TRUE
                if (verbose) cat("the specified variable is considered as categorical...\n")
              } else {
                categorical <- FALSE
                if (verbose) cat("the specified variable is considered continuous...\n")
              }
            }
            #----
            if (!categorical && missing(nc)) {
              nc <- nclass(x)
            } else if (categorical) {
              if (is.null(classes) || is.na(classes)) {
                if (missing(dif) || is.null(classes)) {
                  classes <- unique(x)
                } else {
                  if (length(names(dif)) > 1) {
                    classes <- names(dif)
                    .ux <- as.character(unique(x))
                    if (!all(.ux %in% classes)) classes <- .ux
                  } else classes <- unique(x)
                }
              } else {
                .ux <- unique(x)
                if (is.character(classes)) .ux <- as.character(.ux)
                if (!all(.ux %in% classes)) stop('the specified "classes" does not cover all or some of values in the input raster!')
              }
              nc <- length(classes)
            }
            #-----
            
            if (categorical) {
              if (missing(dif)) {
                dif <- rep(1,nc*nc)
                for (i in 1:nc) dif[(i-1)*nc+i] <-0
              } else {
                dif <- .checkDif(dif,classes)
              }
            }
            #-----
            
            if (!categorical) {
              x <- categorize(x,nc)
              if (length(nc) > 1) nc <- length(nc) - 1
            }
            
            
            if (categorical) {
              x <- .Call('elsac_vector', x, d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa')
            } else {
              x <- .Call('elsa_vector', x, d, as.integer(nc), PACKAGE='elsa')
            }
            
            xx$Ea <- x[[2]]
            xx$Ec <- x[[1]]
            xx$ELSA <- x[[1]] * x[[2]]
            
            
            if (!drop) xx
            else data.frame(xx)
            
          }
)  


setMethod('elsa', signature(x='SpatialPolygonsDataFrame'), 
          function(x,d,nc,categorical,dif,classes,stat,zcol,drop,method,verbose=TRUE,...) {
            if (missing(classes)) classes <- NULL
            
            if (missing(verbose)) verbose <- TRUE
            
            if (missing(d)) stop('d is missed!')
            else if (!class(d) %in% c('numeric','integer','neighbours')) stop('d should be either a number (distance) or an object of class neighbours (created by dneigh function')
            
            if (missing(method)) method <- 'centroid'
            
            if (!inherits(d,'neighbours')) d <- dneigh(x, 0, d[1],method = method)
            d <- d@neighbours
            if (missing(drop) || !is.logical(drop[1])) drop <- FALSE
            else drop <- drop[1]
            
            
            
            if (missing(zcol)) {
              if (ncol(x@data) > 1) stop("zcol should be specified!")
              else zcol <- 1
            } else if (is.character(zcol)) {
              w <- which(colnames(x@data) == zcol[1])
              if (w == 0) stop('the specified variable in zcol does not exist in the data')
              zcol <- w
            } else if (is.numeric(zcol)) {
              zcol <- zcol[1]
              if (zcol > ncol(x@data)) stop('the zcol number is greater than the number of columns in data!')
            } else stop("zcol should be a character or a number!")
            
            xx <- x
            
            x <- x@data[,zcol]
            
            if (is.character(x) || is.factor(x)) {
              x <- as.character(x)
              if (!missing(categorical) && !categorical) warning("you specified a categorical variable, so categorical changed to TRUE!")
              categorical <- TRUE
            }
            
            if (!missing(nc)) {
              if (missing(categorical)) {
                if (missing(dif)) categorical <- FALSE
                else {
                  categorical <- TRUE
                  if (verbose) cat("input data is considered categorical, and nc is ignored!\n")
                }
              } 
            } else {
              if (missing(categorical) && !missing(dif)) categorical <- TRUE
            }
            #----
            if (missing(categorical) || !is.logical(categorical)) {
              # guessing whether the layer is categorical:
              if (.is.categorical(x)) {
                categorical <- TRUE
                if (verbose) cat("the specified variable is considered as categorical...\n")
              } else {
                categorical <- FALSE
                if (verbose) cat("the specified variable is considered continuous...\n")
              }
            }
            #----
            if (!categorical && missing(nc)) {
              nc <- nclass(x)
            } else if (categorical) {
              if (is.null(classes) || is.na(classes)) {
                if (missing(dif) || is.null(classes)) {
                  classes <- unique(x)
                } else {
                  if (length(names(dif)) > 1) {
                    classes <- names(dif)
                    .ux <- as.character(unique(x))
                    if (!all(.ux %in% classes)) classes <- .ux
                  } else classes <- unique(x)
                }
              } else {
                .ux <- unique(x)
                if (is.character(classes)) .ux <- as.character(.ux)
                if (!all(.ux %in% classes)) stop('the specified "classes" does not cover all or some of values in the input raster!')
              }
              nc <- length(classes)
            }
            #-----
            
            if (categorical) {
              if (missing(dif)) {
                dif <- rep(1,nc*nc)
                for (i in 1:nc) dif[(i-1)*nc+i] <-0
              } else {
                dif <- .checkDif(dif,classes)
              }
            }
            #-----
            
            if (!categorical) x <- categorize(x,nc)
            
            if (categorical) {
              x <- .Call('elsac_vector', as.integer(x), d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa')
            } else {
              x <-.Call('elsa_vector', as.integer(x), d, as.integer(nc), PACKAGE='elsa')
            }
            
            xx@data$Ea <- x[[2]]
            xx@data$Ec <- x[[1]]
            xx@data$ELSA <- x[[1]] * x[[2]]
            xx@data <- xx@data[,c('Ea','Ec','ELSA')]
            
            if (!drop) xx
            else xx@data
            
          }
)  




# Author: Babak Naimi, naimi.b@gmail.com
# Date :  August 2016
# Last Update :  February 2020
# Version 2.6
# Licence GPL v3 

if (!isGeneric("elsa.test")) {
  setGeneric("elsa.test", function(x, d, n, method, null, nc, categorical, dif,classes,...)
    standardGeneric("elsa.test"))
}


setMethod('elsa.test', signature(x='RasterLayer'), 
          function(x, d, n=99, method, null, nc, categorical, dif,classes,cells,filename,verbose=TRUE,...) {
            
            if (missing(classes)) classes <- NULL
            
            if (missing(verbose)) verbose <- TRUE
            
            if (missing(filename)) filename <- ''
            
            if (missing(n)) {
              if (ncell(x) > 20000) n <- 99
              else n <- 999
              
              if (verbose) cat(paste("n (number of runs in Monte Carlo simulations) is set to",n,"...\n"))
            }
            #----------
            if (missing(method)) method <- 2
            else {
              method <- method[1]
              if (method %in% c('boot','bootstrap','b','bo')) method <- 2
              else if (method %in% c('perm','permutation','p','pe')) method <- 1
              else {
                if (!is.numeric(method) || !method %in% 1:2) {
                  warning('method is not identified; default ("boot") is considered')
                  method <- 2
                }
              }
            }
            #------
            
            if (!missing(nc) && !is.null(nc) && !is.na(nc)) {
              if (missing(categorical)) {
                if (missing(dif) && is.null(classes)) categorical <- FALSE
                else {
                  if (!missing(dif) && !is.null(dif) && !is.na(dif) && !is.null(classes) && !is.na(classes) && .is.categoricalRaster(x)) categorical <- TRUE
                  else {
                    if (verbose) cat("the input data seems continues (if not, use categorical=TRUE)!.... dif/classes is ignored!\n")
                  }
                }
              } 
            } else {
              if (missing(categorical) && !missing(dif) && !is.null(dif) && !is.na(dif) && !is.null(classes) && !is.na(classes)) categorical <- TRUE
            }
            
            #----
            
            
            if (missing(categorical) || !is.logical(categorical)) {
              # guessing whether the layer is categorical:
              if (.is.categoricalRaster(x)) {
                categorical <- TRUE
                if (verbose) cat("the input is considered as a categorical variable...\n")
              } else {
                categorical <- FALSE
                if (verbose) cat("the input is considered as a continuous variable...\n")
              }
            }
            #----
            if (!categorical && missing(nc)) {
              nc <- nclass(x)
            } else if (categorical) {
              if (is.null(classes) || is.na(classes)) {
                if (missing(dif) || is.null(classes) || is.na(classes) ) {
                  classes <- unique(x)
                } else {
                  if (length(names(dif)) > 1) {
                    classes <- names(dif)
                    .ux <- as.character(unique(x))
                    if (!all(.ux %in% classes)) classes <- .ux
                  } else classes <- unique(x)
                }
              } else {
                .ux <- unique(x)
                if (is.character(classes)) .ux <- as.character(.ux)
                if (!all(.ux %in% classes)) stop('the specified "classes" does not cover all or some of values in the input raster!')
              }
              nc <- length(classes)
            }
            #-----
            
            if (categorical) {
              if (missing(dif)) {
                dif <- rep(1,nc*nc)
                for (i in 1:nc) dif[(i-1)*nc+i] <-0
              } else {
                dif <- .checkDif(dif,classes)
              }
            }
            #------------------------
            if (missing(null)) {
              #null <- calc(x,function(x) { x[!is.na(x)] <- sample(classes,length(x[!is.na(x)]),replace=TRUE); x})
              null <- raster(x)
              w <- which(!is.na(x[]))
              null[w] <- sample(x[w],length(w))
            } else if (inherits(null,'numeric') && length(null) == ncell(x)) {
              nullx <- null
              null <- raster(x)
              null <- setValues(null,nullx)
              rm(nullx)
            } else if ((inherits(null,'RasterLayer') && !compareRaster(x,null,crs=FALSE,stopiffalse=FALSE)) || !inherits(null,'RasterLayer')) {
              warning('null is not a numeric vector, or a raster, or is a raster with a different extent, resolution, etc.; so, the null is generated given the default settings!')
              null <- raster(x)
              w <- which(!is.na(x[]))
              null[w] <- sample(x[w],length(w))
            }
            
            #----------------
            #-----
            w <-.Filter(r=res(x)[1],d1=0,d2=d)
            fdim <- w[[1]]
            w <- w[[2]]
            
            if (fdim < 3) stop("d must be at least equal to the input raster resolution!")
            
            if (!categorical) x <- categorize(x,nc)
            
            out <- raster(x)
            ncl <- ncol(out)
            nrw <- nrow(out)
            filename=trim(filename)
            
            if (canProcessInMemory(out)) {
              if (categorical) {
                if (missing(cells)) {
                  out[] <- .Call('elsac_test', x[],as.vector(null[]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif,as.integer(method),as.integer(n), PACKAGE='elsa')
                  if (filename != '') out <- writeRaster(out, filename, ...)
                } else {
                  out <- .Call('elsac_cell_test', x[],as.vector(null[]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif,as.integer(cells),as.integer(method),as.integer(n), PACKAGE='elsa')
                }
              } else {
                if (missing(cells)) {
                  out[] <- .Call('elsa_test', x[],as.vector(null[]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(method),as.integer(n), PACKAGE='elsa')
                  if (filename != '') out <- writeRaster(out, filename, ...)
                } else {
                  out <- .Call('elsa_cell_test', x[],as.vector(null[]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells),as.integer(method),as.integer(n), PACKAGE='elsa')
                }
              }
            } else {
              tr <- blockSize(out, minblocks=3, minrows=fdim)
              pb <- pbCreate(tr$n, label='ELSA',...)
              addr <- floor(fdim / 2)
              
              if (missing(cells)) {
                out <- writeStart(out, filename)
                v <- getValues(x, row=1, nrows=tr$nrows[1]+addr)
                vn <- getValues(null, row=1, nrows=tr$nrows[1]+addr)
                if (!categorical) {
                  v <- .Call('elsa_test', v , vn, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(method),as.integer(n), PACKAGE='elsa')
                } else {
                  v <- .Call('elsac_test', v , vn, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif,as.integer(method),as.integer(n), PACKAGE='elsa')
                }
                ex <- length(v) - (addr * ncl)
                out <- writeValues(out, v[1:ex], 1)
                
                for (i in 2:(tr$n-1)) {
                  v <- getValues(x, row=tr$row[i]-addr, nrows=tr$nrows[i]+(2*addr))
                  vn <- getValues(null, row=tr$row[i]-addr, nrows=tr$nrows[i]+(2*addr))
                  if (!categorical) {
                    v <- .Call('elsa_test', v , vn, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(method),as.integer(n), PACKAGE='elsa')
                  } else {
                    v <- .Call('elsac_test', v , vn, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif,as.integer(method),as.integer(n), PACKAGE='elsa')
                  }
                  st <- (addr * ncl) + 1
                  ex <- length(v) - (addr * ncl)
                  out <- writeValues(out, v[st:ex], tr$row[i])
                  pbStep(pb)
                }
                
                i <- tr$n
                v <- getValues(x, row=tr$row[i]-addr, nrows=tr$nrows[i]+addr)
                vn <- getValues(null, row=tr$row[i]-addr, nrows=tr$nrows[i]+addr)
                if (!categorical) {
                  v <- .Call('elsa_test', v , vn, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(method),as.integer(n), PACKAGE='elsa')
                } else {
                  v <- .Call('elsac_test', v , vn, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif,as.integer(method),as.integer(n), PACKAGE='elsa')
                }
                st <- (addr * ncl)+1
                ex <- length(v)
                out <- writeValues(out, v[st:ex], tr$row[i])
                pbStep(pb)
                out <- writeStop(out)      
                pbClose(pb)  
              } else {
                v <- getValues(x, row=1, nrows=tr$nrows[1]+addr)
                vn <- getValues(null, row=1, nrows=tr$nrows[1]+addr)
                cls <- cells[which(cells <= (tr$nrows[1]) * ncl)]
                if (length(cls) > 0) {
                  if (!categorical) {
                    v <- .Call('elsa_cell_test', v , vn, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cls),as.integer(method),as.integer(n), PACKAGE='elsa')
                  } else {
                    v <- .Call('elsac_cell_test', v , vn, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif,as.integer(cls), as.integer(method),as.integer(n), PACKAGE='elsa')
                  }
                  out <- c(out, v)
                }
                
                for (i in 2:(tr$n-1)) {
                  cls <- cells[which(cells > ((tr$nrow[i] - 1) * ncl) & cells <= ((tr$nrows[i]+ tr$nrows[i] - 1) * ncl))]
                  if (length(cls) > 0) {
                    cls <- cls - ((tr$row[i]-addr-1)*ncl)
                    v <- getValues(x, row=tr$row[i]-addr, nrows=tr$nrows[i]+(2*addr))
                    vn <- getValues(null, row=tr$row[i]-addr, nrows=tr$nrows[i]+(2*addr))
                    
                    if (!categorical) {
                      v <- .Call('elsa_cell_test', v , vn, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cls),as.integer(method),as.integer(n), PACKAGE='elsa')
                    } else {
                      v <- .Call('elsac_cell_test', v , vn, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif,as.integer(cls), as.integer(method),as.integer(n), PACKAGE='elsa')
                    }
                    
                    out <- c(out, v)
                    pbStep(pb)
                  }
                }
                
                i <- tr$n
                cls <- cells[which(cells > ((tr$nrow[i] - 1) * ncl) & cells <= ((tr$nrows[i]+ tr$nrows[i] - 1) * ncl))]
                cls <- cls - ((tr$row[i]-addr-1)*ncl)
                if (length(cls) > 0) {
                  v <- getValues(x, row=tr$row[i]-addr, nrows=tr$nrows[i]+addr)
                  vn <- getValues(null, row=tr$row[i]-addr, nrows=tr$nrows[i]+addr)
                  if (!categorical) {
                    v <- .Call('elsa_cell_test', v , vn, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cls),as.integer(method),as.integer(n), PACKAGE='elsa')
                  } else {
                    v <- .Call('elsac_cell_test', v , vn, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif,as.integer(cls), as.integer(method),as.integer(n), PACKAGE='elsa')
                  }
                  out <- c(out, v)
                  pbStep(pb)
                  pbClose(pb)  
                }
              }
            }
            #----------
            return(out)
          }
)
#--------------

setMethod('elsa.test', signature(x='SpatRaster'), 
          function(x, d, n=99, method, null, nc, categorical, dif,classes,cells,filename,verbose=TRUE,...) {
            
            if (missing(classes)) classes <- NULL
            
            if (missing(verbose)) verbose <- TRUE
            
            if (missing(filename)) filename <- ''
            
            if (missing(n)) {
              if (ncell(x) > 20000) n <- 99
              else n <- 999
              
              if (verbose) cat(paste("n (number of runs in Monte Carlo simulations) is set to",n,"...\n"))
            }
            #----------
            if (missing(method)) method <- 2
            else {
              method <- method[1]
              if (method %in% c('boot','bootstrap','b','bo')) method <- 2
              else if (method %in% c('perm','permutation','p','pe')) method <- 1
              else {
                if (!is.numeric(method) || !method %in% 1:2) {
                  warning('method is not identified; default ("boot") is considered')
                  method <- 2
                }
              }
            }
            #------
            
            if (!missing(nc) && !is.null(nc) && !is.na(nc)) {
              if (missing(categorical)) {
                if (missing(dif) && is.null(classes)) categorical <- FALSE
                else {
                  if (!missing(dif) && !is.null(dif) && !is.na(dif) && !is.null(classes) && !is.na(classes) && .is.categoricalRaster(x)) categorical <- TRUE
                  else {
                    if (verbose) cat("the input data seems continues (if not, use categorical=TRUE)!.... dif/classes is ignored!\n")
                  }
                }
              } 
            } else {
              if (missing(categorical) && !missing(dif) && !is.null(dif) && !is.na(dif) && !is.null(classes) && !is.na(classes)) categorical <- TRUE
            }
            
            #----
            
            
            if (missing(categorical) || !is.logical(categorical)) {
              # guessing whether the layer is categorical:
              if (.is.categoricalSpatRaster(x)) {
                categorical <- TRUE
                if (verbose) cat("the input is considered as a categorical variable...\n")
              } else {
                categorical <- FALSE
                if (verbose) cat("the input is considered as a continuous variable...\n")
              }
            }
            #----
            if (!categorical && missing(nc)) {
              nc <- nclass(x[[1]])
            } else if (categorical) {
              if (is.null(classes) || is.na(classes)) {
                if (missing(dif) || is.null(classes) || is.na(classes) ) {
                  classes <- unique(x[[1]],incomparables = TRUE)[[1]]
                  if (nlyr(x) > 1) warning('since multiple categorical layers are in the SpatRaster object and "classes" is not specified, the classes are extracted from the first layer!')
                } else {
                  if (length(names(dif)) > 1) {
                    classes <- names(dif)
                    .ux <- as.character(unique(x[[1]],incomparables = TRUE)[[1]])
                    if (!all(.ux %in% classes)) classes <- .ux
                  } else {
                    classes <- unique(x[[1]],incomparables = TRUE)[[1]]
                    if (nlyr(x) > 1) warning('since multiple categorical layers are in the SpatRaster and "classes" is not specified, the classes are extracted from the first layer!')
                  }
                }
              } else {
                .ux <- unique(x,incomparables = TRUE)
                if (is.character(classes)) .ux <- lapply(.ux,as.character)
                if (!all(.ux %in% classes)) stop('the specified "classes" does not cover all or some of values in the input raster!')
              }
              nc <- length(classes)
            }
            #-----
            
            if (categorical) {
              if (missing(dif)) {
                dif <- rep(1,nc*nc)
                for (i in 1:nc) dif[(i-1)*nc+i] <-0
              } else {
                dif <- .checkDif(dif,classes)
              }
            }
            #------------------------
            if (missing(null)) {
              #null <- calc(x,function(x) { x[!is.na(x)] <- sample(classes,length(x[!is.na(x)]),replace=TRUE); x})
              null <- rast(x)
              w <- which(!is.na(x[[1]][][,1]))
              for (i in 1:nlyr(x)) null[[i]][w] <- sample(x[[i]][w][,1],length(w))
            } else if (inherits(null,'numeric') && length(null) == ncell(x)) {
              nullx <- null
              null <- rast(x[[1]])
              null[] <- nullx
              rm(nullx)
              gc()
            } else if ((inherits(null,'SpatRaster') && !compareGeom(x,null,crs=FALSE,stopOnError=FALSE)) || !inherits(null,'SpatRaster')) {
              warning('null is not a numeric vector, or a raster, or is a raster with a different extent, resolution, etc.; so, the null is generated given the default settings!')
              null <- rast(x)
              w <- which(!is.na(x[[1]][][,1]))
              for (i in 1:nlyr(x)) null[[i]][w] <- sample(x[[i]][w][,1],length(w))
            }
            #-----
            w <-.Filter(r=res(x)[1],d1=0,d2=d)
            fdim <- w[[1]]
            w <- w[[2]]
            
            if (fdim < 3) stop("d must be at least equal to the input raster resolution!")
            
            if (!categorical) x <- categorize(x,nc)
            
            out <- rast(x)
            ncl <- ncol(out)
            nrw <- nrow(out)
            filename=trim(filename)
            gc()
            
            if (categorical) {
              if (missing(cells)) {
                for (i in 1:nlyr(x)) {
                  out[[i]][] <- .Call('elsac_test', x[[i]][][,1],as.vector(null[[i]][][,1]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif,as.integer(method),as.integer(n), PACKAGE='elsa')
                }
                
                if (filename != '') out <- writeRaster(out, filename, ...)
                
              } else {
                
                if (nlyr(x) > 1) {
                  out <- list()
                  for (i in 1:nlyr(x)) {
                    out[[i]] <- .Call('elsac_cell_test', x[[i]][][,1],as.vector(null[[i]][][,1]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif,as.integer(cells),as.integer(method),as.integer(n), PACKAGE='elsa')
                  }
                  names(out) <- names(x)
                  
                } else {
                  out <- .Call('elsac_cell_test', x[][,1],as.vector(null[][,1]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif,as.integer(cells),as.integer(method),as.integer(n), PACKAGE='elsa')
                }
              }
            } else {
              if (missing(cells)) {
                for (i in 1:nlyr(x)) {
                  out[[i]][] <- .Call('elsa_test', x[[i]][][,1],as.vector(null[[i]][][,1]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(method),as.integer(n), PACKAGE='elsa')
                }
                
                if (filename != '') out <- writeRaster(out, filename, ...)
                
              } else {
                
                if (nlyr(x) > 1) {
                  out <- list()
                  for (i in 1:nlyr(x)) {
                    out[[i]] <- .Call('elsa_cell_test', x[[i]][][,1],as.vector(null[[i]][][,1]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells),as.integer(method),as.integer(n), PACKAGE='elsa')
                  }
                  names(out) <- names(x)
                  
                } else {
                  out <- .Call('elsa_cell_test', x[][,1],as.vector(null[][,1]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells),as.integer(method),as.integer(n), PACKAGE='elsa')
                }
              }
            }
            #----------
            return(out)
          }
)
#--------------

# 
# 
# setMethod('elsa.test', signature(x='SpatialPointsDataFrame'), 
#           function(x, d, n=99, method, null, nc, categorical, dif,zcol,...) {
#             
#             if (missing(d)) stop('d is missed!')
#             else if (!class(d) %in% c('numeric','integer','neighbours')) stop('d should be either a number (distance) or an object of class neighbours (created by dneigh function')
#             
#             if (!inherits(d,'neighbours')) d <- dneigh(x, d[1])
#             d <- d@neighbours
#             #-------
#             if (missing(zcol)) {
#               if (ncol(x@data) > 1) stop("zcol should be specified!")
#               else zcol <- 1
#             } else if (is.character(zcol)) {
#               w <- which(colnames(x@data) == zcol[1])
#               if (w == 0) stop('the specified variable in zcol does not exist in the data')
#               zcol <- w
#             } else if (is.numeric(zcol)) {
#               zcol <- zcol[1]
#               if (zcol > ncol(x@data)) stop('the zcol number is greater than the number of columns in data!')
#             } else stop("zcol should be a character or a number!")
#             #-------------
#             if (missing(n)) {
#               if (ncell(x) > 20000) n <- 99
#               else n <- 999
#               
#               cat(paste("n (number of runs in Monte Carlo simulations) is set to",n,"...\n"))
#             }
#             #----------
#             if (missing(method)) method <- 2
#             else {
#               method <- method[1]
#               if (method %in% c('boot','bootstrap','b','bo')) method <- 2
#               else if (method %in% c('perm','permutation','p','pe')) method <- 1
#               else {
#                 if (!is.numeric(method) || !method %in% 1:2) {
#                   warning('method is not identified; default ("boot") is considered')
#                   method <- 2
#                 }
#               }
#             }
#             #------
#             xx <- x
#             xx@data$elsa <- rep(NA,nrow(xx))
#             xx@data$p_value <- rep(NA,nrow(xx))
#             xx@data <- xx@data[,c('elsa','p_value')]
#             
#             x <- x@data[,zcol]
#             
#             if (is.character(x) || is.factor(x)) {
#               x <- as.character(x)
#               if (!missing(categorical) && !categorical) warning("you specified a categorical variable, so categorical changed to TRUE!")
#               categorical <- TRUE
#             }
#             
#             if (!missing(nc)) {
#               if (missing(categorical)) {
#                 if (missing(dif)) categorical <- FALSE
#                 else {
#                   categorical <- TRUE
#                   cat("input data is considered categorical, and nc is ignored!\n")
#                 }
#               } 
#             } else {
#               if (missing(categorical) && !missing(dif)) categorical <- TRUE
#             }
#             #----
#             if (missing(categorical) || !is.logical(categorical)) {
#               # guessing whether the layer is categorical:
#               if (.is.categorical(x)) {
#                 categorical <- TRUE
#                 cat("the specified variable is considered as categorical...\n")
#               } else {
#                 categorical <- FALSE
#                 cat("the specified variable is considered continuous...\n")
#               }
#             }
#             #----
#             if (!categorical && missing(nc)) {
#               nc <- nclass(x)
#               classes <- 1:nc
#             } else if (categorical) {
#               classes <- unique(x)
#               nc <- length(classes)
#             }
#             #-----
#             if (categorical) {
#               if (missing(dif)) {
#                 dif <- rep(1,nc*nc)
#                 for (i in 1:nc) dif[(i-1)*nc+i] <-0
#               } else {
#                 dif <- .checkDif(dif,classes)
#               }
#             }
#             #-----
#             
#             if (!categorical) x <- categorize(x,nc)
#             
#             
#             
#             if (missing(null)) {
#               null <- rep(NA,length(x))
#               null[!is.na(x)] <- sample(classes,length(x[!is.na(x)]),replace=TRUE)
#             } else if (class(null) %in% c('numeric','integer')) {
#               if (!length(null) == length(x)) {
#                 warning('null is a numeric vector with a different length; so, the null is generated given the default settings!')
#                 null <- rep(NA,length(x))
#                 null[!is.na(x)] <- sample(classes,length(x[!is.na(x)]),replace=TRUE)
#               }
#             } else {
#               warning('null is not a numeric vector, so, the null is generated given the default settings!')
#               null <- rep(NA,length(x))
#               null[!is.na(x)] <- sample(classes,length(x[!is.na(x)]),replace=TRUE)
#             }
#             .Call('elsac_vector_test',as.integer(lc[]), as.vector(rc.n[]), z,  as.integer(nc), as.integer(classes), dif, as.integer(2),as.integer(99))
#             if (categorical) {
#               xx@data$elsa <- .Call('elsac_vector', as.integer(x), d, as.integer(nc), as.integer(classes),dif)
#               xx@data$p_value <- .Call('elsac_vector_test', as.integer(x),as.integer(null), d,  as.integer(nc), as.integer(classes), dif, as.integer(method),as.integer(n))
#             } else {
#               xx@data$elsa <- .Call('elsa_vector', as.integer(x), d, as.integer(nc))
#               xx@data$p_value <- .Call('elsa_vector_test', as.integer(x),as.integer(null), d,  as.integer(nc), as.integer(method),as.integer(n))
#             }
#             
#           }
# )
# #---------------

setMethod('elsa.test', signature(x='Spatial'), 
          function(x, d, n, method, null, nc, categorical, dif,classes,zcol,longlat,verbose=TRUE,...) {
            
            if (missing(classes)) classes <- NULL
            
            if (missing(verbose)) verbose <- TRUE
            
            if (missing(d)) stop('d is missed!')
            else if (!class(d) %in% c('numeric','integer','neighbours')) stop('d should be either a number (distance) or an object of class neighbours (created by dneigh function')
            
            if (missing(longlat) || !is.logical(longlat)) longlat <- NULL
            
            if (inherits(x,'SpatialPolygonsDataFrame')) {
              if (!inherits(d,'neighbours')) d <- dneigh(x, 0, d[1],longlat=longlat,method = 'centroid')
            } else if (inherits(x,'SpatialPointsDataFrame')) {
              if (!inherits(d,'neighbours')) d <- dneigh(x, 0, d[1],longlat=longlat)
            } else stop('x should be a SpatialPointsDataFrame or SpatialPolygonsDataFrame!')
            
            d <- d@neighbours
            #-------
            if (missing(zcol)) {
              if (ncol(x@data) > 1) stop("zcol should be specified!")
              else zcol <- 1
            } else if (is.character(zcol)) {
              w <- which(colnames(x@data) == zcol[1])
              if (w == 0) stop('the specified variable in zcol does not exist in the data')
              zcol <- w
            } else if (is.numeric(zcol)) {
              zcol <- zcol[1]
              if (zcol > ncol(x@data)) stop('the zcol number is greater than the number of columns in data!')
            } else stop("zcol should be a character or a number!")
            #-------------
            if (missing(n)) {
              if (nrow(x) > 10000) n <- 99
              else n <- 999
              
              if (verbose) cat(paste("n (number of runs in Monte Carlo simulations) is set to",n,"...\n"))
            }
            #----------
            if (missing(method)) method <- 2
            else {
              method <- method[1]
              if (method %in% c('boot','bootstrap','b','bo')) method <- 2
              else if (method %in% c('perm','permutation','p','pe')) method <- 1
              else {
                if (!is.numeric(method) || !method %in% 1:2) {
                  warning('method is not identified; default ("boot") is considered')
                  method <- 2
                }
              }
            }
            #------
            xx <- x
            xx@data$elsa <- rep(NA,nrow(xx))
            xx@data$p_value <- rep(NA,nrow(xx))
            xx@data <- xx@data[,c('elsa','p_value')]
            
            x <- x@data[,zcol]
            
            if (is.character(x) || is.factor(x)) {
              x <- as.character(x)
              if (!missing(categorical) && !categorical) warning("you specified a categorical variable, so categorical changed to TRUE!")
              categorical <- TRUE
            }
            
            if (!missing(nc)) {
              if (missing(categorical)) {
                if (missing(dif)) categorical <- FALSE
                else {
                  categorical <- TRUE
                  if (verbose) cat("input data is considered categorical, and nc is ignored!\n")
                }
              } 
            } else {
              if (missing(categorical) && !missing(dif)) categorical <- TRUE
            }
            #----
            if (missing(categorical) || !is.logical(categorical)) {
              # guessing whether the layer is categorical:
              if (.is.categorical(x)) {
                categorical <- TRUE
                if (verbose) cat("the specified variable is considered as categorical...\n")
              } else {
                categorical <- FALSE
                if (verbose) cat("the specified variable is considered continuous...\n")
              }
            }
            #----
            if (!categorical && missing(nc)) {
              nc <- nclass(x)
              classes <- 1:nc
            } else if (categorical) {
              if (is.null(classes) || is.na(classes)) {
                if (missing(dif) || is.null(classes) || is.na(classes) ) {
                  classes <- unique(x)
                } else {
                  if (length(names(dif)) > 1) {
                    classes <- names(dif)
                    .ux <- as.character(unique(x))
                    if (!all(.ux %in% classes)) classes <- .ux
                  } else classes <- unique(x)
                }
              } else {
                .ux <- unique(x)
                if (is.character(classes)) .ux <- as.character(.ux)
                if (!all(.ux %in% classes)) stop('the specified "classes" does not cover all or some of values in the input raster!')
              }
              nc <- length(classes)
            }
            #-----
            if (categorical) {
              if (missing(dif)) {
                dif <- rep(1,nc*nc)
                for (i in 1:nc) dif[(i-1)*nc+i] <-0
              } else {
                dif <- .checkDif(dif,classes)
              }
            }
            #-----
            
            if (!categorical) x <- categorize(x,nc)
            if (missing(null)) {
              null <- rep(NA,length(x))
              null[!is.na(x)] <- sample(classes,length(x[!is.na(x)]),replace=TRUE)
            } else if (class(null) %in% c('numeric','integer')) {
              if (!length(null) == length(x)) {
                warning('null is a numeric vector with a different length; so, the null is generated given the default settings!')
                null <- rep(NA,length(x))
                null[!is.na(x)] <- sample(classes,length(x[!is.na(x)]),replace=TRUE)
              }
            } else {
              warning('null is not a numeric vector, so, the null is generated given the default settings!')
              null <- rep(NA,length(x))
              null[!is.na(x)] <- sample(classes,length(x[!is.na(x)]),replace=TRUE)
            }
            
            if (categorical) {
              xx@data$elsa <- .Call('v_elsac_vector', x, d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa')
              xx@data$p_value <- .Call('elsac_vector_test', x,null, d,  as.integer(nc), as.integer(classes), dif, as.integer(method),as.integer(n), PACKAGE='elsa')
            } else {
              xx@data$elsa <- .Call('v_elsa_vector', x, d, as.integer(nc), PACKAGE='elsa')
              xx@data$p_value <- .Call('elsa_vector_test', x,null, d,  as.integer(nc), as.integer(method),as.integer(n), PACKAGE='elsa')
            }
            
          }
)


#--------------
._elsa.testR <- function(x, d, n=99, nc, categorical, dif,classes,cells,filename,verbose=TRUE,...) {
  if (missing(classes)) classes <- NULL
  if (missing(filename)) filename <- ''
  if (missing(n)) n <- 99
  if (missing(verbose)) verbose <- TRUE
  
  if (!missing(nc)) {
    if (missing(categorical)) {
      if (missing(dif)) categorical <- FALSE
      else {
        categorical <- TRUE
        if (verbose) cat("input data is considered categorical, and nc is ignored!\n")
      }
    }
  } else {
    if (missing(categorical) && !missing(dif)) categorical <- TRUE
  }
  #----
  if (missing(categorical) || !is.logical(categorical)) {
    # guessing whether the layer is categorical:
    if (.is.categorical(x)) {
      categorical <- TRUE
      if (verbose) cat("the input is considered as a categorical variable...\n")
    } else {
      categorical <- FALSE
      if (verbose) cat("the input is considered as a continuous variable...\n")
    }
  }
  #----
  if (!categorical) {
    if (missing(nc)) nc <- nclass(x)
    classes <- 1:nc
  } else if (categorical) {
    if (is.null(classes) || is.na(classes)) {
      if (missing(dif) || is.null(classes) || is.na(classes) ) {
        classes <- unique(x)
      } else {
        if (length(names(dif)) > 1) {
          classes <- names(dif)
          .ux <- as.character(unique(x))
          if (!all(.ux %in% classes)) classes <- .ux
        } else classes <- unique(x)
      }
    } else {
      .ux <- unique(x)
      if (is.character(classes)) .ux <- as.character(.ux)
      if (!all(.ux %in% classes)) stop('the specified "classes" does not cover all or some of values in the input raster!')
    }
    nc <- length(classes)
  }
  #-----
  
  if (categorical) {
    if (missing(dif)) {
      dif <- rep(1,nc*nc)
      for (i in 1:nc) dif[(i-1)*nc+i] <-0
    } else {
      dif <- .checkDif(dif,classes)
    }
  }
  
  nNA <- which(!is.na(x[]))
  null <- calc(x,function(x) { x[!is.na(x)] <- sample(classes,length(x[!is.na(x)]),replace=TRUE); x})
  null <- null[nNA]
  if (missing(cells)) {
    e1 <- elsa(x,d=d,nc=nc,categorical=categorical,dif=dif)
    o2 <- x
    #o2 <- calc(o2,function(x) { x[!is.na(x)] <- 0; x})
    o2[nNA] <- 0
    o1 <- raster(x)
    for (i in 1:n) {
      #o1 <- calc(x,function(x) { x[!is.na(x)] <- sample(null,length(x[!is.na(x)]),replace=TRUE); x})
      o1[nNA] <- sample(null,length(null),replace=TRUE)
      e2 <- elsa(o1,d=d,nc=nc,categorical=categorical,dif=dif)
      ee <- e1 - e2
      ee <- calc(ee,function(x) {x[x > 0] <- 1; x[x <= 0] = 0; x})
      o2 <- o2 + ee
    }
    rm(e1,e2,ee,o1)
    o2 <- (o2+1) / (n+1)
    
    filename <- trim(filename)
    if (filename != '') writeRaster(o2,filename,...)
  } else {
    e1 <- elsa(x,d=d,nc=nc,categorical=categorical,dif=dif,cells=cells)
    o2 <- rep(0,length(cells))
    for (i in 1:n) {
      o1[nNA] <- sample(null,length(null),replace=TRUE)
      #o1 <- calc(x,function(x) { x[!is.na(x)] <- sample(classes,length(x[!is.na(x)]),replace=TRUE); x})
      e2 <- elsa(o1,d=d,nc=nc,categorical=categorical,dif=dif,cells=cells)
      ee <- e1 - e2
      ee <- ifelse(ee > 0,1,0)
      o2 <- o2 + ee
    }
    rm(e1,e2,ee,o1)
    o2 <- (o2+1) / (n+1)
  }
  o2
}


# Author: Babak Naimi, naimi.b@gmail.com
# Date :  March 2019
# last update: April 2019
# Version 1.3
# Licence GPL v3 
#------------------

# low-level functions to be used within the other functions

.elsaContinousVector <- function(x,d,nc,ncl,nrw,res) {
  w <-.Filter(r=res[1],d1=0,d2=d)
  fdim <- w[[1]]
  w <- w[[2]]
  
  .Call('v_elsa', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa') 
}
#------
.elsaContinousVectorCell <- function(x,d,nc,ncl,nrw,res,cells) {
  w <-.Filter(r=res[1],d1=0,d2=d)
  fdim <- w[[1]]
  w <- w[[2]]
  .Call('v_elsa_cell', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells), PACKAGE='elsa')
}

###########################

.elsaEcEaContinousVector <- function(x,d,nc,ncl,nrw,res) {
  w <-.Filter(r=res[1],d1=0,d2=d)
  fdim <- w[[1]]
  w <- w[[2]]
  
  xx <- .Call('elsa', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
  names(xx) <- c('Ec','Ea')
  return(xx)
}
#---------
.elsaEcEaContinousVectorCells <- function(x,d,nc,ncl,nrw,res,cells) {
  w <-.Filter(r=res[1],d1=0,d2=d)
  fdim <- w[[1]]
  w <- w[[2]]
  
  xx <- .Call('elsa_cell', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells), PACKAGE='elsa')
  names(xx) <- c('Ec','Ea')
  return(xx)
}
#########################

.elsaCategoricalVector <- function(x,d,dif,classes,ncl,nrw,res) {
  #classes <- unique(x)
  #classes <- classes[!is.na(classes)]
  
  nc <- length(classes)
  
  if (missing(dif)) {
    dif <- rep(1,nc*nc)
    for (i in 1:nc) dif[(i-1)*nc+i] <-0
  } else {
    dif <- .checkDif(dif,classes)
  }
  #-----
  w <-.Filter(r=res[1],d1=0,d2=d)
  
  fdim <- w[[1]]
  w <- w[[2]]
  
  .Call('v_elsac', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
}
#-----

.elsaCategoricalVectorCell <- function(x,d,dif,classes,ncl,nrw,res,cells) {
  #if (missing(d)) d <- res[1]
  #----
  # classes <- unique(x)
  # classes <- classes[!is.na(classes)]
   
  nc <- length(classes)
  
  if (missing(dif)) {
    dif <- rep(1,nc*nc)
    for (i in 1:nc) dif[(i-1)*nc+i] <-0
  } else {
    dif <- .checkDif(dif,classes)
  }
  #-----
  w <-.Filter(r=res[1],d1=0,d2=d)
  
  fdim <- w[[1]]
  w <- w[[2]]
  
  .Call('v_elsac_cell', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
}
#---------
.elsaEcEaCategoricalVector <- function(x,d,dif,classes,ncl,nrw,res) {
  # classes <- unique(x)
  # classes <- classes[!is.na(classes)]
  
  nc <- length(classes)
  
  if (missing(dif)) {
    dif <- rep(1,nc*nc)
    for (i in 1:nc) dif[(i-1)*nc+i] <-0
  } else {
    dif <- .checkDif(dif,classes)
  }
  #-----
  w <-.Filter(r=res[1],d1=0,d2=d)
  
  fdim <- w[[1]]
  w <- w[[2]]
  xx <- .Call('elsac', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
  names(xx) <- c('Ec','Ea')
  return(xx)
}
#-----

.elsaEcEaCategoricalVectorCell <- function(x,d,dif,classes,ncl,nrw,res,cells) {
  #if (missing(d)) d <- res[1]
  #----
  # classes <- unique(x)
  # classes <- classes[!is.na(classes)]
  
  nc <- length(classes)
  
  if (missing(dif)) {
    dif <- rep(1,nc*nc)
    for (i in 1:nc) dif[(i-1)*nc+i] <-0
  } else {
    dif <- .checkDif(dif,classes)
  }
  #-----
  w <-.Filter(r=res[1],d1=0,d2=d)
  
  fdim <- w[[1]]
  w <- w[[2]]
  
  xx <- .Call('elsac_cell', x[], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
  names(xx) <- c('Ec','Ea')
  return(xx)
}

# Author: Babak Naimi, naimi.b@gmail.com
# Date :  August 2016
# last update: February 2020
# Version 2.3
# Licence GPL v3 

.checkrasterMemory <- function(cells,n=1) {
  cells <- ceiling(sqrt(cells))
  canProcessInMemory(raster(nrows=cells, ncols=cells, xmn=0, xmx=cells,vals=NULL),n)
}

if (!isGeneric("entrogram")) {
  setGeneric("entrogram", function(x, width, cutoff,...)
    standardGeneric("entrogram"))
}


setMethod('entrogram', signature(x='RasterLayer'), 
          function(x, width, cutoff, categorical, nc, dif, cloud=FALSE, s=NULL,stat,verbose=TRUE,...) {
            re <- res(x)[1]
            
            if (missing(verbose)) verbose <- TRUE
            
            if (missing(stat)) stat <- 'ELSA'
            else {
              stat <- toupper(stat)
              if (!stat %in% c('ELSA','EA','EC')) stop('stat should be either of "ELSA", "Ea", "Ec"!')
            }
            
            if (missing(cutoff)) cutoff<- sqrt((xmin(x)-xmax(x))^2+(ymin(x)-ymax(x))^2) / 3
            if (missing(width)) width <- re
            else if (width < re) width <- re
            if (cutoff < width) stop("cutoff should be greater than width size")
            nlag <- ceiling(cutoff / width)
            
            n <- ncell(x) - cellStats(x,'countNA')
            #---
            if (is.null(s)) {
              if (!.checkrasterMemory(n,nlag)) {
                s <- c()
                for (i in (nlag-1):1) s <- c(s,.checkrasterMemory(n,i))
                s <- which(s)
                if (length(s) > 0) {
                  s <- (nlag - s[1]) / (2*nlag)
                  s <- ceiling(n * s)
                  s <- sampleRandom(x,s,cells=TRUE)[,1]
                } else {
                  s <- 1 / (2 * nlag)
                  s <- ceiling(n * s)
                  while (!.checkrasterMemory(s,1)) s <- ceiling(s / 2)
                  s <- sampleRandom(x,s,cells=TRUE)[,1]
                }
              } else {
                s <- (1:ncell(x))[which(!is.na(x[]))]
              }
            } else {
              if (!is.numeric(s)) stop("s argument should be an integer number or NULL!")
              while (!.checkrasterMemory(s[1],1)) s <- ceiling(s[1] * 0.8)
              if (s > n) s <- n
              s <- sampleRandom(x,s,cells=TRUE)[,1]
            }
            #######---------------
            #----
            if (!missing(nc)) {
              if (missing(categorical)) {
                if (missing(dif)) categorical <- FALSE
                else {
                  categorical <- TRUE
                  if (verbose) cat("input data is considered categorical, and nc is ignored!\n")
                }
              }
            } else {
              if (missing(categorical) && !missing(dif)) categorical <- TRUE
            }
            #----
            if (missing(categorical) || !is.logical(categorical)) {
              # guessing whether the layer is categorical:
              if (.is.categorical(x)) {
                categorical <- TRUE
                if (verbose) cat("the input is considered as a categorical variable...\n")
              } else {
                categorical <- FALSE
                if (verbose) cat("the input is considered as a continuous variable...\n")
              }
            }
            #----
            if (!categorical && missing(nc)) {
              nc <- nclass(x)
            } else if (categorical) {
              classes <- unique(x)
              nc <- length(classes)
            }
            #-----
            
            if (categorical) {
              if (missing(dif)) {
                dif <- rep(1,nc*nc)
                for (i in 1:nc) dif[(i-1)*nc+i] <-0
              } else {
                dif <- .checkDif(dif,classes)
              }
            }
            #-----
            #######---------------------
            
            if (!categorical) x <- categorize(x,nc)
            
            ncl <- ncol(x)
            nrw <- nrow(x)
            
            out <- new("Entrogram")
            out@width <- width
            out@cutoff <- cutoff
            if (cloud) {
              out@entrogramCloud <- matrix(NA,nrow=length(s),ncol=nlag)
              for (i in 1:nlag) {
                w <-.Filter(r=res(x)[1],d1=0,d2=i*width)
                w <- w[[2]]
                if (categorical) {
                  if (is.null(stat) ||  stat == 'ELSA') out@entrogramCloud[,i] <- .Call('v_elsac_cell', as.integer(x[]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(s), PACKAGE='elsa')
                  else if (stat == 'EA') out@entrogramCloud[,i] <- .Call('v_elsac_cell_Ea', as.integer(x[]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(s), PACKAGE='elsa')
                  else if (stat == 'EC') out@entrogramCloud[,i] <- .Call('v_elsac_cell_Ec', as.integer(x[]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(s), PACKAGE='elsa')
                } else {
                  if (is.null(stat) ||  stat == 'ELSA') out@entrogramCloud[,i] <- .Call('v_elsa_cell', as.integer(x[]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(s), PACKAGE='elsa')
                  else if (stat == 'EA') out@entrogramCloud[,i] <- .Call('v_elsa_cell_Ea', as.integer(x[]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(s), PACKAGE='elsa')
                  else if (stat == 'EC') out@entrogramCloud[,i] <- .Call('v_elsa_cell_Ec', as.integer(x[]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(s), PACKAGE='elsa')
                }
                #out@entrogramCloud[,i] <- elsa(x,d=i*width,nc=nc,categorical=categorical,dif=dif,cells=s)
              }
              out@entrogram <- data.frame(distance=seq(width,width*nlag,width) - (width/2),E=apply(out@entrogramCloud,2,mean,na.rm=TRUE))
            } else {
              d <- seq(width,width*nlag,width) - (width/2)
              out@entrogram <- data.frame(distance=d,E=rep(NA,length(d)))
              for (i in 1:nlag) {
                w <-.Filter(r=res(x)[1],d1=0,d2=i*width)[[2]]
                if (categorical) {
                  if (is.null(stat) ||  stat == 'ELSA') out@entrogram [i,2] <- mean(.Call('v_elsac_cell', as.integer(x[]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(s), PACKAGE='elsa'),na.rm=TRUE)
                  else if (stat == 'EA') out@entrogram [i,2] <- mean(.Call('v_elsac_cell_Ea', as.integer(x[]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(s), PACKAGE='elsa'),na.rm=TRUE)
                  else if (stat == 'EC') out@entrogram [i,2] <- mean(.Call('v_elsac_cell_Ec', as.integer(x[]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(s), PACKAGE='elsa'),na.rm=TRUE)
                } else {
                  if (is.null(stat) ||  stat == 'ELSA') out@entrogram [i,2] <- mean(.Call('v_elsa_cell', as.integer(x[]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(s), PACKAGE='elsa'),na.rm=TRUE)
                  else if (stat == 'EA') out@entrogram [i,2] <- mean(.Call('v_elsa_cell_Ea', as.integer(x[]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(s), PACKAGE='elsa'),na.rm=TRUE)
                  else if (stat == 'EC') out@entrogram [i,2] <- mean(.Call('v_elsa_cell_Ec', as.integer(x[]), as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(s), PACKAGE='elsa'),na.rm=TRUE)
                }
                #out@entrogram [i,2] <- mean(elsa(x,d=i*width,nc=nc,categorical=categorical,dif=dif,cells=s),na.rm=TRUE)
              }
            }
            out
          }
)
##########

#-------
setMethod('entrogram', signature(x='SpatialPolygonsDataFrame'), 
          function(x, width, cutoff, categorical, nc, dif, zcol,  cloud=FALSE, s=NULL,method,longlat,stat,verbose=TRUE,...) {
            n <- nrow(x)
            
            if (missing(verbose)) verbose <- TRUE
            
            if (missing(longlat)) longlat <- NULL
            
            if (missing(stat)) stat <- 'ELSA'
            else {
              stat <- toupper(stat)
              if (!stat %in% c('ELSA','EA','EC')) stop('stat should be either of "ELSA", "Ea", "Ec"!')
            }
            
            if (missing(cutoff)) cutoff<- sqrt((xmin(x)-xmax(x))^2+(ymin(x)-ymax(x))^2) / 3
            if (missing(width)) width <- cutoff / 15
            
            if (cutoff < width) stop("cutoff should be greater than width size")
            
            nlag <- ceiling(cutoff / width)
            
            if (missing(zcol)) {
              if (ncol(x@data) > 1) stop("zcol should be specified!")
              else zcol <- 1
            } else if (is.character(zcol)) {
              w <- which(colnames(x@data) == zcol[1])
              if (w == 0) stop('the specified variable in zcol does not exist in the data')
              zcol <- w
            } else if (is.numeric(zcol)) {
              zcol <- zcol[1]
              if (zcol > ncol(x@data)) stop('the zcol number is greater than the number of columns in data!')
            } else stop("zcol should be a character or a number!")
            
            if (missing(method)) method <- 'centroid'
            else {
              if (tolower(method)[1] %in% c('bnd','bound','boundary','bond','b')) method <- 'bound'
              else method <- 'centroid'
            }
            
            if (method == 'centroid') xy <- coordinates(x)
            else xy <- x
            
            x <- x@data[,zcol]
            #---
            if (!is.null(s) && is.numeric(s) && s < n) {
              x <- x[sample(n,s)]
              n <- length(n)
            } 
            #######---------------
            #----
            if (!missing(nc)) {
              if (missing(categorical)) {
                if (missing(dif)) categorical <- FALSE
                else {
                  categorical <- TRUE
                  if (verbose) cat("input data is considered categorical, and nc is ignored!\n")
                }
              }
            } else {
              if (missing(categorical) && !missing(dif)) categorical <- TRUE
            }
            #----
            if (missing(categorical) || !is.logical(categorical)) {
              # guessing whether the layer is categorical:
              if (.is.categorical(x)) {
                categorical <- TRUE
                if (verbose) cat("the input is considered as a categorical variable...\n")
              } else {
                categorical <- FALSE
                if (verbose) cat("the input is considered as a continuous variable...\n")
              }
            }
            #----
            if (!categorical && missing(nc)) {
              nc <- nclass(x)
              classes <- 1:nc
            } else if (categorical) {
              classes <- unique(x)
              nc <- length(classes)
            }
            #-----
            
            if (categorical) {
              if (missing(dif)) {
                dif <- rep(1,nc*nc)
                for (i in 1:nc) dif[(i-1)*nc+i] <-0
              } else {
                dif <- .checkDif(dif,classes)
              }
            }
            #-----
            if (!categorical) x <- categorize(x,nc)
            #######---------------------
            out <- new("Entrogram")
            out@width <- width
            out@cutoff <- cutoff
            if (cloud) {
              out@entrogramCloud <- matrix(NA,nrow=n,ncol=nlag)
              for (i in 1:nlag) {
                d <- dneigh(xy,d1=0,d2=i*width,method = method,longlat = longlat)@neighbours
                if (categorical) {
                  if (is.null(stat) ||  stat == 'ELSA') out@entrogramCloud[,i] <- .Call('v_elsac_vector', as.integer(x), d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa')
                  else if (stat == 'EA') out@entrogramCloud[,i] <- .Call('v_elsac_vector_Ea', as.integer(x), d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa')
                  else if (stat == 'EC') out@entrogramCloud[,i] <- .Call('v_elsac_vector_Ec', as.integer(x), d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa')
                } else {
                  if (is.null(stat) ||  stat == 'ELSA') out@entrogramCloud[,i] <-.Call('v_elsa_vector', as.integer(x), d, as.integer(nc), PACKAGE='elsa')
                  else if (stat == 'EA') out@entrogramCloud[,i] <-.Call('v_elsa_vector_Ea', as.integer(x), d, as.integer(nc), PACKAGE='elsa') 
                  else if (stat == 'EC') out@entrogramCloud[,i] <-.Call('v_elsa_vector_Ec', as.integer(x), d, as.integer(nc), PACKAGE='elsa') 
                }
              }
              out@entrogram <- data.frame(distance=seq(width,width*nlag,width) - (width/2),E=apply(out@entrogramCloud,2,mean,na.rm=TRUE))
            } else {
              d <- seq(width,width*nlag,width) - (width/2)
              out@entrogram <- data.frame(distance=d,E=rep(NA,length(d)))
              for (i in 1:nlag) {
                d <- dneigh(xy,d1=0,d2=i*width,method = method,longlat = longlat)@neighbours
                if (categorical) {
                  if (is.null(stat) ||  stat == 'ELSA') out@entrogram [i,2] <- mean(.Call('v_elsac_vector', as.integer(x), d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa'),na.rm=TRUE)
                  else if (stat == 'EA')  out@entrogram [i,2] <- mean(.Call('v_elsac_vector_Ea', as.integer(x), d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa'),na.rm=TRUE)
                  else if (stat == 'EC')  out@entrogram [i,2] <- mean(.Call('v_elsac_vector_Ec', as.integer(x), d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa'),na.rm=TRUE)
                } else {
                  if (is.null(stat) ||  stat == 'ELSA') out@entrogram [i,2] <- mean(.Call('v_elsa_vector', as.integer(x), d, as.integer(nc), PACKAGE='elsa'),na.rm=TRUE)
                  else if (stat == 'EA')   out@entrogram [i,2] <- mean(.Call('v_elsa_vector_Ea', as.integer(x), d, as.integer(nc), PACKAGE='elsa'),na.rm=TRUE)
                  else if (stat == 'EC')   out@entrogram [i,2] <- mean(.Call('v_elsa_vector_Ec', as.integer(x), d, as.integer(nc), PACKAGE='elsa'),na.rm=TRUE)
                }
              }
            }
            out
          }
)



setMethod('entrogram', signature(x='SpatialPointsDataFrame'), 
          function(x, width, cutoff, categorical, nc, dif, zcol,  cloud=FALSE, s=NULL,longlat,stat,verbose=TRUE,...) {
            n <- nrow(x)
            
            if (missing(verbose)) verbose <- TRUE
            
            if (missing(stat)) stat <- 'ELSA'
            else {
              stat <- toupper(stat)
              if (!stat %in% c('ELSA','EA','EC')) stop('stat should be either of "ELSA", "Ea", "Ec"!')
            }
            if (missing(longlat)) longlat <- NULL
            
            if (missing(cutoff)) cutoff<- sqrt((xmin(x)-xmax(x))^2+(ymin(x)-ymax(x))^2) / 3
            if (missing(width)) width <- cutoff / 15
            
            if (cutoff < width) stop("cutoff should be greater than width size")
            
            nlag <- ceiling(cutoff / width)
            
            if (missing(zcol)) {
              if (ncol(x@data) > 1) stop("zcol should be specified!")
              else zcol <- 1
            } else if (is.character(zcol)) {
              w <- which(colnames(x@data) == zcol[1])
              if (w == 0) stop('the specified variable in zcol does not exist in the data')
              zcol <- w
            } else if (is.numeric(zcol)) {
              zcol <- zcol[1]
              if (zcol > ncol(x@data)) stop('the zcol number is greater than the number of columns in data!')
            } else stop("zcol should be a character or a number!")
            
            xy <- coordinates(x)
            x <- x@data[,zcol]
            #---
            if (!is.null(s) && is.numeric(s) && s < n) {
              x <- x[sample(n,s)]
              n <- length(n)
            } 
            #######---------------
            #----
            if (!missing(nc)) {
              if (missing(categorical)) {
                if (missing(dif)) categorical <- FALSE
                else {
                  categorical <- TRUE
                  if (verbose) cat("input data is considered categorical, and nc is ignored!\n")
                }
              }
            } else {
              if (missing(categorical) && !missing(dif)) categorical <- TRUE
            }
            #----
            if (missing(categorical) || !is.logical(categorical)) {
              # guessing whether the layer is categorical:
              if (.is.categorical(x)) {
                categorical <- TRUE
                if (verbose) cat("the input is considered as a categorical variable...\n")
              } else {
                categorical <- FALSE
                if (verbose) cat("the input is considered as a continuous variable...\n")
              }
            }
            #----
            if (!categorical && missing(nc)) {
              nc <- nclass(x)
              classes <- 1:nc
            } else if (categorical) {
              classes <- unique(x)
              nc <- length(classes)
            }
            #-----
            
            if (categorical) {
              if (missing(dif)) {
                dif <- rep(1,nc*nc)
                for (i in 1:nc) dif[(i-1)*nc+i] <-0
              } else {
                dif <- .checkDif(dif,classes)
              }
            }
            #-----
            if (!categorical) x <- categorize(x,nc)
            #######---------------------
            out <- new("Entrogram")
            out@width <- width
            out@cutoff <- cutoff
            if (cloud) {
              out@entrogramCloud <- matrix(NA,nrow=n,ncol=nlag)
              for (i in 1:nlag) {
                d <- dneigh(xy,d1=0,d2=i*width,longlat = longlat)@neighbours
                if (categorical) {
                  if (is.null(stat) ||  stat == 'ELSA') out@entrogramCloud[,i] <- .Call('v_elsac_vector', as.integer(x), d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa')
                  else if (stat == 'EA') out@entrogramCloud[,i] <- .Call('v_elsac_vector_Ea', as.integer(x), d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa')
                  else if (stat == 'EC') out@entrogramCloud[,i] <- .Call('v_elsac_vector_Ec', as.integer(x), d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa')
                } else {
                  if (is.null(stat) ||  stat == 'ELSA') out@entrogramCloud[,i] <-.Call('v_elsa_vector', as.integer(x), d, as.integer(nc))
                  else if (stat == 'EA') out@entrogramCloud[,i] <-.Call('v_elsa_vector_Ea', as.integer(x), d, as.integer(nc)) 
                  else if (stat == 'EC') out@entrogramCloud[,i] <-.Call('v_elsa_vector_Ec', as.integer(x), d, as.integer(nc)) 
                }
              }
              out@entrogram <- data.frame(distance=seq(width,width*nlag,width) - (width/2),E=apply(out@entrogramCloud,2,mean,na.rm=TRUE))
            } else {
              d <- seq(width,width*nlag,width) - (width/2)
              out@entrogram <- data.frame(distance=d,E=rep(NA,length(d)))
              for (i in 1:nlag) {
                d <- dneigh(xy,d1=0,d2=i*width,longlat = longlat)@neighbours
                if (categorical) {
                  if (is.null(stat) ||  stat == 'ELSA') out@entrogram [i,2] <- mean(.Call('v_elsac_vector', as.integer(x), d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa'),na.rm=TRUE)
                  else if (stat == 'EA')  out@entrogram [i,2] <- mean(.Call('v_elsac_vector_Ea', as.integer(x), d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa'),na.rm=TRUE)
                  else if (stat == 'EC')  out@entrogram [i,2] <- mean(.Call('v_elsac_vector_Ec', as.integer(x), d, as.integer(nc), as.integer(classes),dif, PACKAGE='elsa'),na.rm=TRUE)
                } else {
                  if (is.null(stat) ||  stat == 'ELSA') out@entrogram [i,2] <- mean(.Call('v_elsa_vector', as.integer(x), d, as.integer(nc), PACKAGE='elsa'),na.rm=TRUE)
                  else if (stat == 'EA')   out@entrogram [i,2] <- mean(.Call('v_elsa_vector_Ea', as.integer(x), d, as.integer(nc), PACKAGE='elsa'),na.rm=TRUE)
                  else if (stat == 'EC')   out@entrogram [i,2] <- mean(.Call('v_elsa_vector_Ec', as.integer(x), d, as.integer(nc), PACKAGE='elsa'),na.rm=TRUE)
                }
              }
            }
            out
          }
)


# Author: Babak Naimi, naimi.b@gmail.com
# Date :  August 2016
# Version 1.1
# Licence GPL v3 

#----------
if (!isGeneric("lisa")) {
  setGeneric("lisa", function(x,d1,d2,statistic,...)
    standardGeneric("lisa"))
}


setMethod('lisa', signature(x='RasterLayer'), 
          function(x,d1=0,d2,statistic,mi,filename,...) {
            if (missing(statistic)) stop('statistic should be specified')
            if (length(statistic) > 1) {
              statistic <- statistic[1]
              warning('only first item in statistic is considered!')
            }
            if (missing(mi) || !tolower(mi) %in% c('i','ii','i.i','z','zi','z.i')) mi <- NULL
            else {
              if (tolower(mi) %in% c('i','ii','i.i')) mi <- 1
              else mi <- 2
            }
            
            if (!tolower(statistic) %in% c("i","c","g","g*",'localmoran','moran','localgeary','geary','localg','localg*')) stop("statistic should be one of: I (or localmoran), G, G*, and C (or LocalGeary)")
            if (missing(d2)) d2 <- res(x)[1]
            if (missing(d1)) d1 <- 0
            if (missing(filename)) filename=''
            #-----
            w <-.Filter(r=res(x)[1],d1=d1,d2=d2)
            fdim <- w[[1]]
            w <- w[[2]]
            
            if (fdim < 3) stop("d must be at least equal to the input raster resolution!")
            
            out <- raster(x)
            ncl <- ncol(out)
            nrw <- nrow(out)
            filename=trim(filename)
            
            if (canProcessInMemory(out)) {
              if (tolower(statistic) %in% c("i",'localmoran','moran')) {
                v <- .Call('localmoran', x[], as.integer(ncl), as.integer(nrw),as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                if (is.null(mi)) out[] <- v[[2]]
                else out[] <- v[[mi]]
              } else if (tolower(statistic) %in% c("c",'localgeary')) out[] <- .Call('localgeary', x[], as.integer(ncl), as.integer(nrw), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
              else if (tolower(statistic) %in% c("g",'localg',"g*",'localg*')) {
                v <- .Call('GG', x[], as.integer(ncl), as.integer(nrw), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                if (tolower(statistic) %in% c("g",'localg')) out[] <- v[[1]]
                else out[] <- v[[2]]
              }
              if (filename != '') out <- writeRaster(out, filename, ...)
            } else {
              tr <- blockSize(out, minblocks=3, minrows=fdim)
              
              if (tolower(statistic) %in% c("i",'localmoran','moran')) pb <- pbCreate(tr$n, label='LocalMoran',...)
              else if (tolower(statistic) %in% c("c",'localgeary')) pb <- pbCreate(tr$n, label='LocalGeary',...)
              else if (tolower(statistic) %in% c("g",'localg')) pb <- pbCreate(tr$n, label='LocalG',...)
              else if (tolower(statistic) %in% c("g*",'localg*')) pb <- pbCreate(tr$n, label='LocalG*',...)
              addr <- floor(fdim / 2)
              
              out <- writeStart(out, filename)
              v <- getValues(x, row=1, nrows=tr$nrows[1]+addr)
              
              if (tolower(statistic) %in% c("i",'localmoran','moran')) {
                v <- .Call('localmoran', x[], as.integer(ncl), as.integer(nrw),as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                if (is.null(mi)) v <- v[[2]]
                else v <- v[[mi]]
              } else if (tolower(statistic) %in% c("c",'localgeary')) v <- .Call('localgeary', v, as.integer(ncl), as.integer(nrw), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
              else if (tolower(statistic) %in% c("g",'localg',"g*",'localg*')) {
                v <- .Call('GG', v, as.integer(ncl), as.integer(nrw), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                if (tolower(statistic) %in% c("g",'localg')) v <- v[[1]]
                else v <- v[[2]]
              }
              ex <- length(v) - (addr * ncl)
              out <- writeValues(out, v[1:ex], 1)
              
              for (i in 2:(tr$n-1)) {
                v <- getValues(x, row=tr$row[i]-addr, nrows=tr$nrows[i]+(2*addr))
                
                if (tolower(statistic) %in% c("i",'localmoran','moran')) {
                  v <- .Call('localmoran', x[], as.integer(ncl), as.integer(nrw),as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                  if (is.null(mi)) v <- v[[2]]
                  else v <- v[[mi]]
                } else if (tolower(statistic) %in% c("c",'localgeary')) v <- .Call('localgeary', v, as.integer(ncl), as.integer(nrw), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                else if (tolower(statistic) %in% c("g",'localg',"g*",'localg*')) {
                  v <- .Call('GG', v, as.integer(ncl), as.integer(nrw), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                  if (tolower(statistic) %in% c("g",'localg')) v <- v[[1]]
                  else v <- v[[2]]
                }
                
                st <- (addr * ncl)+1
                ex <- length(v) - (addr * ncl)
                out <- writeValues(out, v[st:ex], tr$row[i])
                pbStep(pb)
              }
              i <- tr$n
              v <- getValues(x, row=tr$row[i]-addr, nrows=tr$nrows[i]+addr)
              
              if (tolower(statistic) %in% c("i",'localmoran','moran')) {
                v <- .Call('localmoran', x[], as.integer(ncl), as.integer(nrw),as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                if (is.null(mi)) v <- v[[2]]
                else v <- v[[mi]]
              } else if (tolower(statistic) %in% c("c",'localgeary')) v <- .Call('localgeary', v, as.integer(ncl), as.integer(nrw), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
              else if (tolower(statistic) %in% c("g",'localg',"g*",'localg*')) {
                v <- .Call('GG', v, as.integer(ncl), as.integer(nrw), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                if (tolower(statistic) %in% c("g",'localg')) v <- v[[1]]
                else v <- v[[2]]
              }
              
              st <- (addr * ncl)+1
              ex <- length(v)
              out <- writeValues(out, v[st:ex], tr$row[i])
              pbStep(pb)
              out <- writeStop(out)
              pbClose(pb)
            }
            return(out)
          }
)
#---------

setMethod('lisa', signature(x='Spatial'), 
          function(x,d1,d2,statistic,zcol,longlat,drop,...) {
            
            if (!class(x) %in% c('SpatialPolygonsDataFrame','SpatialPointsDataFrame')) stop('x can only be either of RasterLayer, SpatialPointsDataFrame, SpatialPolygonsDataFrame')
            
            if (missing(statistic)) stop('statistic should be specified')
            if (length(statistic) > 1) {
              statistic <- statistic[1]
              warning('only first item in statistic is considered!')
            }
            
            if (missing(drop) || !is.logical(drop[1])) drop <- FALSE
            else drop <- drop[1]
            
            if (!tolower(statistic) %in% c("i","c","g","g*",'localmoran','moran','localgeary','geary','localg','localg*')) stop("statistic should be one of: I (or localmoran), G, G*, and C (or LocalGeary)")
            if (missing(d1)) d1 <- 0
            if (missing(d2) && !inherits(d1,'neighbours')) stop('d2 should be specified, or put an object created by dneigh in d1')
            if (missing(longlat)) longlat <- NULL
            
            if (!inherits(d1,'neighbours')) d <- dneigh(x, d1, d2,longlat = longlat)@neighbours
            else d <- d1@neighbours
            
            if (missing(zcol)) {
              if (ncol(x@data) > 1) stop("zcol should be specified!")
              else zcol <- 1
            } else if (is.character(zcol)) {
              w <- which(colnames(x@data) == zcol[1])
              if (w == 0) stop('the specified variable in zcol does not exist in the data')
              zcol <- w
            } else if (is.numeric(zcol)) {
              zcol <- zcol[1]
              if (zcol > ncol(x@data)) stop('the zcol number is greater than the number of columns in data!')
            } else stop("zcol should be a character or a number!")
            
            xx <- x
            x <- x@data[,zcol]
            if (is.factor(x) || is.character(x)) stop('lisa statistics only apply on numerical variables')
            
            if (tolower(statistic) %in% c("i",'localmoran','moran')) {
              x <- .Call('localmoran_vector', x, d, PACKAGE='elsa')
              n <- 'LocalMoran'
            } else if (tolower(statistic) %in% c("c",'localgeary')) {
              x <- .Call('localgeary_vector', x, d, PACKAGE='elsa')
              n <- 'LocalGeray'
            }
            else if (tolower(statistic) %in% c("g",'localg',"g*",'localg*')) {
              x <- .Call('GG_vector', x, d, PACKAGE='elsa')
              if (tolower(statistic) %in% c("g",'localg')) {
                x <- x[[1]]
                n <- 'LocalG'
              }
              else {
                x <- x[[2]]
                n <- 'LocalG*'
              }
            }
            
            if (!drop) {
              if (tolower(statistic) %in% c("i",'localmoran','moran')) {
                xx@data$Ii <- x[[1]]
                xx@data$Z.Ii <- x[[2]]
                xx@data <- xx@data[,c('Ii','Z.Ii')]
              } else {
                xx@data$lisa <- x
                xx@data <- xx@data[,'lisa',drop=FALSE]
                colnames(xx@data) <- n
              }
              xx
            } else {
              if (tolower(statistic) %in% c("i",'localmoran','moran')) x[[2]]
              else x
            }
            
          }
)  


# Author: Babak Naimi, naimi.b@gmail.com
# Date :  May 2018
# last update: March 2019
# Version 1.1
# Licence GPL v3 

#These statistics are under development!


if (!isGeneric("melsa")) {
  setGeneric("melsa", function(x,d,nc,categorical,dif,classes,stat,...)
    standardGeneric("melsa"))
}



setMethod('melsa', signature(x='SpatRaster'), 
          function(x,d,nc,categorical,dif,classes,stat,cells,filename,verbose=TRUE,...) {
            if (missing(classes)) classes <- NULL
            
            if (missing(verbose)) verbose <- TRUE
            
            if (missing(stat) || is.null(stat)) stat <- 'elsa'
            else {
              stat <- tolower(stat)
              if (length(stat) == 1) {
                if (!stat %in% c('elsa','ec','ea')) {
                  stat <- 'elsa'
                  warning('stat should be either of "ELSA", "Ec", "Ea"; the default "ELSA" is considered!')
                }
              } else {
                if (!all(tolower(stat) %in% c('elsa','ec','ea'))) stop('stat should be selected from "ELSA", "Ea", "Ec"')
              }
            }
            #----
            if (missing(d)) d <- res(x)[1] * sqrt(2)
            
            if (missing(filename)) filename <- ''
            
            if (!missing(nc) && !is.null(nc) && !is.na(nc)) {
              if (missing(categorical)) {
                if (missing(dif) && is.null(classes)) categorical <- FALSE
                else {
                  if (!missing(dif) && !is.null(dif) && !is.na(dif) && !is.null(classes) && !is.na(classes) && .is.categoricalSpatRaster(x)) categorical <- TRUE
                  else {
                    if (verbose) cat("the input data seems continues (if not, use categorical=TRUE)!.... dif/classes is ignored!\n")
                  } 
                }
              } 
            } else {
              if (missing(categorical) && !missing(dif) && !is.null(dif) && !is.na(dif) && !is.null(classes) && !is.na(classes)) categorical <- TRUE
            }
            #----
            if (missing(categorical) || !is.logical(categorical)) {
              # guessing whether the layer is categorical:
              if (.is.categoricalSpatRaster(x)) {
                categorical <- TRUE
                if (verbose) cat("the input is considered as a categorical variable...\n")
              } else {
                categorical <- FALSE
                if (verbose) cat("the input is considered as a continuous variable...\n")
              }
            }
            #----
            if (!categorical && missing(nc)) {
              nc <- nclass(x[[1]])
            } else if (categorical) {
              if (is.null(classes) || is.na(classes)) {
                if (missing(dif) || is.null(classes) || is.na(classes) ) {
                  classes <- unique(x[[1]],incomparables = TRUE)[[1]]
                  if (nlyr(x) > 1) warning('since multiple categorical layers are in the SpatRaster object and "classes" is not specified, the classes are extracted from the first layer!')
                } else {
                  if (length(names(dif)) > 1) {
                    classes <- names(dif)
                    .ux <- as.character(unique(x[[1]],incomparables = TRUE)[[1]])
                    #.ux <- lapply(.ux,as.character)
                    # if (!all(sapply(.ux,function(x) all(x %in% classes)))) {
                    #   if (ncol(.ux) > 1) classes <- .ux
                    #   else classes <- .ux[[1]]
                    #   #if (any(sapply(.ux,function(x) length(unique(x))) / length(unique(unlist(.ux))) > 0.5)) stop('It seems that the classes in different layers ')
                    # }
                    if (!all(.ux %in% classes)) classes <- .ux
                  } else {
                    #.ux <- unique(x[[1]],incomparables = TRUE)[[1]]
                    classes <- unique(x[[1]],incomparables = TRUE)[[1]]
                    if (nlyr(x) > 1) warning('since multiple categorical layers are in the SpatRaster and "classes" is not specified, the classes are extracted from the first layer!')
                  }
                }
              } else {
                .ux <- unique(x,incomparables = TRUE)
                if (is.character(classes)) .ux <- lapply(.ux,as.character)
                # if (is.list(classes) && length(classes) == length(.ux)) {
                #   for (i in 1:length(classes)) {
                #     if (!all(sapply(.ux,function(x) all(x %in% classes[[i]])))) stop('the specified "classes" does not cover all or some of values in the input raster!')
                #   }
                # } else {
                #   if (!all(sapply(.ux,function(x) all(x %in% classes)))) stop('the specified "classes" does not cover all or some of values in the input raster!')
                # }
                if (!all(sapply(.ux,function(x) all(x %in% classes)))) stop('the specified "classes" does not cover all or some of values in the input raster!')
              }
              # if (is.list(classes)) {
              #   nc <- sapply(classes,length)
              # } else nc <- length(classes)
              nc <- length(classes)
            }
            #-----
            
            if (categorical) {
              if (missing(dif)) {
                dif <- rep(1,nc*nc)
                for (i in 1:nc) dif[(i-1)*nc+i] <-0
              } else {
                dif <- .checkDif(dif,classes)
              }
            }
            #-----
            w <-.Filter(r=res(x)[1],d1=0,d2=d)
            fdim <- w[[1]]
            w <- w[[2]]
            
            if (fdim < 3) stop("d must be at least equal to the input raster resolution!")
            
            if (!categorical) x <- categorize(x,nc)
            
            out <- rast(x[[1]])
            ncl <- ncol(out)
            nrw <- nrow(out)
            filename=trim(filename)
            gc()
            #---------------
            if (.canProcessInMemory(out,n=3)) {
              
              if (categorical) {
                if (missing(cells)) {
                  if (length(stat) == 1 && stat == 'elsa') {
                    for (i in 1:nlyr(x)) {
                      out[[i]][] <- .Call('v_elsac', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                    }
                    names(out) <- paste0(names(x),'_ELSA')
                  } else {
                    
                    if (nlyr(x) > 1) {
                      if (length(stat) > 1) out <- rast(x[[1]])
                      for (i in 1:nlyr(x)) {
                        xx <- .Call('elsac', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                        if (length(stat) > 1) {
                          .lyrnames <- names(x)
                          nnn <- c()
                          if ('ea' %in% stat) {
                            outx <- rast(out[[1]])
                            outx[] <- xx[[2]]
                            out <- c(out,outx)
                            nnn <- c(nnn,paste0(.lyrnames[i],'_Ea'))
                          }
                          if ('ec' %in% stat) {
                            outx <- rast(out[[1]])
                            outx[] <- xx[[1]]
                            out <- c(out,outx)
                            nnn <- c(nnn,paste0(.lyrnames[i],'_Ec'))
                          }
                          if ('elsa' %in% stat) {
                            outx <- rast(out[[1]])
                            outx[] <- xx[[2]] * xx[[1]]
                            out <- c(out,outx)
                            nnn <- c(nnn,paste0(.lyrnames[i],'_ELSA'))
                          }
                          names(out) <- nnn
                          
                        } else {
                          if (stat == 'ea') {
                            out[[i]][] <- xx[[2]]
                            names(out) <- 'Ea'
                          } else {
                            out[[i]][] <- xx[[1]]
                            names(out) <- 'Ec'
                          }
                        }
                      }
                      
                    } else {
                      xx <- .Call('elsac', x[][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                      if (length(stat) > 1) {
                        nnn <- c()
                        if ('ea' %in% stat) {
                          outx <- rast(out)
                          outx[] <- xx[[2]]
                          out <- c(out,outx)
                          nnn <- c(nnn,'Ea')
                        }
                        if ('ec' %in% stat) {
                          outx <- rast(out)
                          outx[] <- xx[[1]]
                          out <- c(out,outx)
                          nnn <- c(nnn,'Ec')
                        }
                        if ('elsa' %in% stat) {
                          outx <- rast(out)
                          outx[] <- xx[[2]] * xx[[1]]
                          out <- c(out,outx)
                          nnn <- c(nnn,'ELSA')
                        }
                        names(out) <- nnn
                        
                      } else {
                        if (stat == 'ea') {
                          out[] <- xx[[2]]
                          names(out) <- 'Ea'
                        } else {
                          out[] <- xx[[1]]
                          names(out) <- 'Ec'
                        }
                      }
                    }
                    
                  }
                  if (filename != '') out <- writeRaster(out, filename, ...)
                } else {
                  if (nlyr(x) > 1) {
                    out <- matrix(NA,nrow=length(cells),ncol=nlyr(x)*length(stat))
                    .layernames <- names(x)
                    colnames(out) <- paste0(.layernames,'_',stat)
                    for (i in 1:nlyr(x)) {
                      if (length(stat) == 1) {
                        if (stat == 'elsa') out[,i] <- .Call('v_elsac_cell', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                        else if (stat == 'ec') out[,i] <- .Call('v_elsac_cell_Ec', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                        else if (stat == 'ea') out[,i] <- .Call('v_elsac_cell_Ea', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                      } else {
                        xx <- .Call('elsac_cell', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                        
                        if ('ea' %in% stat) {
                          out[,paste0(.layernames[i],'_','ea')] <- xx[[2]]
                        }
                        if ('ec' %in% stat) {
                          out[,paste0(.layernames[i],'_','ec')] <- xx[[1]]
                        }
                        if ('elsa' %in% stat) {
                          out[,paste0(.layernames[i],'_','elsa')] <- xx[[2]] * xx[[1]]
                        }
                      }
                    }
                  } else {
                    if (length(stat) == 1) {
                      if (stat == 'elsa') out <- .Call('v_elsac_cell', x[][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                      else if (stat == 'ec') out <- .Call('v_elsac_cell_Ec', x[][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                      else if (stat == 'ea') out <- .Call('v_elsac_cell_Ea', x[][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                    } else {
                      xx <- .Call('elsac_cell', x[][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cells), PACKAGE='elsa')
                      out <- list()
                      if ('ea' %in% stat) {
                        out[['Ea']] <- xx[[2]]
                      }
                      if ('ec' %in% stat) {
                        out[['Ec']] <- xx[[1]]
                      }
                      if ('elsa' %in% stat) {
                        out[['ELSA']] <-  xx[[2]] * xx[[1]]
                      }
                    }
                  }
                  
                }
              } else {
                if (missing(cells)) {
                  
                  
                  
                  rr <- lapply(1:nlyr(x),function(i) x[[i]][][,1])
                  xx <- .Call('Melsa', rr, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                  if (length(stat) > 1) {
                    if ('ea' %in% stat) {
                      outx <- rast(x[[1]])
                      outx[] <- xx[[2]]
                      names(outx) <- 'Ea'
                      out <- c(out,outx)
                    }
                    if ('ec' %in% stat) {
                      outx <- rast(x[[1]])
                      outx[] <- xx[[1]]
                      names(outx) <- 'Ec'
                      out <- c(out,outx)
                    }
                    if ('elsa' %in% stat) {
                      outx <- rast(x[[1]])
                      outx[] <- xx[[2]] * xx[[1]]
                      names(outx) <- 'ELSA'
                      out <- c(out,outx)
                    }
                  } else {
                    if (stat == 'ea') {
                      out[] <- xx[[2]]
                      names(out) <- 'Ea'
                    } else if (stat == 'ec') {
                      out[] <- xx[[1]]
                      names(out) <- 'Ec'
                    } else {
                      out[] <- xx[[1]] * xx[[2]]
                      names(out) <- 'ELSA'
                    }
                  }
                  
                  
                  
                  if (filename != '') out <- writeRaster(out, filename, ...)
                  
                } else {
                  out <- list()
                  for (i in 1:nlyr(x)) {
                    if (length(stat) == 1) {
                      if (stat == 'elsa') out[[paste0(names(x[[i]]),'_ELSA')]] <- .Call('v_elsa_cell', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells), PACKAGE='elsa')
                      else if (stat == 'ec') out[[paste0(names(x[[i]]),'Ec')]] <- .Call('v_elsa_cell_Ec', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells), PACKAGE='elsa')
                      else if (stat == 'ea') out[[paste0(names(x[[i]]),'_Ea')]] <- .Call('v_elsa_cell_Ea', x[[i]][][,1], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells), PACKAGE='elsa')
                    } else {
                      xx <- .Call('elsa_cell', x[[i]][][,i], as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(cells), PACKAGE='elsa')
                      if ('ea' %in% stat) {
                        out[[paste0(names(x[[i]]),'_Ea')]] <- xx[[2]]
                      }
                      if ('ec' %in% stat) {
                        out[[paste0(names(x[[i]]),'_Ec')]] <- xx[[1]]
                      }
                      if ('elsa' %in% stat) {
                        out[[paste0(names(x[[i]]),'_ELSA')]] <-  xx[[2]] * xx[[1]]
                      }
                    }
                  }
                }
              }
            } else {
              if (verbose) cat("\nThe input dataset is considered as a big raster dataset that will be handled out of memory (on the disk)...")
              
              if (nlyr(x) > 1) {
                warning("Since the raster dataset cannot handled in memory, the function is applied only to the first layer!")
                x <- x[[1]]
                out <- rast(x[[1]])
              }
              tr <- blocks(out,n=3)
              
              addr <- floor(fdim / 2)
              
              if (missing(cells)) {
                
                if (length(stat) > 1) warning(paste('for big rasters, stat can only have one value, so stat = "',toupper(stat[1]),'", is considered!\n',sep=''))
                stat <- stat[1]
                
                
                readStart(x)
                b <- writeStart(out, filename=filename,...)
                v <- readValues(x, row=1, nrows=b$nrows[1]+addr)
                if (!categorical) {
                  v <- .Call('elsa', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                } else {
                  v <- .Call('elsac', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                }
                
                if (stat == 'elsa') v <- v[[1]] * v[[2]]
                else if (stat == 'ea') v <- v[[2]]
                else v <- v[[1]]
                
                ex <- length(v) - (addr * ncl)
                writeValues(out, v[1:ex], 1, nrows=b$nrows[1])
                
                for (i in 2:(b$n-1)) {
                  v <- readValues(x, row=tr$row[i]-addr, nrows=b$nrows[i]+(2*addr))
                  if (!categorical) {
                    v <- .Call('elsa', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                  } else {
                    v <- .Call('elsac', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                  }
                  
                  if (stat == 'elsa') v <- v[[1]] * v[[2]]
                  else if (stat == 'ea') v <- v[[2]]
                  else v <- v[[1]]
                  
                  st <- (addr * ncl)+1
                  ex <- length(v) - (addr * ncl)
                  writeValues(out, v[st:ex], b$row[i],nrows=b$nrows[i])
                }
                
                i <- b$n
                v <- readValues(x, row=b$row[i]-addr, nrows=b$nrows[i])
                if (!categorical) {
                  v <- .Call('elsa', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), PACKAGE='elsa')
                } else {
                  v <- .Call('elsac', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, PACKAGE='elsa')
                }
                
                if (stat == 'elsa') v <- v[[1]] * v[[2]]
                else if (stat == 'ea') v <- v[[2]]
                else v <- v[[1]]
                
                st <- (addr * ncl)+1
                ex <- length(v)
                writeValues(out, v[st:ex], tr$row[i])
                
                writeStop(out)      
                readStop(x)
              } else {
                readStart(x)
                v <- readValues(x, row=1, nrows=tr$nrows[1]+addr)
                cls <- cells[which(cells <= (tr$nrows[1]) * ncl)]
                if (length(cls) > 0) {
                  if (!categorical) {
                    v <- .Call('elsa_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), as.integer(cls), PACKAGE='elsa')
                  } else {
                    v <- .Call('elsac_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cls), PACKAGE='elsa')
                  }
                  
                  if (length(stat) > 1) {
                    out <- list()
                    if ('ea' %in% stat) {
                      out[['Ea']] <- c(out[['L']],v[[2]])
                    }
                    if ('ec' %in% stat) {
                      out[['Ec']] <- c(out[['R']],v[[1]])
                    }
                    if ('elsa' %in% stat) {
                      out[['ELSA']] <-  c(out[['ELSA']],v[[2]] * v[[1]])
                    }
                  } else {
                    out <- c()
                    if (stat == 'ea') {
                      out <- c(out, v[[2]])
                    } else if (stat == 'ec') {
                      out <- c(out, v[[1]])
                    } else out <- c(out, v[[1]]*v[[2]])
                  }
                }
                
                for (i in 2:(tr$n-1)) {
                  
                  cls <- cells[which((cells > ((tr$row[i] - 1) * ncl)) & (cells <= ((tr$row[i]+ tr$nrows[i] - 1) * ncl)))]
                  if (length(cls) > 0) {
                    cls <- cls - ((tr$row[i]-addr-1)*ncl)
                    v <- readValues(x, row=tr$row[i]-addr, nrows=tr$nrows[i]+(2*addr))
                    if (!categorical) {
                      v <- .Call('elsa_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), as.integer(cls), PACKAGE='elsa')
                    } else {
                      v <- .Call('elsac_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cls), PACKAGE='elsa')
                    }
                    if (length(stat) > 1) {
                      if ('ea' %in% stat) {
                        out[['Ea']] <- c(out[['L']],v[[2]])
                      }
                      if ('ec' %in% stat) {
                        out[['Ec']] <- c(out[['R']],v[[1]])
                      }
                      if ('elsa' %in% stat) {
                        out[['ELSA']] <-  c(out[['ELSA']],v[[2]] * v[[1]])
                      }
                    } else {
                      if (stat == 'ea') {
                        out <- c(out, v[[2]])
                      } else if (stat == 'ec') {
                        out <- c(out, v[[1]])
                      } else out <- c(out, v[[1]]*v[[2]])
                    }
                  }
                }
                
                i <- tr$n
                cls <- cells[which(cells > ((tr$row[i] - 1) * ncl) & cells <= ((tr$row[i]+ tr$nrows[i] - 1) * ncl))]
                cls <- cls - ((tr$row[i]-addr-1)*ncl)
                if (length(cls) > 0) {
                  v <- readValues(x, row=tr$row[i]-addr, nrows=tr$nrows[i])
                  if (!categorical) {
                    v <- .Call('v_elsa_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]), as.integer(cls), PACKAGE='elsa')
                  } else {
                    v <- .Call('v_elsac_cell', v, as.integer(ncl), as.integer(nrw), as.integer(nc), as.integer(w[,1]), as.integer(w[,2]),as.integer(classes),dif, as.integer(cls), PACKAGE='elsa')
                  }
                  if (length(stat) > 1) {
                    if ('ea' %in% stat) {
                      out[['Ea']] <- c(out[['Ea']],v[[2]])
                    }
                    if ('ec' %in% stat) {
                      out[['Ec']] <- c(out[['Ec']],v[[1]])
                    }
                    if ('elsa' %in% stat) {
                      out[['ELSA']] <-  c(out[['ELSA']],v[[2]] * v[[1]])
                    }
                  } else {
                    if (stat == 'ea') {
                      out <- c(out, v[[2]])
                    } else if (stat == 'ec') {
                      out <- c(out, v[[1]])
                    } else out <- c(out, v[[1]]*v[[2]])
                  }
                  
                }
                readStop(x)
              }
            }
            return(out)
          }
)  


#---------------





# Author: Babak Naimi, naimi.b@gmail.com
# Date :  August 2016
# Last update: Nov. 2022
# Version 2.3
# Licence GPL v3 
#-----------


.nclass_fun <- function(x,nc,...) {
  .Call('categorize', as.vector(x), as.vector(nc), PACKAGE='elsa')
}
#-------

if (!isGeneric("nclass")) {
  setGeneric("nclass", function(x,th,...)
    standardGeneric("nclass"))
}

# select the optimum number of classes based on one-standard error rule

setMethod('nclass', signature(x='RasterLayer'), 
          function(x,th=0.005,probs) {
            if (missing(th)) th <- 0.005
            if (missing(probs)) probs <- NULL
            
            if (canProcessInMemory(x,2)) {
              w <- which(!is.na(x[]))
              w <- w[sample(length(w),min(round(length(w) * 0.8),1e4))]
            } else {
              w <- min(round(ncell(x) * 0.8),1e4)
              w <- sampleRandom(x,w,cells=TRUE)[,1]
            }
            xx <- x[w]
            Loop <- TRUE
            i <-  2
            o <- c()
            while (Loop) {
              cc <- cor(xx,categorize(xx,i,probs=probs),method='spearman')
              if (cc >= (1-th) | i > 100) Loop <- FALSE
              o <- c(o,cc)
              i <- i + 1
            }
            i <- i-1
            se <- sd(o,na.rm = TRUE) / sqrt(i)
            which(o > (max(o,na.rm = TRUE) - se))[1] + 1
            # o <- o[2:i] - o[1:(i-1)]
            # i <- i-1
            # o <- o[1:(i-1)] - o[2:i]
            # w <- which(abs(o) <= th)
            # if (length(w) > 0) return(w[1]+2)
            # else return(i+1)
          }
)

#------------ 

setMethod('nclass', signature(x='SpatRaster'), 
          function(x,th=0.005,probs) {
            if (missing(th)) th <- 0.005
            if (missing(probs)) probs <- NULL
            
            if (.canProcessInMemory(x,2)) {
              w <- which(!is.na(x[]))
              w <- w[sample(length(w),min(round(length(w) * 0.8),1e4))]
              gc()
            } else {
              w <- min(round(ncell(x) * 0.8),1e4)
              w <- spatSample(x,w,cells=TRUE)[,1]
            }
            xx <- x[w][,1]
            xx <- xx[!is.na(xx)]
            
            Loop <- TRUE
            i <-  2
            o <- c()
            while (Loop) {
              cc <- cor(xx,categorize(xx,i,probs=probs),method='spearman')
              if (cc >= (1-th) | i > 100) Loop <- FALSE
              o <- c(o,cc)
              i <- i + 1
            }
            i <- i-1
            se <- sd(o,na.rm = TRUE) / sqrt(i)
            which(o > (max(o,na.rm = TRUE) - se))[1] + 1
            # o <- o[2:i] - o[1:(i-1)]
            # i <- i-1
            # o <- o[1:(i-1)] - o[2:i]
            # w <- which(abs(o) <= th)
            # if (length(w) > 0) return(w[1]+2)
            # else return(i+1)
          }
)

#------------ 

setMethod('nclass', signature(x='numeric'), 
          function(x,th=0.005,probs) {
            if (missing(th)) th <- 0.005
            if (missing(probs)) probs <- NULL
            x <- x[which(!is.na(x))]
            Loop <- TRUE
            i <-  2
            o <- c()
            while (Loop) {
              cc <- cor(x,categorize(x,i,probs=probs),method='spearman')
              if (cc >= (1-th) | i > 100) Loop <- FALSE
              o <- c(o,cc)
              i <- i + 1
            }
            i <- i-1
            se <- sd(o,na.rm = TRUE) / sqrt(i)
            which(o > (max(o,na.rm = TRUE) - se))[1] + 1
            #o <- o[2:i] - o[1:(i-1)]
            #i <- i-1
            #o <- o[1:(i-1)] - o[2:i]
            #w <- which(abs(o) <= th)
            #if (length(w) > 0) return(w[1]+2)
            #else return(i+1)
          }
)


# Author: Babak Naimi, naimi.b@gmail.com
# Date :  July 2016
# Version 2.0
# Licence GPL v3 

if (!isGeneric("plot")) {
  setGeneric("plot", function(x,y,...)
    standardGeneric("plot"))
}	


setMethod("plot", signature(x='Entrogram'), 
          function(x,xlim,ylim,xlab,ylab,pch,col,main,cloud=FALSE,box=FALSE,...) {
            if ((cloud || box) & is.null(x@entrogramCloud)) stop("cloud=TRUE, or box=TRUE is not working as the cloud data are not stored in the input Entrogram object, you should use cloud=TRUE in the entrogram function to keep the data!")
            nlag <- ceiling(x@cutoff / x@width)
            if (missing(xlim)) xlim <- c(0,x@cutoff)
            if (missing(ylim)) {
              if (cloud || box) ylim <- c(0,quantile(x@entrogramCloud,prob=0.99,na.rm=TRUE))
              else ylim <- c(0,max(x@entrogram$E,na.rm=TRUE))
            }
            if (missing(xlab)) xlab <- "Distance"
            if (missing(ylab)) ylab <- "Mean ELSA"
            if (missing(pch)) pch <- 16
            if (missing(col)) {
              if (box & !cloud) col <- 0
              else col <- 'blue'
            }
            if (missing(main)) {
              if (cloud) main <- "Entrogram Cloud"
              else if (box) main <- "Box plot of Entrogram Cloud"
              else main <- "Entrogram"
            }
            if (cloud) {
              plot(x@entrogram$distance,x@entrogramCloud[1,],xlim=xlim,ylim=ylim,xlab=xlab,ylab=ylab,main=main,pch=pch,col=col,...)
              for (i in 2:nrow(x@entrogramCloud)) points(x@entrogram$distance,x@entrogramCloud[i,],col=col,pch=pch,...)
            } else if (box) boxplot(x@entrogramCloud,names=x@entrogram$distance,xlab=xlab,ylab=ylab,ylim=ylim,col=col,main=main,...)
            else plot(x@entrogram$distance,x@entrogram$E,xlim=xlim,ylim=ylim,xlab=xlab,ylab=ylab,main=main,pch=pch,col=col,...)
          }
)

setMethod("plot", signature(x='Variogram'), 
          function(x,xlim,ylim,xlab,ylab,pch,col,main,cloud=FALSE,box=FALSE,...) {
            if ((cloud || box) & is.null(x@variogramCloud)) stop("cloud=TRUE, or box=TRUE is not working as the cloud data are not stored in the input Entrogram object, you should use cloud=TRUE in the entrogram function to keep the data!")
            nlag <- ceiling(x@cutoff / x@width)
            if (missing(xlim)) xlim <- c(0,x@cutoff)
            if (missing(ylim)) {
              if (cloud || box) ylim <- c(0,quantile(x@variogramCloud,prob=0.99,na.rm=TRUE))
              else ylim <- c(0,max(x@variogram$gamma,na.rm=TRUE))
            }
            if (missing(xlab)) xlab <- "Distance"
            if (missing(ylab)) ylab <- "Semivariance"
            if (missing(pch)) pch <- 16
            if (missing(col)) {
              if (box & !cloud) col <- 0
              else col <- 'blue'
            }
            if (missing(main)) {
              if (cloud) main <- "Variogram Cloud"
              else if (box) main <- "Box plot of Variogram Cloud"
              else main <- "Variogram"
            }
            if (cloud) {
              plot(x@variogram$distance,x@variogramCloud[1,],xlim=xlim,ylim=ylim,xlab=xlab,ylab=ylab,main=main,pch=pch,col=col,...)
              for (i in 2:nrow(x@variogramCloud)) points(x@variogram$distance,x@variogramCloud[i,],col=col,pch=pch,...)
            } else if (box) boxplot(x@variogramCloud,names=x@variogram$distance,xlab=xlab,ylab=ylab,ylim=ylim,col=col,main=main,...)
            else plot(x@variogram$distance,x@variogram$gamma,xlim=xlim,ylim=ylim,xlab=xlab,ylab=ylab,main=main,pch=pch,col=col,...)
          }
)



setMethod("plot", signature(x='Correlogram'), 
          function(x,xlim,ylim,xlab,ylab,pch,col,main,...) {
            nlag <- ceiling(x@cutoff / x@width)
            if (missing(xlim)) xlim <- c(0,x@cutoff)
            if (missing(ylim)) {
              mn <- min(x@correlogram$moran,na.rm = TRUE)
              if (mn >=0) ylim <- c(-0.1,max(x@correlogram$moran,na.rm=TRUE))
              else ylim <- c(mn-0.1,max(x@correlogram$moran,na.rm=TRUE))
            }
            if (missing(xlab)) xlab <- "Distance"
            if (missing(ylab)) ylab <- "Moran's I"
            if (missing(pch)) pch <- 16
            if (missing(col)) {
              col <- 'blue'
            }
            if (missing(main)) main <- "Correlogram"
            
            plot(x@correlogram$distance,x@correlogram$moran,xlim=xlim,ylim=ylim,xlab=xlab,ylab=ylab,main=main,pch=pch,col=col,...)
            abline(h=0)
          }
)




# Author: Babak Naimi, naimi.b@gmail.com
# Date :  August 2014
# Version 1.0
# Licence GPL v3 


setMethod ('show' , 'Entrogram', 
           function(object) {
             cat('class               :' , class(object), '\n')
             cat('---------------------------------------\n')
             cat('Width               :' , object@width, '\n')
             cat('Cutoff              :' , object@cutoff, '\n')
             cat('Number of lags      : ' , ceiling(object@cutoff / object@width), '\n')
             cat ('\n')
             cat('------ Entrogram data ------','\n')
             if (nrow(object@entrogram) > 10) {
               print(object@entrogram[1:10,])
               cat ('--- and ',nrow(object@entrogram) - 10,' more...!\n')
             } else print(object@entrogram)
           }
)

# Author: Babak Naimi, naimi.b@gmail.com
# Date :  November 2022
# last update: July 2025
# Version 1.3
# Licence GPL v3 
#-----------------------------

.eval <- function(x,env) {
  eval(parse(text=x),envir=env)
}
#----

.canProcessInMemory <- function(x,n=1) {
  # copied partially from mem_info in the terra package!
  opt <- .eval("terra:::spatOptions()",env=environment())
  opt$ncopies = n
  v <- x@pntr$mem_needs(opt)
  return(round(v[5]) != 0)
}

#------
.is.projected <- function(x) {
  if (inherits(x,'Spatial')) {
    if (!is.na(is.projected(x))) {
      is.projected(x)
    } else {
      all(bbox(x)[1,] <= 180) & all(bbox(x)[1,] >= -180) & all(bbox(x)[2,] <= 90) & all(bbox(x)[2,] >= -90)
    }
  } else if (inherits(x,'matrix') || inherits(x,'data.frame')) {
    all(range(x[,1],na.rm=TRUE) <= 180) & all(range(x[,1],na.rm=TRUE) >= -180) & all(range(x[,2],na.rm=TRUE) <= 90) & all(range(x[,2],na.rm=TRUE) >= -90)
  } else if (inherits(x,'SpatRaster') || inherits(x,'SpatVector')) {
    e <- as.vector(ext(x))
    !all(e >= -180 & e <= 180)
  }
  
  
}

# Author: Babak Naimi, naimi.b@gmail.com
# Date :  August 2016
# Latest Update: May 2019
# Version 1.5
# Licence GPL v3 

if (!isGeneric("Variogram")) {
  setGeneric("Variogram", function(x,width,cutoff,...)
    standardGeneric("Variogram"))
}


setMethod('Variogram', signature(x='RasterLayer'), 
          function(x, width, cutoff, cloud=FALSE,s=NULL,...) {
            re <- res(x)[1]
            if (missing(cutoff)) cutoff<- sqrt((xmin(x)-xmax(x))^2+(ymin(x)-ymax(x))^2) / 3
            if (missing(width)) width <- re
            else if (width < re) width <- re
            
            if (missing(s)) s <- NULL
            
            if (cutoff < width) stop("cutoff should be greater than width size")
            nlag <- ceiling(cutoff / width)
            
            n <- ncell(x) - cellStats(x,'countNA')
            #---
            if (is.null(s)) {
              if (!.checkrasterMemory(n,nlag)) {
                s <- c()
                for (i in (nlag-1):1) s <- c(s,.checkrasterMemory(n,i))
                s <- which(s)
                if (length(s) > 0) {
                  s <- (nlag - s[1]) / (2*nlag)
                  s <- ceiling(n * s)
                  #s <- sampleRandom(x,s,cells=TRUE)[,1]
                  s <- sampleRandom(x,s,sp=TRUE)
                } else {
                  s <- 1 / (2 * nlag)
                  s <- ceiling(n * s)
                  while (!.checkrasterMemory(s,1)) s <- ceiling(s / 2)
                  #s <- sampleRandom(x,s,cells=TRUE)[,1]
                  s <- sampleRandom(x,s,sp=TRUE)
                }
              } 
            } else {
              if (!is.numeric(s)) stop("s argument should be an integer number or NULL!")
              while (!.checkrasterMemory(s[1],1)) s <- ceiling(s[1] * 0.8)
              if (s > n) s <- n
              #s <- sampleRandom(x,s,cells=TRUE)[,1]
              s <- sampleRandom(x,s,sp=TRUE)
            }
            
            #######---------------------
            if (is.null(s)) {
              out <- new("Variogram")
              out@width <- width
              out@cutoff <- cutoff
              d <- seq(width,width*nlag,width) - (width/2)
              out@variogram <- data.frame(distance=d,gamma=rep(NA,length(d)))
              if (cloud) out@variogramCloud <- matrix(NA,nrow=if (is.null(s)) length(x) else length(s),ncol=nlag)
              for (i in 1:nlag) {
                d1 <- (i -1) * width
                d2 <- d1 + width
                w <-.Filter(r=res(x)[1],d1=d1,d2=d2)[[2]]
                w <- .Call('semivar',as.vector(x[]),as.integer(ncol(x)),as.integer(nrow(x)),as.integer(w[,1]),as.integer(w[,2]), PACKAGE='elsa')
                if (cloud) out@variogramCloud[,i] <- w
                w <- w[!is.infinite(w)]
                w <- w[!is.na(w)]
                out@variogram [i,2] <- mean(w)
              }
            } else {
              if (!is.na(projection(x))) {
                longlat <- strsplit(trim(strsplit(projection(x),'\\+')[[1]][2]),'=')[[1]][2] == 'longlat'
                if (is.na(longlat) || !is.logical(longlat)) longlat <- NULL
              } else longlat <- NULL
              out <- Variogram(s,width,cutoff,zcol=names(x),cloud=cloud,s=NULL,longlat=longlat,...)
            }
            out
          }
)
##########


setMethod('Variogram', signature(x='Spatial'), 
          function(x, width, cutoff, zcol,  cloud=FALSE, s=NULL,longlat,...) {
            if (!class(x) %in% c('SpatialPolygonsDataFrame','SpatialPointsDataFrame')) stop('x can only be either of RasterLayer, SpatialPointsDataFrame, SpatialPolygonsDataFrame')
            
            n <- nrow(x)
            
            if (missing(s)) s <- NULL
            
            if (missing(longlat)) longlat <- NULL
            
            if (missing(cutoff)) cutoff<- sqrt((xmin(x)-xmax(x))^2+(ymin(x)-ymax(x))^2) / 3
            if (missing(width)) width <- cutoff / 15
            
            if (cutoff < width) stop("cutoff should be greater than width size")
            
            nlag <- ceiling(cutoff / width)
            
            if (missing(zcol)) {
              if (ncol(x@data) > 1) stop("zcol should be specified!")
              else zcol <- 1
            } else if (is.character(zcol)) {
              w <- which(colnames(x@data) == zcol[1])
              if (w == 0) stop('the specified variable in zcol does not exist in the data')
              zcol <- w
            } else if (is.numeric(zcol)) {
              zcol <- zcol[1]
              if (zcol > ncol(x@data)) stop('the zcol number is greater than the number of columns in data!')
            } else stop("zcol should be a character or a number!")
            
            xy <- coordinates(x)
            x <- x@data[,zcol]
            #---
            if (!is.null(s) && is.numeric(s) && s < n) {
              s <- sample(n,s)
              x <- x[s]
              n <- length(x)
              xy <- xy[s,]
            }
            #######---------------
            out <- new("Variogram")
            out@width <- width
            out@cutoff <- cutoff
            d <- seq(width,width*nlag,width) - (width/2)
            out@variogram <- data.frame(distance=d,gamma=rep(NA,length(d)))
            if (cloud) {
              out@variogramCloud <- matrix(NA,nrow=n,ncol=nlag)
              for (i in 1:nlag) {
                d1 <- (i -1) * width
                d2 <- d1 + width
                d <- dneigh(xy,d1=d1, d2=d2,longlat = longlat)@neighbours
                w <- .Call('semivar_vector', x, d, PACKAGE='elsa')
                out@variogramCloud[,i] <-w
                w <- w[!is.infinite(w)]
                w <- w[!is.na(w)]
                out@variogram [i,2] <- mean(w,na.rm=TRUE)
              }
            } else {
              for (i in 1:nlag) {
                d1 <- (i -1) * width
                d2 <- d1 + width
                d <- dneigh(xy,d1=d1, d2=d2,longlat = longlat)@neighbours
                w <- .Call('semivar_vector', x, d, PACKAGE='elsa')
                w <- w[!is.infinite(w)]
                w <- w[!is.na(w)]
                out@variogram [i,2] <- mean(w,na.rm=TRUE)
              }
            }
            out
          }
)

