global_functions.R

#for faster rendering caching the computationally expensive functions
memoised_corAndPvalue <- memoise::memoise(function(...) corAndPvalue(...))

output_download_data <- function(mat, file) {  
  df <- cbind(data.frame(ID=rownames(mat)),
              as.data.frame(mat))
  write.csv(df, file, row.names=F, col.names=T)
}

get_eset_withcorrelated_genes <- function(geneIds, eset, corThreshold, corDirection='both'){
  
  expMatrix <- exprs(eset)
  flog.debug('Calculating correlated genes ....', name="server")

  #expression matrix with selected genes
  m1 <- expMatrix[rownames(expMatrix) %in% geneIds,]
  
  #expression matrix with which the selected genes will be correlated
  m2 <- expMatrix
  
  #calculate correlation
  res <- memoised_corAndPvalue(t(m1),t(m2),nThreads=4)
  cor <- round(res$cor,digits=3)
  
  # Force threshold to be positive, so not confused by negative values
  corThreshold <- abs(corThreshold)
  
  # Subset based on direction
  if (corDirection == 'positive') {
    cor <- cor >= corThreshold
  }
  else if (corDirection == 'negative') {
    cor <- cor <= -corThreshold
  }
  else if (corDirection == 'both') {
    cor <- abs(cor) >= corThreshold
  }
  else {
    cor <- abs(cor) >= corThreshold
  }
  
  #columns of the cor matrix which have correlation with some gene > corThreshold
  cols_to_select <- apply(cor,2,any)
  correlated_genes <- union(colnames(cor)[cols_to_select], rownames(m1))
  
  flog.debug('Done calculating correlated genes', name="server")
  
  eset[rownames(expMatrix) %in% correlated_genes,]
}

get_expMatrix_withcorrelated_genes <- function(geneIds, expMatrix, corThreshold, corDirection='both'){
  cat('Calculating correlated genes ....')  
  #expression matrix with selected genes
  m1 <- expMatrix[rownames(expMatrix) %in%  geneIds,]
  #expression matrix with which the selected genes will be correlated
  m2 <- expMatrix
  #calculate correlation
  res <- memoised_corAndPvalue(t(m1),t(m2),nThreads=4)
  cor <- round(res$cor,digits=3)
  
  # Force threshold to be positive, so not confused by negative values
  corThreshold <- abs(corThreshold)

  # Subset based on direction
  if (corDirection == 'positive') {
    cor <- cor >= corThreshold
  }
  else if (corDirection == 'negative') {
    cor <- cor <= -corThreshold
  }
  else if (corDirection == 'both') {
    cor <- abs(cor) >= corThreshold
  }
  else {
    cor <- abs(cor) >= corThreshold
  }
  
  #columns of the cor matrix which have correlation with some gene > corThreshold
  cols_to_select <- apply(cor,2,any)
  correlated_genes <- union(colnames(cor)[cols_to_select], rownames(m1))
  cat('Done','\n')
  expMatrix[rownames(expMatrix) %in% correlated_genes,]
}


#filter metadata
get_filtered_metadata <- function(input, metadata){
  filtered_metadata <- metadata
  
  if( length(input$linetype) != 0 ){
    filtered_metadata <- subset(filtered_metadata, Cell_Line_Type %in% input$linetype)
  }
  if( length(input$gene_combination) != 0 ){
    filtered_metadata <- subset(filtered_metadata, Reprogramming_Gene_Combination %in% input$gene_combination)  
  }
  if(length(input$vector_type) != 0){
    filtered_metadata <- subset(filtered_metadata, Reprogramming_Vector_Type %in% input$vector_type)
  }
  if(length(input$tissue_origin) != 0){
    filtered_metadata <- subset(filtered_metadata, Tissue_of_Origin %in% input$tissue_origin)
  }
  if(length(input$diff_state) != 0){
    filtered_metadata <- subset(filtered_metadata, Differentiation_State %in% input$diff_state)
  }
  if(length(input$cell_origin) != 0){
    filtered_metadata <- subset(filtered_metadata, Cell_Type_of_Origin %in% input$cell_origin)
  }
  if(length(input$originating_lab_id) != 0){
    filtered_metadata <- subset(filtered_metadata, Originating_Lab_ID %in% input$originating_lab_id)
  }
  
  filtered_metadata
}

filter_by_metadata <- function(input, eset){
  filtered_metadata <- pData(eset)
  
  if( length(input$linetype) != 0 ){
    filtered_metadata <- subset(filtered_metadata, Cell_Line_Type %in% input$linetype)
  }
  if( length(input$gene_combination) != 0 ){
    filtered_metadata <- subset(filtered_metadata, Reprogramming_Gene_Combination %in% input$gene_combination)  
  }
  if(length(input$vector_type) != 0){
    filtered_metadata <- subset(filtered_metadata, Reprogramming_Vector_Type %in% input$vector_type)
  }
  if(length(input$tissue_origin) != 0){
    filtered_metadata <- subset(filtered_metadata, Tissue_of_Origin %in% input$tissue_origin)
  }
  if(length(input$diff_state) != 0){
    filtered_metadata <- subset(filtered_metadata, Diffname_short %in% input$diff_state)
  }
  if(length(input$cell_origin) != 0){
    filtered_metadata <- subset(filtered_metadata, Cell_Type_of_Origin %in% input$cell_origin)
  }
  if(length(input$originating_lab) != 0){
    filtered_metadata <- subset(filtered_metadata, Originating_Lab %in% input$originating_lab)
  }
  if(length(input$gender) != 0){
    filtered_metadata <- subset(filtered_metadata, Gender %in% input$gender)
  }
  
  eset[, rownames(filtered_metadata)]
}


#create the annotation data frame for the heatmap
get_filteredAnnotation <- function(input,metadata){
  if(length(input$heatmap_annotation_labels) == 0){
    stop('please select atleast one heatmap annotation variable \n\n')      
  }
  else{
    annotation <- metadata[,c(input$heatmap_annotation_labels),drop=F]
    # rownames(annotation) <- metadata$Sample
    annotation
  }
}

get_heatmapAnnotation <- function(heatmap_annotation_labels, metadata){
  if(length(heatmap_annotation_labels) == 0){
    stop('please select atleast one heatmap annotation variable \n\n')      
  }
  else{
    annotation <- metadata[, heatmap_annotation_labels, drop=F]
    annotation
  }
}

clean_list <- function(x, change_case=toupper) {
  # Split by space, comma or new lines
  x <- unlist(strsplit(x, split=c('[\\s+,\\n+\\r+)]'),perl=T))
  
  # convert everything to specified case
  x <- change_case(x)
  
  # remove the blank entries
  x <- x[!(x == "")]
  
  x
}