R/plotSpwACmap.R

In psSubpathway: Flexible Identification of Phenotype-Specific Subpathways

##' plotSpwACmap
##'
##'
##' @title Plot subpathway activity change map
##' @description Plot a box diagram and heat map of subpathway activity in each phenotype.
##' @param inputdata A list of result data generated by function `SubSEA` or `DCSA`.
##' @param spwid The subpathway id which the user wants to plot.
##' @details
##' Plot a box diagram of subpathway activity in each Phenotype and a heat map of the distribution of the phenotypic samples in the activity of the subpathways.
##' The subpathway activity change map includes subpathway active change box plot and subpathway active change. Each row in the heat map is all samples of a phenotype.
##' These samples are distributed in the subpathway high activity value area label is red, and the distribution in the low expression value area label is blue.
##' @return a plot

##' @author Xudong Han,
##' Junwei Han,
##' Qingfei Kong
##' @examples
##' # get the Subspwresult which is the result of SubSEA method.
##' Subspwresult<-get("Subspwresult")
##' # plot the subpathway 00120_9 in the SubSEA function result.
##' plotSpwACmap(Subspwresult,spwid="00120_9")
##' # get the DCspwresult which is the result of DCSA method.
##' DCspwresult<-get("DCspwresult")
##' # plot the subpathway 00982_2 in the DCSA function result.
##' plotSpwACmap(DCspwresult,spwid="00982_2")
##' @importFrom graphics par
##' @importFrom graphics boxplot
##' @importFrom graphics image
##' @importFrom graphics axis
##' @importFrom graphics mtext
##' @export
plotSpwACmap<-function(inputdata,spwid=""){
  spwmatrix<-inputdata$spwmatrix
  cnames<-colnames(spwmatrix)
  rnames<-row.names(spwmatrix)
  phen<-names(table(cnames))
  pl<-length(phen)

  A.r <- length(spwmatrix[,1])
  A.c <- length(spwmatrix[1,])

  gsindex<-which(rnames==spwid)
  qdspw<-spwmatrix[gsindex,]

  par(mfrow=c(1,2),oma = c(0, 0, 3, 0))
  group<-data.frame(spw=qdspw,samp=cnames)
  boxplot(spw~samp,group,col=c(2:(pl+1)),xlab="Activity change box-plot",
          ylab = "Subpathway activity")

  retux<-matrix(NA,nrow = pl,ncol = A.c)
  ordindex<-order(qdspw,decreasing = T)
  correl<-qdspw[ordindex]
  ordsample<-cnames[ordindex]
  revphen<-rev(phen)
  for(p in 1:pl){
    ppindex<-which(ordsample==revphen[p])
    retux[p,ppindex]<-correl[ppindex]
  }
  row.names(retux)<-revphen
  colnames(retux)<-ordsample

  n.rows<-length(retux[,1])
  n.cols<-length(retux[1,])
  rnames1<-row.names(retux)
  cnames1<-colnames(retux)
  mycol <-rev(c("#FF0000", "#FF0D1D", "#FF4040", "#FF5A5A", "#FF7080", "#FF9DB0", "#FFAADA", "#EEE5EE", "#D5D5FF", "#A9A9FF", "#8888FF", "#7070FF", "#4040FF", "#0000FF","#0000FF"))
  image(1:n.cols, 1:n.rows, t(retux), col=mycol, axes=FALSE,xlab="Activity change heat map (red:high activity value,blue:opposite)", ylab=" ")
  axis(2, at=1:n.rows , labels=rnames1, adj= 0.5, tick=FALSE, las = 1, font.axis=2, line=-1)
  size.col.char <- 35/(n.cols + 5)
  axis(1, at=1:n.cols, labels=cnames1, tick=FALSE, las = 3,cex.axis=size.col.char, font.axis=2, line=-1)
  mtext(paste("Subpathway:",spwid,"activity change map"), side = 3, line = 0, outer = T,font=2)
}