@@ -11,11 +11,10 @@

 #' @param nbreaks Number of bins to break yvector and xvector into.

 #' @param ybreak The values to break the yvector at.

 #' @param xbreak The values to break the xvector at.

-#' @param ret Boolean to return the observed data that would have been plotted.

 #' @param scale Scaling of circle bin sizes.

 #' @param local Boolean to shade by signficant bin numbers (TRUE) or overall proportion (FALSE).

 #' @param ... Additional plot arguments.

-#' @return If ret == TRUE, returns a matrix of features along rows, and the group membership along columns.

+#' @return A matrix of features along rows, and the group membership along columns.

 #' @seealso \code{\link{plotMRheatmap}}

 #' @examples

 #' 

@@ -30,7 +29,7 @@

 #' plotBubble(y,x)

 #'

 plotBubble<-function(yvector,xvector,sigvector=NULL,nbreaks=10, ybreak=quantile(yvector,p=seq(0,1,length.out=nbreaks)),

-    xbreak=quantile(xvector,p=seq(0,1,length.out=nbreaks)), ret=FALSE,scale=1,local=FALSE,...){

+    xbreak=quantile(xvector,p=seq(0,1,length.out=nbreaks)),scale=1,local=FALSE,...){

     ybreaks = cut(yvector,breaks=ybreak,include.lowest=TRUE)

     xbreaks = cut(xvector,breaks=xbreak,include.lowest=TRUE)

@@ -85,17 +84,13 @@ plotBubble<-function(yvector,xvector,sigvector=NULL,nbreaks=10, ybreak=quantile(

     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)

-    if(ret == TRUE){

-        res = cbind(as.character(ybreaks),as.character(xbreaks))

-        colnames(res) = c("yvector","xvector")

-        rownames(res) = names(yvector)

-        if(is.null(sigvector)){

-            return(res)

-        } else {

-            sig = rep(0,nrow(res))

-            sig[which(rownames(res)%in%sigvector)] = 1

-            res = cbind(res,sig)

-            return(res)

-        }

+    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)

     }

+    invisible(res)

 }

@@ -58,11 +58,11 @@ plotBubble<-function(yvector,xvector,sigvector=NULL,nbreaks=10, ybreak=quantile(

         if(local==TRUE){

             contSigTable = sapply(contSig,function(i){i})

             linMap <- function(x, a, b) approxfun(range(x), c(a, b))(x)

-            if(length(ybreak)!=length(xbreak)) {

+            if(length(levels(ybreak))!=length(levels(xbreak))) {

                 warning("Not square matrix - this is not implemented currently")

             }

-            contSigTable = matrix(linMap(contSigTable,a=0,b=1),nrow=length(ybreak))

-            for(i in 1:length(ybreak)){

+            contSigTable = matrix(linMap(contSigTable,a=0,b=1),nrow=length(levels(ybreaks)))

+            for(i in 1:length(levels(ybreaks))){

                     contSig[[i]] = contSigTable[,i]

             }

         }

@@ -32,8 +32,8 @@

 plotBubble<-function(yvector,xvector,sigvector=NULL,nbreaks=10, ybreak=quantile(yvector,p=seq(0,1,length.out=nbreaks)),

     xbreak=quantile(xvector,p=seq(0,1,length.out=nbreaks)), ret=FALSE,scale=1,local=FALSE,...){

-    ybreaks = cut(yvector,breaks=ybreak,include.lowest=T)

-    xbreaks = cut(xvector,breaks=xbreak,include.lowest=T)

+    ybreaks = cut(yvector,breaks=ybreak,include.lowest=TRUE)

+    xbreaks = cut(xvector,breaks=xbreak,include.lowest=TRUE)

     contTable = lapply(levels(xbreaks),function(i){

         k = which(xbreaks==i)

         sapply(levels(ybreaks),function(j){

@@ -9,10 +9,13 @@

 #' @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.

+#' @param ybreak The values to break the yvector at.

+#' @param xbreak The values to break the xvector at.

 #' @param ret Boolean to return the observed data that would have been plotted.

-#' @param scale Scaling of circle bins.

+#' @param scale Scaling of circle bin sizes.

+#' @param local Boolean to shade by signficant bin numbers (TRUE) or overall proportion (FALSE).

 #' @param ... Additional plot arguments.

-#' @return NA

+#' @return If ret == TRUE, returns a matrix of features along rows, and the group membership along columns.

 #' @seealso \code{\link{plotMRheatmap}}

 #' @examples

 #' 

@@ -21,10 +24,16 @@

 #' sparsity = rowMeans(MRcounts(mouseData)==0)

 #' lor = log(fitPA(mouseData,cl=pData(mouseData)[,3])$oddsRatio)

 #' plotBubble(lor,sparsity,main="lor ~ sparsity")

-#' 

-plotBubble<-function(yvector,xvector,sigvector=NULL,nbreaks=10,ret=FALSE,scale=1,...){

-    ybreaks = cut(yvector,breaks=quantile(yvector,p=seq(0,1,length.out=nbreaks)),include.lowest=T)

-    xbreaks = cut(xvector,breaks=quantile(xvector,p=seq(0,1,length.out=nbreaks)),include.lowest=T)

+#' # 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)),

+    xbreak=quantile(xvector,p=seq(0,1,length.out=nbreaks)), ret=FALSE,scale=1,local=FALSE,...){

+

+    ybreaks = cut(yvector,breaks=ybreak,include.lowest=T)

+    xbreaks = cut(xvector,breaks=xbreak,include.lowest=T)

     contTable = lapply(levels(xbreaks),function(i){

         k = which(xbreaks==i)

         sapply(levels(ybreaks),function(j){

@@ -46,6 +55,17 @@ plotBubble<-function(yvector,xvector,sigvector=NULL,nbreaks=10,ret=FALSE,scale=1

                 x

             })

         })

+        if(local==TRUE){

+            contSigTable = sapply(contSig,function(i){i})

+            linMap <- function(x, a, b) approxfun(range(x), c(a, b))(x)

+            if(length(ybreak)!=length(xbreak)) {

+                warning("Not square matrix - this is not implemented currently")

+            }

+            contSigTable = matrix(linMap(contSigTable,a=0,b=1),nrow=length(ybreak))

+            for(i in 1:length(ybreak)){

+                    contSig[[i]] = contSigTable[,i]

+            }

+        }

     } else {

         contSig = lapply(levels(xbreaks),function(i){

             k = which(xbreaks==i)

@@ -54,7 +74,7 @@ plotBubble<-function(yvector,xvector,sigvector=NULL,nbreaks=10,ret=FALSE,scale=1

             })

         })

     }

-    

+

     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",

@@ -64,7 +84,18 @@ plotBubble<-function(yvector,xvector,sigvector=NULL,nbreaks=10,ret=FALSE,scale=1

     }

     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)

+

     if(ret == TRUE){

-        return(cbind(xbreaks,ybreaks))

+        res = cbind(as.character(ybreaks),as.character(xbreaks))

+        colnames(res) = c("yvector","xvector")

+        rownames(res) = names(yvector)

+        if(is.null(sigvector)){

+            return(res)

+        } else {

+            sig = rep(0,nrow(res))

+            sig[which(rownames(res)%in%sigvector)] = 1

+            res = cbind(res,sig)

+            return(res)

+        }

     }

 }

new file mode 100644

@@ -0,0 +1,70 @@

+#' 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.

+#' @param ret Boolean to return the observed data that would have been plotted.

+#' @param scale Scaling of circle bins.

+#' @param ... Additional plot arguments.

+#' @return NA

+#' @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")

+#' 

+plotBubble<-function(yvector,xvector,sigvector=NULL,nbreaks=10,ret=FALSE,scale=1,...){

+    ybreaks = cut(yvector,breaks=quantile(yvector,p=seq(0,1,length.out=nbreaks)),include.lowest=T)

+    xbreaks = cut(xvector,breaks=quantile(xvector,p=seq(0,1,length.out=nbreaks)),include.lowest=T)

+    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

+            })

+        })

+    } else {

+        contSig = lapply(levels(xbreaks),function(i){

+            k = which(xbreaks==i)

+            sapply(levels(ybreaks),function(j){

+                1

+            })

+        })

+    }

+    

+    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)

+    if(ret == TRUE){

+        return(cbind(xbreaks,ybreaks))

+    }

+}