R/luccpl_event.R

In car13romani/LuccPL: Processing and analisys language for land use and cover changes

#################################################################
##                                                             ##
##   (c) Carlos Alexandre Romani <carlos.romani@inpe.br>       ##
##                                                             ##
##       Image Processing Division                             ##
##       National Institute for Space Research (INPE), Brazil  ##
##                                                             ##
##                                                             ##
##       R script                                              ##
##                                                             ##
##                                             2020-01-10      ##
##                                                             ##
##            Land Use and Cover Data Analysis                 ##
##                                                             ##
##                                                             ##
#################################################################



#' @title Event
#' @name luccpl_event
#' @aliases luccpl_event
#' @author Carlos Alexandre Romani
#' @docType data
#'
#' @description Main function of the package, where the processing is performed based on the query subfunctions.
#' This function takes a cube of classified land use data as input, together with a query array.
#' The query array is applied to each location (x, y) in the data cube, performing analyzes, and returning
#' as a result a Boolean data cube, with answers to the questions asked.
#'
#' @usage luccpl_event(rbrick, query_array)
#'
#' @param rbrick S4. A spatiotemporal raster brick
#' @param query_array Integer. Query matrix generated by the luccpl_query function,
#'  containing the information to perform the queries in numerical form.
#'
#' @keywords datasets
#' @return A Boolean data cube, with answers to the questions asked.
#' @importFrom ensurer ensure_that
#' @importFrom raster brick getValuesBlock nlayers setValues
#' @importFrom parallel makeCluster detectCores parLapply stopCluster
#' @export
#'





luccpl_event <- function(rbrick, query_array) {
    # case rbrick is a path of raster brick .tif
    
    ensurer::ensure_that(rbrick, !is.null(rbrick), err_desc = "Define a valid rbrick input.")
    ensurer::ensure_that(query_array, !is.null(query_array), err_desc = "Define a valid query_array.")
    
    if (typeof(rbrick) == "character") {
        rbrick <- raster::brick(rbrick, progress = "text")
    }
    
    # import rbrick
    if (typeof(rbrick) == "S4") {
        # sizeblock <- n_rows*rbrick@ncols
        sizets <- dim(rbrick)[3]
        
        
        nblocks <- rbrick@nrows
        
        nrelations <- dim(query_array)[1]
        
        # call Fortran function
        lucc_process <- function(SB, ST, NR, BI, BO, QA) {
            out <- .Fortran("lucc_process", as.integer(SB), as.integer(ST), as.integer(NR), as.integer(BI), as.integer(BO), as.integer(QA))
            return(out[[5]])
        }
        # i=790 send blocks to Fortran function dim(rbrick)
        
        cl <- parallel::makeCluster(parallel::detectCores())
        out <- parallel::parLapply(cl, as.list(1:nblocks), function(i) {
            bcin <- raster::getValues(rbrick, row = i, nrows = 1)
            sizeblock <- dim(bcin)[1]
            
            bcin[is.na(bcin)] <- 0
            blockin <- t(bcin)
            
            blockout <- array(0, dim = dim(blockin))
            
            out_aux <- lucc_process(SB = sizeblock, ST = sizets, NR = nrelations, BI = blockin, BO = blockout, QA = query_array)
            
            return(out_aux)
            
        })
        parallel::stopCluster(cl)
        
        out1 <- unlist(out)
        
        # redimension out to generate result restreBrick
        dim(out1) <- c(sizets, (dim(rbrick)[1] * dim(rbrick)[2]))
        
        out1 <- t(out1)
        
        # generate result rasterBrick
        return(raster::setValues(rbrick, values = out1))
        
        
    }
    
}