R/01_score_functions.R

In jyoh1248/MyoSignature: Myocarditis signature proejct

#' cbind.all() Function
#'
#' @return data frame
#' @export
#' @examples
#' cbind.all()
#' 
cbind.all <- function (...) {
   nm <- list(...)
   nm <- lapply(nm, as.matrix)
   n <- max(sapply(nm, nrow)) 
   do.call(cbind, lapply(nm, function(x) rbind(x, matrix(,n-nrow(x), ncol(x)))))
}


#' get_score_by_group() Function
#'
#' This function calculate signature score from z score table (will be used inside function `table_to_score()`)
#' @param zscore_table : data frame containing z score
#' @param metadata : Metadata 
#' @param group_col : variable names of the group
#' @param direction : "byRow" to calculate per Gene, "byCol" to calculate per sample 
#' @return score
#' @export
#' @examples
#'  get_score_by_group(zscore_table,metadata,group_col, group,direction="byRow")
#' 
get_score_by_group <- function(zscore_table,metadata,group_col, group,direction="byRow"){

   metadata$selected_group <- eval(parse(text = paste0("metadata$`",group_col,"`")))
   #print(metadata)
   #print(group)
   #gp_samples <- metadata[which(metadata$selected_group == group),"BulkName"]
   gp_samples <- metadata$BulkName[which(metadata$selected_group == group)]
   
   #print(gp_samples)
   
   if(length(gp_samples)>0){
      gp_scores <- zscore_table[,which(names(zscore_table) %in% gp_samples),drop = FALSE]
      gp_scores <- gp_scores[complete.cases(gp_scores),,drop=FALSE ]

      if(direction == "byRow"){
         gp_scores <- (rowSums(gp_scores)*100)/(ncol(gp_scores)*100)

         gp_scores <- as.data.frame(gp_scores)
         names(gp_scores) <- paste0(group)
      } else {
         
         gp_scores <- (colSums(gp_scores)*100)/(nrow(gp_scores)*100)
         gp_scores <- as.data.frame(gp_scores)
         gp_scores$groups <- group

         names(gp_scores) <- c("score","groups")
      }
      
      return(gp_scores)
   }
   
   return(NULL)
}


#' table_to_score() Function
#'
#' This function calculate GENES score and SAMPLES score
#' @param zscore_final : data frame containing z score
#' @param samples_meta : Metadata 
#' @param group_col : variable names of the group
#' @return list of GENES score and  SAMPLES score
#' @export
#' @examples
#'  table_to_score(zscore_final,samples_meta,group_col)
#' 
table_to_score <- function(zscore_final,samples_meta,group_col){
   message(paste0("Grouping samples by: ",group_col))

   selected_groups <- eval(parse(text = paste0("samples_meta$`",group_col,"`")))
   selected_groups <- unique(selected_groups)
   
   message(paste0("Available groups: ",paste0(selected_groups,collapse = ", ")))
   message("")
   
   # calculate the scores for each group
   score_table_by_gene <- data.frame()
   score_table_by_sample <- data.frame()
   
   for(tmp_group in selected_groups){
      
      message(paste0(" * Processing ",tmp_group))
      
      message(paste0("   - calculating GENES score"))
      tmp_score_byGene <- get_score_by_group(zscore_final,samples_meta,"group",tmp_group,"byRow")
      message(paste0("   - calculating SAMPLES score"))
      tmp_score_bySample <- get_score_by_group(zscore_final,samples_meta,"group",tmp_group,"byCol")
      
      score_table_by_gene <- cbind.all(score_table_by_gene,tmp_score_byGene)
      score_table_by_sample <- rbind(score_table_by_sample,tmp_score_bySample)
      
      message("")
      
   }
   
   return(list(score_table_by_gene,score_table_by_sample))
}



# zscore_final <- zscore_covid_genes 
# samples_meta 
# group_col <- "group"
# test <- table_to_score(zscore_final,samples_meta,"group")