R/luccpl_format.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 Query
#' @name luccpl_query
#' @aliases luccpl_query
#' @author Carlos Alexandre Romani
#' @docType data
#'
#' @description Here, the query queries generated by the different query functions are organized and joined,
#'  the result being a query_array
#' 
#' @usage luccpl_query(FUN_list)
#'
#' @param FUN_list List of functions (relations)
#'
#' @keywords datasets
#' @return A query_array to perform the query on luccpl_event function.
#' 
#'

luccpl_query <- function(FUN_list) {
    
    # extract the logical connectors in the FUN_list
    if (length(which("and" == FUN_list)) != 0L) {
        FUN_list[which("and" == FUN_list) - 1] <- 0
        FUN_list <- FUN_list[-which("and" == FUN_list)]
    }
    if (length(which("or" == FUN_list)) != 0L) {
        FUN_list[which("or" == FUN_list) - 1] <- 1
        FUN_list <- FUN_list[-which("or" == FUN_list)]
    }
    FUN_list <- as.integer(FUN_list)
    
    # format query_array
    
    dim(FUN_list) <- c(6, (length(FUN_list)/6))
    query_array <- t(FUN_list)
    # print(query_array) fuction to process data cube and return query result
    
    return(query_array)
    
}




#' @title Mdata
#' @name mdata
#' @aliases mdata
#' @author Carlos Alexandre Romani
#' @docType data
#'
#' @description This function make relation between metadata and digital number in data input.
#' 
#' @usage mdata(pattern_list, metadata)
#'
#' @param pattern_list list of patterns used in query
#' @param metadata of land use classes for input data
#'
#' @keywords datasets
#' @return a list of digital numbers of classifications.
#' 
#'

mdata <- function(pattern_list, metadata) {
    md_out <- NULL
    for (i in 1:length(pattern_list)) {
        md_out[i] <- which(metadata == pattern_list[i])
        if (is.null(md_out[i])) 
            stop("This pattern of Land Use dont exist in metadata!")
    }
    
    return(md_out)
}




#' @title Tdata
#' @name tdata
#' @aliases tdata
#' @author Carlos Alexandre Romani
#' @docType data
#'
#' @description This function make relation between dates and timestep.
#' 
#' @usage tdata(date, dates)
#'
#' @param date date from query
#' @param dates dates from timeserie
#'
#' @keywords datasets
#' @return function to return the time-step for each data.
#' 
#'

tdata <- function(date, dates) {
    td_out <- NULL
    for (i in 1:length(date)) {
        td_out[i] <- which(dates == date[i])
        print(td_out[i])
        if (is.null(td_out[i])) 
            stop("This date dont exist in metadata!")
    }
    
    return(td_out)
    
}




#' @title and_or_bool
#' @name and_or_bool
#' @aliases and_or_bool
#' @author Carlos Alexandre Romani
#' @docType data
#'
#' @description This function convert the conjunction operator and/or in 0/1 to make query array.
#' 
#' @usage and_or_bool(connector_list, n_relations)
#'
#' @param connector_list is a list of and/or to convert in 0/1
#' @param n_relations number of relations to the query
#'
#' @keywords datasets
#' @return function to return 0 to 'and' and 1 to 'or'
#' 
#'

and_or_bool <- function(connector_list, n_relations) {
    ao_out <- NULL
    if (is.null(connector_list)) 
        connector_list <- "and"
    for (i in 1:length(connector_list)) {
        if (pracma::strcmp(connector_list[i], "and")) 
            ao_out[i] <- 0 else if (pracma::strcmp(connector_list[i], "or")) 
            ao_out[i] <- 1
        # else stop('Error in connectors 'and/or'')
    }
    if (length(ao_out) == 1) {
        ao_out[1:n_relations] <- ao_out
        ao_out[n_relations] <- 0
    }
    return(ao_out)
}




#' @title format1
#' @name format1
#' @aliases format1
#' @author Carlos Alexandre Romani
#' @docType data
#'
#' @description Function to format many patterns to parse. internally used
#' 
#' @usage format1(x)
#'
#' @param x patterns
#'
#' @keywords datasets
#' @return formated patterns
#' 
#'

format1 <- function(x) {
    out <- NULL
    if (length(x) == 1) 
        return(paste0("'", x, "'")) else {
        for (i in 1:(length(x) - 1)) {
            out <- paste0(out, "'", x[i], "',")
        }
        out <- paste0(out, "'", x[length(x)], "'")
        return(out)
    }
}