R/plotDSpwHeatmap.R

Defines functions plotDSpwHeatmap

Documented in plotDSpwHeatmap

##' plotDSpwHeatmap
##'
##' @title Plot heat map of the drug regulated subpathway activity score
##' @description The `plotDSpwHeatmap()` function plots a heat map of the subpathways that are regulated by specified drug and have
##' differential expression between specified cancer subtype and normal.
##' @param data A list of result data generated by function `PrioSubtypeDrug()`.
##' @param drug.label A character string of drug labels to determine which drug to use for visualization.
##' @param subtype.label Character string indicates which sample of the cancer subtype was used to plot the heat map.
##' @param show.rownames Boolean specifying if row names are be shown.
##' @param show.colnames Boolean specifying if column names are be shown.
##' @param color Vector of colors used in heatmap.
##' @param phen_colors Vector of colors is used to annotate the sample subtype and control sample.It should be assigned two colors.
##' @param border_color Color of cell borders on heatmap, use NA if no border should be drawn.
##' @param cellwidth Individual cell width in points. If left as NA, then the values depend on the size of plotting window.
##' @param cellheight Individual cell height in points. If left as NA, then the values depend on the size of plotting window.
##' @param fontsize Base fontsize for the plot (default: 10).
##' @param fontsize.row Fontsize for rownames (default: 10).
##' @param fontsize.col Fontsize for colnames (default: 10).
##' @param scale Character indicating if the values should be centered and scaled in either the row direction or the column direction, or none. Corresponding values are "row", "column" and "none".
##' @details
##' Based on the input cancer subtype, the program draws a heat map of the drug regulated subpathway activity
##' score. If the cancer subtype of input has sutype-specific drug score (SDS)<0,
##' we can observe the drug upregulatory subpathway is lowly expressed in the cancer subtype samples and high in the normal samples;
##' the drug downregulatory subpathway is highly expressed in the cancer subtype samples and low in the normal samples. This indicates that after the drug action,
##' these subpathways activity is converted from the level of the cancer subtype into the level of normal. If the cancer subtype of input has sutype-specific drug
##' score (SDS)>0, it is indicated that the drug action may promote the subpathway expression status of the cancer subtype.
##' @return A heat map.
##' @author Xudong Han,
##' Junwei Han,
##' Chonghui Liu
##' @examples
##' require(pheatmap)
##' ## Get the result data of PrioSubtypeDrug().
##' ## The data is based on the simulated breast cancer subtype data.
##' Subtype_drugs<-get("Subtype_drugs")
##' plotDSpwHeatmap(data=Subtype_drugs,drug.label="pirenperone(1.02e-05M)",subtype.label="Basal")
##' ##Visualize the results of only two types of samples.
##' Disease_drugs<-get("Disease_drugs")
##' plotDSpwHeatmap(data=Disease_drugs,drug.label="W-13(1e-05M)",subtype.label="Cancer")
##' @importFrom pheatmap pheatmap
##' @importFrom stats na.omit
##' @export
plotDSpwHeatmap<-function(data,drug.label="",subtype.label="",show.rownames = TRUE,show.colnames = TRUE,
                          color=NA,phen_colors=NA,border_color = "grey60",cellwidth = NA, cellheight = NA,fontsize = 10,fontsize.row = 10,fontsize.col = 10,scale = "row"){
   havepheatmap <- isPackageLoaded("pheatmap")
  if(havepheatmap==FALSE){
    stop("The 'pheatmap' library, should be loaded first")
  }

  phen<-names(table(data[["SampleInformation"]][["sampleSubtype"]]))
  phen<-phen[phen!=data[["Parameter"]][["control.label"]]]
  control.label<-data[["Parameter"]][["control.label"]]
  colork<-get("Colork")
  pp<-which(phen==subtype.label)

  if(is.na(phen_colors)==TRUE){
    sycolor<-c(colork[pp],"#3CB371")
  }else{
    sycolor<-phen_colors
  }

  names(sycolor)<-c(subtype.label,control.label)


  drugindex<-which(data[[subtype.label]]$Drug==drug.label)
  up_drug_spw<-unlist(strsplit(data[[1]]$Target_upregulation[drugindex]," "))
  down_drug_spw<-unlist(strsplit(data[[1]]$Target_downregulation[drugindex]," "))
  upspwindex<-match(up_drug_spw,row.names(data[["SubpathwayMatrix"]]))
  downspwindex<-match(down_drug_spw,row.names(data[["SubpathwayMatrix"]]))
  upspwindex<-na.omit(upspwindex)
  downspwindex<-na.omit(downspwindex)

  controlindex<-which(data[["SampleInformation"]][["sampleSubtype"]]==data[["Parameter"]][["control.label"]])
  control_length<-length(controlindex)

  phen_index<-which(data[["SampleInformation"]][["sampleSubtype"]]==subtype.label)
  phen_length<-length(phen_index)

  rt_matrix<-data[["SubpathwayMatrix"]][c(upspwindex,downspwindex),c(phen_index,controlindex)]
  contmeanup<-apply(rt_matrix[1:length(upspwindex),c((length(phen_index)+1):ncol(rt_matrix))],1,mean)
  contmeandown<-apply(rt_matrix[((length(upspwindex)+1):nrow(rt_matrix)),c((length(phen_index)+1):ncol(rt_matrix))],1,mean)
  phenmeanup<-apply(rt_matrix[1:length(upspwindex),c(1:length(phen_index))],1,mean)
  phenmeandown<-apply(rt_matrix[((length(upspwindex)+1):nrow(rt_matrix)),c(1:length(phen_index))],1,mean)
  if(data[[subtype.label]]$SDS[drugindex]<0){
    tqup<-which(phenmeanup<contmeanup)
    tqdown<-which(phenmeandown>contmeandown)
    upspwlength<-length(tqup)
    downspwlength<-length(tqdown)
  }else{
    tqup<-which(phenmeanup>contmeanup)
    tqdown<-which(phenmeandown<contmeandown)
    upspwlength<-length(tqup)
    downspwlength<-length(tqdown)
  }
  upn<-names(phenmeanup[tqup])
  downn<-names(phenmeandown[tqdown])
  rt_matrix<-rt_matrix[match(c(upn,downn),row.names(rt_matrix)),]

  rowann <- data.frame(Subpathway = factor(rep(c("upregulated_subpathway","downregulated_subpathway"),c(upspwlength,downspwlength))))
  rownames(rowann) <-row.names(rt_matrix)
  if(subtype.label=="all"){
    colann<-data.frame(Subtype=factor(rep(c(phen,data[["Parameter"]][["control.label"]]),c(phen_length,control_length))))
  }else{
    colann<-data.frame(Subtype=factor(rep(c(subtype.label,data[["Parameter"]][["control.label"]]),c(phen_length,control_length))))
  }
  sample_v<-colnames(rt_matrix)
  if(is.element(TRUE,duplicated(sample_v))==TRUE){

      sample_v<-paste(sample_v,seq(1:length(sample_v)),sep = "-")
      colnames(rt_matrix)<-sample_v
      row.names(colann)<-sample_v
    }else{
      row.names(colann)<-sample_v
    }

  ann_colors<-list(Subpathway=c(upregulated_subpathway="red",downregulated_subpathway="blue"),Subtype=sycolor)

  if(is.na(color)==TRUE){
    pheatmap(rt_matrix,cluster_rows=FALSE,cluster_cols=FALSE,annotation_row =rowann,annotation_col =colann,
             border_color=border_color,cellwidth=cellwidth,cellheight = cellheight,
            show_rownames=show.rownames, show_colnames=show.colnames,fontsize=fontsize, fontsize_row=fontsize.row,
            fontsize_col=fontsize.col,annotation_colors = ann_colors,main=paste("Heatmap of the activities of significant subpathways targeted by the",drug.label),
            gaps_col=cumsum(phen_length),gaps_row = upspwlength,scale=scale)
  }else{
    pheatmap(rt_matrix,cluster_rows=FALSE,cluster_cols=FALSE,annotation_row =rowann,annotation_col =colann,color=color,
             border_color=border_color,cellwidth=cellwidth,cellheight = cellheight,
            show_rownames=show.rownames, show_colnames=show.colnames,fontsize=fontsize, fontsize_row=fontsize.row,
            fontsize_col=fontsize.col,annotation_colors = ann_colors,main=paste("Heatmap of the activities of significant subpathways targeted by the",drug.label),
            gaps_col=cumsum(phen_length),gaps_row = upspwlength,scale=scale)
  }
}

Try the SubtypeDrug package in your browser

Any scripts or data that you put into this service are public.

SubtypeDrug documentation built on May 17, 2021, 9:09 a.m.