R/metadata.R

In mjakubczak/spicyScript: Run spicy models from command line

#' Get ExpressionSet metadata
#' 
#' Returns basic ExpressionSet metadata in json format. It is used for galaxy
#' server purposes. 
#' 
#' @param filename character, the filename of the ExpressionSet RDS file
#' @param discrCol character, the name of the discrimination column (column
#' that contains observation groups)
#' @param minGroups integer, the minimal valid number of groups
#' @param maxGroups integer, the maximal valid number of groups
#' 
#' @return list in json format (dict) with fields: dims, phenoCols, discrCol, 
#' isTrainingDataSet, groups
#' @export
getEsetMeta <- function(filename, discrCol = NULL, minGroups = 2L, maxGroups = 10L){
  eset <- readRDS(filename)
  
  dims <- Biobase::dims(eset)
  groupInfo <- Biobase::pData(eset)
  phenoCols <- names(groupInfo)
  
  if (is.null(discrCol) || !discrCol %in% phenoCols){
    count <- sapply(
      X = groupInfo,
      FUN = function(x) nlevels(as.factor(x))
    )
    
    validCols <- names(count[count >= minGroups & count <= maxGroups])
    
    if (length(validCols) > 0){
      discrCol <- validCols[1]
    }
  }
  
  isTrainingDataset <- !is.null(discrCol)
  
  groups <- if (isTrainingDataset){
    as.character(unique(groupInfo[[discrCol]]))
  }
  
  metadata <- list(
    dims = list(
      nobs = dims["Samples", 1],
      nvar = dims["Features", 1]
    ),
    phenoCols = jsonlite::toJSON(phenoCols),
    discrCol = discrCol,
    isTrainingDataset = isTrainingDataset,
    groups = jsonlite::toJSON(groups)
  )
  
  jsonUnbox(metadata)
}

#' Get class of the object stored in RDS file
#' 
#' Returns 1st position in class of the object
#' 
#' @param filename character, the RDS filename
#' 
#' @return Object class in json format (string)
#' @export
getObjectClass <- function(filename){
  obj <- readRDS(filename)
  
  jsonUnbox(class(obj)[1])
}

#' Get sheet names of the xslx file
#' 
#' Returns sheet names of the given filename
#' 
#' @param filename character, the xlsx filename
#' 
#' @return Sheet names in json format (array)
#' @export
getXlsxSheetNames <- function(filename){
  sheetNames <- openxlsx::getSheetNames(filename)
  
  jsonlite::toJSON(sheetNames)
}