In jyyulab/NetBID: Network-based Bayesian Inference of Drivers, version 2

library(NetBID2)
library(kableExtra)

dt <- pData(eset)
if(nrow(dt)<20){
kableExtra::kable(dt,align = "c") %>%
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover", "condensed")) %>%
  kableExtra::scroll_box(width = "100%", height = "100%")
}else{
  kableExtra::kable(dt,align = "c") %>%
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover", "condensed")) %>%
  kableExtra::scroll_box(width = "100%", height = "500px")
}

This eSet contains r nrow(use_mat) probes/transcripts/genes in r ncol(use_mat) samples, in which r length(intgroup) sample class: r intgroup will used for basic clustering analysis.

Part I: Heatmap between samples

Distance between samples is calculated by dist2().

if('heatmap' %in% choose_plot){
  nrow <- ceiling(length(intgroup)/2)
  par(mfrow = c(nrow, 2))
  par(mar = c(6, 6, 6, 6))
  m <- dist2.mod(use_mat)
  res <- draw.heatmap(mat=m,phenotype_info = pData(eset),use_phe=intgroup,
                      pre_define = pre_define)
}else{
  message('No selection for Heatmap!')
}

Part II: Dimension Reduction plot for samples

Original expression matrix is transformed and first two components/dimensions are visualized.

emb_plot <- intersect(choose_plot,c('pca','mds','umap'))
if(length(emb_plot)>0){
  if(emb_plot_type=='2D.interactive') {
    l <- htmltools::tagList()
      for(each_emb_method in emb_plot){
        for (i in 1:length(intgroup)) {
             w1 <- unique(get_obs_label(pData(eset),intgroup[i]))
              if(length(w1)<=6){
                l[[i]] <- draw.emb.kmeans(use_mat,embedding_method=each_emb_method,obs_label=get_obs_label(pData(eset),intgroup[i]),
                                 verbose=FALSE,main=intgroup[i],plot_type = emb_plot_type,use_color=use_color,pre_define=pre_define)
       }else{
         message(sprintf('No support for original clusters size larger than 6 (here %s has %s unique groups), please directly call draw.emb.kmeans() or draw.2D.interactive() for visualization! ',intgroup[i],length(w1)))
       }
      }
    }
    plotly:::layout(l)
  }
}else{
    message('No selection for Embedding (pca,mds,umap) plot!')
}

emb_plot <- intersect(choose_plot,c('pca','mds','umap'))
if(length(emb_plot)>0){
  for(each_emb_method in emb_plot){
  if(emb_plot_type!='2D.interactive') {
      pp <- 0.3+0.7-(ncol(use_mat)-10)*(0.7/900)
      if(ncol(use_mat)<=10) pp <- 1
      if(ncol(use_mat)>1000) pp <- 0.3
      for (i in 1:length(intgroup)) {
       tmp1 <- draw.emb.kmeans(use_mat,embedding_method=each_emb_method,obs_label=get_obs_label(pData(eset),intgroup[i]),
                               verbose=FALSE,point_cex=pp,main=intgroup[i],plot_type = emb_plot_type)
     }
  }
  }
}else{
    message('No selection for Embedding (pca,mds,umap) plot!')
}

Part III: Boxplot

The boxplot for the expression value in each sample is displayed with colored grouped by the sample class.

par(mar=c(4,10,4,10))
for(i in 1:base::length(intgroup)){
      class_label <- get_obs_label(Biobase::pData(eset),intgroup[i])
      cls_cc <- get.class.color(class_label,use_color=use_color,pre_define=pre_define) ## get color for each label
      graphics::boxplot(use_mat,col = cls_cc,ylab = "",xlab='Value',main = sprintf('Boxplot for %s',intgroup[i]),
                     ylim=c(base::min(use_mat,na.rm=TRUE),
                            base::max(use_mat,na.rm=TRUE)),horizontal=TRUE,las=2)
      pp <- par()$usr
      legend(pp[2],pp[4],legend=base::unique(class_label),
             fill = cls_cc[base::unique(class_label)],
             xpd = TRUE,border = NA,bty = 'n',horiz = FALSE)
}

Part IV: Density plot

The density for the expression value in each sample is displayed with colored grouped by the sample class.

if('density' %in% choose_plot){
nrow <- ceiling(length(intgroup)/2)
par(mfrow = c(nrow, 2))
par(mar = c(3, 3, 3, 3))
for(i in 1:length(intgroup)){
      all_dens <- list()
      for (j in 1:ncol(use_mat)) {
        all_dens[[j]] <- density(use_mat[,j],na.rm=TRUE)
      }
      plot(1,col = 'white',xlim=c(min(unlist(lapply(all_dens,function(x)min(x$x,na.rm=TRUE))),na.rm=TRUE),
                                  max(unlist(lapply(all_dens,function(x)max(x$x,na.rm=TRUE))),na.rm=TRUE)),
           type = 'l',xlab = "",ylab='Density',main = sprintf('Density plot for %s',intgroup[i]),
           ylim=c(min(unlist(lapply(all_dens,function(x)min(x$y,na.rm=TRUE))),na.rm=TRUE),
                  max(unlist(lapply(all_dens,function(x)max(x$y,na.rm=TRUE))),na.rm=TRUE)))
      class_label <- pData(eset)[,intgroup[i]]
      cls_cc <- get.class.color(class_label)
      for (j in 1:ncol(use_mat)) {
        lines(all_dens[[j]], col = cls_cc[j])
      }
      legend('topright',legend=unique(class_label),
             fill = cls_cc[unique(class_label)],
             xpd = TRUE,border = NA,bty = 'n',horiz = FALSE)
}
}else{
  message('No selection for Density plot!')
}

Part V: Correlation plot (r correlation_strategy)

if('correlation' %in% choose_plot){
  par(mar=c(3,3,3,3))
  for(i in 1:length(intgroup)){
    class_label <- get_obs_label(pData(eset),intgroup[i])
    draw.correlation(use_mat,class_label,main=intgroup[i],correlation_strategy=correlation_strategy,plot_all_point=plot_all_point)
  }
}else{
  message('No selection for Correlation plot!')
}

Part VI: MeanSd Plot

if('meansd' %in% choose_plot){
  res <- draw.meanSdPlot(eset)
}else{
  message('No selection for MeanSd plot!')
}

jyyulab/NetBID documentation built on Dec. 23, 2024, 6:34 a.m.