R/plotBubble.R
 65e0e07d ``` #' Basic plot of binned vectors. #' #' This function plots takes two vectors, calculates the contingency table and #' plots circles sized by the contingency table value. Optional significance vectors #' of the values significant will shade the circles by proportion of significance. #' #' #' @param yvector A vector of values represented along y-axis. #' @param xvector A vector of values represented along x-axis. #' @param sigvector A vector of the names of significant features (names should match x/yvector). #' @param nbreaks Number of bins to break yvector and xvector into. ``` f968d844 ``` #' @param ybreak The values to break the yvector at. #' @param xbreak The values to break the xvector at. #' @param scale Scaling of circle bin sizes. #' @param local Boolean to shade by signficant bin numbers (TRUE) or overall proportion (FALSE). ``` 65e0e07d ``` #' @param ... Additional plot arguments. ``` ad9f1d3c ``` #' @return A matrix of features along rows, and the group membership along columns. ``` 65e0e07d ``` #' @seealso \code{\link{plotMRheatmap}} #' @examples #' #' data(mouseData) #' mouseData = mouseData[which(rowSums(mouseData)>139),] #' sparsity = rowMeans(MRcounts(mouseData)==0) #' lor = log(fitPA(mouseData,cl=pData(mouseData)[,3])\$oddsRatio) #' plotBubble(lor,sparsity,main="lor ~ sparsity") ``` f968d844 ``` #' # Example 2 #' x = runif(100000) #' y = runif(100000) #' plotBubble(y,x) #' plotBubble<-function(yvector,xvector,sigvector=NULL,nbreaks=10, ybreak=quantile(yvector,p=seq(0,1,length.out=nbreaks)), ``` ad9f1d3c ``` xbreak=quantile(xvector,p=seq(0,1,length.out=nbreaks)),scale=1,local=FALSE,...){ ``` f968d844 ``` ``` 6dea2e5d ``` ybreaks = cut(yvector,breaks=ybreak,include.lowest=TRUE) xbreaks = cut(xvector,breaks=xbreak,include.lowest=TRUE) ``` 65e0e07d ``` contTable = lapply(levels(xbreaks),function(i){ k = which(xbreaks==i) sapply(levels(ybreaks),function(j){ length(which(ybreaks[k]==j)) }) }) names(contTable) = levels(xbreaks) yvec = 1:length(levels(ybreaks)) nc = length(yvec) if(!is.null(sigvector)){ # I am calculating contTable twice if sigvector==TRUE # This can be changed to if else statement to return two rows contSig = lapply(levels(xbreaks),function(i){ k = which(xbreaks==i) sapply(levels(ybreaks),function(j){ x = sum(names(yvector[k])[which(ybreaks[k]==j)]%in%sigvector)/length(which(ybreaks[k]==j)) if(is.na(x)) x = 0 x }) }) ``` f968d844 ``` if(local==TRUE){ contSigTable = sapply(contSig,function(i){i}) linMap <- function(x, a, b) approxfun(range(x), c(a, b))(x) ``` 7ec77ed5 ``` if(length(levels(ybreak))!=length(levels(xbreak))) { ``` f968d844 ``` warning("Not square matrix - this is not implemented currently") } ``` 7ec77ed5 ``` contSigTable = matrix(linMap(contSigTable,a=0,b=1),nrow=length(levels(ybreaks))) for(i in 1:length(levels(ybreaks))){ ``` f968d844 ``` contSig[[i]] = contSigTable[,i] } } ``` 65e0e07d ``` } else { contSig = lapply(levels(xbreaks),function(i){ k = which(xbreaks==i) sapply(levels(ybreaks),function(j){ 1 }) }) } ``` f968d844 ``` ``` 65e0e07d ``` medianSizes = median(unlist(contTable)) plot(y=yvec,x=rep(1,nc),cex=scale*contTable[[1]]/medianSizes, xlim=c(-0.25,nc+.25),ylim=c(-0.25,nc+.25),bty="n",xaxt="n",yaxt="n", xlab="",ylab="",pch=21,...,bg=rgb(blue=1,red=0,green=0,alpha=contSig[[1]])) for(i in 2:length(contTable)){ points(y=yvec,x=rep(i,nc),cex =scale*contTable[[i]]/medianSizes,pch=21,bg=rgb(blue=1,red=0,green=0,alpha=contSig[[i]])) } axis(1,at = 1:nc,labels=levels(xbreaks),las=2,cex.axis=.5) axis(2,at = 1:nc,labels=levels(ybreaks),las=2,cex.axis=.5) ``` f968d844 ``` ``` ad9f1d3c ``` res = cbind(as.character(ybreaks),as.character(xbreaks)) colnames(res) = c("yvector","xvector") rownames(res) = names(yvector) if(is.null(sigvector)){ sig = rep(0,nrow(res)) sig[which(rownames(res)%in%sigvector)] = 1 res = cbind(res,sig) ``` 65e0e07d ``` } ``` ad9f1d3c ``` invisible(res) ``` 65e0e07d ``` } ```