R/perform.sc3.reduction.cluster.R

In connorhknight/IBRAP: Integrated Benchmarking scRNA-seq Analytical Pipeline (IBRAP)

#' @name perform.sc3.reduction.cluster
#' @aliases perform.sc3.reduction.cluster
#' 
#' @title Performs SC3 clustering on reduced embeddings
#'
#' @description Performs SC3 clustering on defined method-assays and supplied reductions. SC3 is designed to function on count matrices, reduction may not always work well.
#' 
#' @param object IBRAP S4 class object
#' @param assay Character. String containing indicating which assay to use
#' @param reduction Character. String defining which reduction to supply to the clustering algorithm.
#' @param dims Numerical. How many dimensions of the reduciton should be supplied, NULL equates to all.
#' @param assignment.df.name Character. What to call the df contained in clusters.
#' @param ks Numerical range. Number of clusters to identify, this can be a range, i.e. 5:10.
#' @param n.core Numerical. How many cores should be used to run SC3. Default = 3
#' 
#' @return Cluster assignments using the list of resolutions provided contained within cluster_assignments under assignment.df.name
#'
#' @export

perform.sc3.reduction.cluster <- function(object, 
                                          assay,
                                          reduction,
                                          dims,
                                          cluster.df.name.suffix='',
                                          ks, 
                                          n.core = 3) {
  
  if(!is(object = object, class2 = 'IBRAP')) {
    
    stop('object must be of class IBRAP \n')
    
  }
  
  if(!is.character(assay)) {
    
    stop('assay must be character string(s) \n')
    
  }
  
  for(x in assay) {
    
    if(!x %in% names(object@methods)) {
      
      stop(paste0('reduction: ', x, 'does not exist\n'))
      
    }
    
  }
  
  for(x in reduction) {
    
    for(i in assay) {
      
      if(!x %in% names(c(object@methods[[i]]@computational_reductions, 
                         object@methods[[i]]@visualisation_reductions, 
                         object@methods[[i]]@integration_reductions))) {
        
        stop(paste0('reduction: ', x, ' does not exist\n'))
        
      }
      
    }
    
  }
  
  if(!is.character(cluster.df.name.suffix)) {
    
    stop(paste0('cluster.df.name.suffix must be character string(s)\n'))
    
  }
  
  if(!is.numeric(ks)) {
    
    stop(paste0('ks must be numerical\n'))
    
  }
  
  if(!is.numeric(n.core)) {
    
    stop(paste0('n.core must be numerical\n'))
    
  }
  
  if('_' %in% unlist(strsplit(x = cluster.df.name.suffix, split = ''))) {
    
    cat(crayon::cyan(paste0(Sys.time(), ': _ cannot be used in cluster.df.name.suffix, replacing with - \n')))
    cluster.df.name.suffix <- sub(pattern = '_', replacement = '-', x = cluster.df.name.suffix)
    
  }
  
  cat(crayon::cyan(paste0(Sys.time(), ': initialising SC3 clustering\n')))
  
  for(p in assay) {
    
    reduction.list <- list()
    red.names <- c(names(object@methods[[p]]@computational_reductions), 
                   names(object@methods[[p]]@integration_reductions),
                   names(object@methods[[p]]@visualisation_reductions))
    
    for(i in red.names) {
      
      if(i %in% names(object@methods[[p]]@computational_reductions)) {
        
        reduction.list[[i]] <- object@methods[[p]]@computational_reductions[[i]]
        
      }
      
      if(i %in% names(object@methods[[p]]@integration_reductions)) {
        
        reduction.list[[i]] <- object@methods[[p]]@integration_reductions[[i]]
        
      }
      
      if(i %in% names(object@methods[[p]]@visualisation_reductions)) {
        
        reduction.list[[i]] <- object@methods[[p]]@visualisation_reductions[[i]]
        
      }
      
    }
    
    for(r in reduction) {
      
      if(!r %in% names(reduction.list)) {
        
        stop('reductions could not be found\n')
        
      }
      
    }
    
    reduction.list <- reduction.list[reduction]
    
    count <- 1
    
    for(r in reduction) {
      
      red <- reduction.list[[r]]
      
      if(is.null(dims[[count]])) {
        
        dimen <- 1:ncol(red)
        
      } else {
        
        dimen <- 1:dims[[count]]
        
      }
      print('.')
      temp.2 <- SingleCellExperiment::SingleCellExperiment(list('logcounts' = t(red)[dimen,]))
      print('.')
      SummarizedExperiment::rowData(temp.2)$feature_symbol <- rownames(temp.2)
      print('.')
      temp.2 <- temp.2[!duplicated(SummarizedExperiment::rowData(temp.2)$feature_symbol), ]
      print('.')
      temp.2 <- SC3::sc3_prepare(temp.2, gene_filter = FALSE, n_cores = n.core)
      print('.')
      temp.2 <- SC3::sc3_calc_dists(temp.2)
      print('.')
      temp.2 <- SC3::sc3_calc_transfs(temp.2)
      print('.')
      temp.2 <- SC3::sc3_kmeans(temp.2, ks = ks)
      print('.')
      temp.2 <- SC3::sc3_calc_consens(temp.2)
      print('.')
      if(any(is.na(as.data.frame(SummarizedExperiment::colData(temp.2))))) {
        
        temp.2 <- SC3::sc3_run_svm(object = temp.2, ks = ks)
        
      }

      object@methods[[p]]@cluster_assignments[[paste0(r, ':SC3', cluster.df.name.suffix)]] <- as.data.frame(SummarizedExperiment::colData(temp.2))
      cat(crayon::cyan(paste0(Sys.time(), ': SC3 clustering completed\n')))
      count <- count + 1
      
    }
    
  }
  
  return(object)
  
}