R/Utils.R

In RGMQL: GenoMetric Query Language for R/Bioconductor

.counter <- function(zero = 0)
{
    i <- zero
    function() {
        i <<- i + 1
        toString <- as.character(i)
    }
}

.add_metadata <- function(files)
{
    x <- scan(files, what="", sep="\n")
    y <- strsplit(x, "\t")
    names(y) <- vapply(y, `[[`,character(1), 1)
    listMeta <- lapply(y, `[`, -1)
}

.schema_header <- function(datasetName)
{
    schema_name <- list.files(datasetName, pattern = "*.schema$",
                                full.names = TRUE)
    
    schema_name_xml <- list.files(datasetName, pattern = "*.xml$",
                                full.names = TRUE)
    
    if(!length(schema_name) && !length(schema_name_xml))
        stop("schema not present")
    
    if(!length(schema_name))
        xml_schema <- xml2::read_xml(schema_name_xml)
    else
        xml_schema <- xml2::read_xml(schema_name)
    
    list_field <- xml2::as_list(xml_schema)
    vector_field <- unlist(list_field)
}

.schema_type_coordinate <- function(datasetName)
{
    schema_name <- list.files(datasetName, pattern = "*.schema$",
                              full.names = TRUE)
    
    schema_name_xml <- list.files(datasetName, pattern = "*.xml$",
                                  full.names = TRUE)
    
    if(!length(schema_name) && !length(schema_name_xml))
        stop("schema not present")
    
    if(!length(schema_name))
        xml_schema <- xml2::read_xml(schema_name_xml)
    else
        xml_schema <- xml2::read_xml(schema_name)
    
    gmql_schema_tag <- xml2::xml_children(xml_schema)
    all_attrs <- xml2::xml_attrs(gmql_schema_tag)
    all_attrs_list <- as.list(all_attrs[[1]])
}

# aggregates factory
.aggregates <- function(meta_data,class)
{
    if(!is.list(meta_data))
        stop("meta_data: invalid input")
    
    if(!all(vapply(meta_data, function(x) is(x,class), logical(1))))
        stop("All elements must be META_AGGREGATES object")
    
    names <- names(meta_data)
    if(is.null(names))
    {
        warning("You did not assign a names to a list.\nWe build it for you")
        names <- vapply(meta_data, take_value.META_AGGREGATES,character(1))
    }
    else
    {
        if("" %in% names)
            stop("No partial names assignment is allowed")
    }
    aggregate_matrix <- t(vapply(meta_data, function(x) {
        new_value = as.character(x)
        matrix <- matrix(new_value)
    },character(2)))
    
    m_names <- matrix(names)
    metadata_matrix <- cbind(m_names,aggregate_matrix)
}


# meta join condition
.join_condition <- function(cond)
{
    cond_matrix <- NULL
    def <- cond$condition$def
    if(!is.null(def))
        cond_matrix <- rbind(cond_matrix, def)
    
    exact <- cond$condition$exact
    if(!is.null(exact))
        cond_matrix <- rbind(cond_matrix, exact)
    
    full <- cond$condition$full
    if(!is.null(full))
        cond_matrix <- rbind(cond_matrix, full)
    cond_matrix
}

.check_input <- function(value)
{
    if(!is.character(value))
        stop("no valid data")
    
    if(length(value)>1)
        stop("no multiple string")
}

.check_logical <- function(value)
{
    if(!is.logical(value))
        stop("no valid data")
    
    if(length(value)>1)
        stop("no multiple string")
}

.is_login_expired <- function(url)
{
    if(exists("GMQL_credentials", envir = .GlobalEnv))
    {
        if(exists("authToken", where = GMQL_credentials))
        {
            authToken <- GMQL_credentials$authToken
            url <- sub("/*[/]$","",url)
            h <- c('Accept' = 'Application/json', 'X-Auth-Token' = authToken)
            URL <- paste0(url,"/user")
            req <- httr::GET(URL,httr::add_headers(h))
            if(req$status_code !=200)
                return(TRUE)
            else
                return(FALSE)
        }
    }
    return(TRUE)
}