Evaluate the percent contribution of categorical and continuous covariates using dimensionally reduced data from read counts

evaluate_covariates.R

evaluate.covariates<-function(x,pc.percents,continuous,categorical){

  covariate.contribution<-function(x,continuous,categorical){
  
    #asinh transform continuous covariates
    asinh.continuous <- lapply(continuous,asinh)
    asinh.continuous <- as.data.frame(do.call(cbind,asinh.continuous))
    
  
    #discretize cateogorical covariates to perform lm
    disc.categorical <- lapply(lapply(categorical,as.numeric),function(x){x-1})
    disc.categorical <- do.call(cbind,disc.categorical)
  
  #   #combine x,continuous, categorical as data frome
    #for lmFit usage
    lm.data <- cbind(x,asinh.continuous,disc.categorical)
    cov.names <- c(colnames(continuous),colnames(categorical))
      
    
    #loop through dimensions and perform lm
    #on lm.data object
    r.squared.values <- list()
    for(i in 1:ncol(x)){
      r.squared.values[[i]] <- unlist(lapply(lm.data[,cov.names],function(covariate) summary(lm(lm.data[,i] ~ covariate))$r.squared))
    }
    
    r.squared.values <- do.call(cbind,r.squared.values)
    colnames(r.squared.values)<-colnames(x)
    r.squared.values
  }
  
  r.squared.values <- covariate.contribution(x,continuous,categorical)
  
  contribution<-function(x,r.squared.values,pc.percents){
    require(plyr)
    require(reshape2)
    weighted.contribution<-sweep(r.squared.values, MARGIN=2, STATS=pc.percents, FUN='*')
    weighted.sum<-rowSums(weighted.contribution)
  
    colnames(r.squared.values)<-colnames(x)
    rownames(r.squared.values)<-paste(rownames(r.squared.values),round(weighted.sum,2),sep = " : ")
  
    heatmap.data<-melt(r.squared.values)
    colnames(heatmap.data)<-c("Covariate","dim","R2")
    heatmap.data
  }
  
  return(contribution(x,r.squared.values,pc.percents))

}

#example:
# heatmap.data<-evaluate.covariates(pc.from.rld,pc.percents,meta.data[,c("age","PMI","pH","RIN","Qual")],meta.data[,c("statut","sex","Run")])
# 
# ggplot(heatmap.data, aes(Covariate, dim, group=dim)) +
#   geom_tile(aes(fill = R2)) + 
#   geom_text(aes(fill = heatmap.data$R2, label = round(heatmap.data$R2, 2))) +
#   scale_fill_gradient(low = "white", high = "red") + labs(x = "Covariates and Weighted Sum of R^2 Value", y = "dim and percent variance")+ggtitle("R^2 Value for dim-Covariate  Regression \n")+
#   theme(axis.text.x  =  element_text(face="bold", colour="#990000", vjust=0.5, size=10),axis.text.y  =  element_text(face="bold", colour="#990000", vjust=0.5, size=10),
#         axis.title.x = element_text(face="bold",size=12),axis.title.y = element_text(face="bold",size=12))