Skip to content

Commit

Permalink
Merge branch 'release/1.3.0'
Browse files Browse the repository at this point in the history
epurdom committed May 25, 2017

Verified

This commit was created on GitHub.com and signed with GitHub’s verified signature. The key has expired.
2 parents c5f9282 + 453d95b commit 19ecc5e
Showing 17 changed files with 537 additions and 24 deletions.
2 changes: 1 addition & 1 deletion .travis.yml
Original file line number Diff line number Diff line change
@@ -31,7 +31,7 @@ notifications:

## Use patched devtools
r_github_packages:
- hadley/devtools
- hadley/devtools@efa894ffa

## Code coverage
r_packages:
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: clusterExperiment
Title: Compare Clusterings for Single-Cell Sequencing
Version: 1.2.0
Version: 1.3.0
Description: Provides functionality for running and comparing many
different clusterings of single-cell sequencing data or other large mRNA Expression data sets.
Authors@R: c(person("Elizabeth", "Purdom", email = "epurdom@stat.berkeley.edu",
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -46,6 +46,7 @@ exportMethods(nClusters)
exportMethods(nFeatures)
exportMethods(nSamples)
exportMethods(orderSamples)
exportMethods(plotBarplot)
exportMethods(plotClusters)
exportMethods(plotCoClustering)
exportMethods(plotDendrogram)
13 changes: 12 additions & 1 deletion NEWS
Original file line number Diff line number Diff line change
@@ -1,6 +1,17 @@
Changes in version 1.2.0 ( Release date: 2017-04-04 )
Changes in version 1.3.0 ( Release date: 2017-05-24 )
==============
Changes:
* `plotHeatmap` accepts `data.frame` or `ExpressionSet` objects for the data argument (calls `data.matrix` or `exprs` on object and sends to matrix version)
* Added `plotBarplot` to plot a barplot for 1 cluster or comparison of 2 clusters along with tests.
* Added `whichClusters` argument to `clusterMatrix` to return only clusters corresponding to certain clusters. Mainly relevant for using arguments like `workflow` that are used by other commands (otherwise could just index the complete matrix manually...)

Bug fixes:
* `plotHeatmap` now goes through the `clusterLegend` input and removes levels that do not exist in the sampleData; this was causing incorrect coloring when the `clusterLegend` had more (or less) levels that it assigned color to than the `sampleData` did (e.g. if `sampleData` was a subset of larger dataset upon which the original colors were assigned.) NOTE: that this now has the effect of NOT plotting all values in the clusterLegend if they are not represented in the data, thus changing the previous behavior of `plotHeatmap` legend.
* fixed bug in how `plotHeatmap` checked that the dimensions of user-supplied dendrogram match that of data (matrix version).
* fixed `convertClusterLegend` so when `output` is `matrixNames` or `matrixColors`, the resulting matrix has the `colnames` equal to cluster labels, like `clusterMatrix`.

Changes in version 1.2.0 ( Release date: 2017-04-04 )
==============
Changes:
* RSEC now has option `rerunClusterMany`, which if FALSE will not rerun the clusterMany step if RSEC is called on an existing clusterExperiment object (assuming of course, clusterMany has been run already on the object)
* setBreaks now has option `makeSymmetric` to force symmetric breaks around zero when using the quantile option.
10 changes: 9 additions & 1 deletion R/AllGenerics.R
Original file line number Diff line number Diff line change
@@ -170,6 +170,14 @@ setGeneric(
}
)

setGeneric(
name="plotBarplot",
def=function(clusters, whichClusters,...)
{
standardGeneric("plotBarplot")
}
)

setGeneric(
name="plotHeatmap",
def=function(data,...)
@@ -194,7 +202,7 @@ setGeneric(

setGeneric(
name = "clusterMatrix",
def = function(x) {
def = function(x,whichClusters) {
standardGeneric("clusterMatrix")
}
)
37 changes: 35 additions & 2 deletions R/AllHelper.R
Original file line number Diff line number Diff line change
@@ -183,16 +183,49 @@ setMethod(
)

#' @rdname ClusterExperiment-methods
#' @param whichClusters optional argument that can be either numeric or
#' character value. If numeric, gives the indices of the \code{clusterMatrix}
#' to return; this can also be used to defined an ordering for the
#' clusterings. \code{whichClusters} can be a character value identifying the
#' \code{clusterTypes} to be used, or if not matching \code{clusterTypes} then
#' \code{clusterLabels}; alternatively \code{whichClusters} can be either
#' 'all' or 'workflow' to indicate choosing all clusters or choosing all
#' \code{\link{workflowClusters}}. If missing, the entire matrix of all
#' clusterings is returned.
#' @return \code{clusterMatrix} returns the matrix with all the clusterings.
#' @export
#' @aliases clusterMatrix
setMethod(
f = "clusterMatrix",
signature = "ClusterExperiment",
definition = function(x) {
signature = c("ClusterExperiment","missing"),
definition = function(x,whichClusters) {
return(x@clusterMatrix)
}
)
#' @rdname ClusterExperiment-methods
#' @return \code{clusterMatrix} returns the matrix with all the clusterings.
#' @export
#' @aliases clusterMatrix
setMethod(
f = "clusterMatrix",
signature = c("ClusterExperiment","numeric"),
definition = function(x,whichClusters) {
return(x@clusterMatrix[,whichClusters,drop=FALSE])
}
)
#' @rdname ClusterExperiment-methods
#' @return \code{clusterMatrix} returns the matrix with all the clusterings.
#' @export
#' @aliases clusterMatrix
setMethod(
f = "clusterMatrix",
signature = c("ClusterExperiment","character"),
definition = function(x,whichClusters) {
wh<-.TypeIntoIndices(x,whClusters=whichClusters)
return(clusterMatrix(x,whichClusters=wh))
}
)


#' @rdname ClusterExperiment-methods
#' @return \code{primaryCluster} returns the primary clustering (as numeric).
18 changes: 17 additions & 1 deletion R/mergeClusters.R
Original file line number Diff line number Diff line change
@@ -198,7 +198,7 @@ setMethod(f = "mergeClusters",
}
)

.plotMerge<-function(dendro,mergeOutput,plotType,mergeMethod,clusterLegendMat=NULL,...){
.plotMerge<-function(dendro,mergeOutput,plotType,mergeMethod,clusterLegendMat=NULL,dendroSamples=NULL,...){
sigInfo<-mergeOutput$propDE
whToMerge<-which(sigInfo$Merged)
nodesToMerge<-sigInfo$Node[whToMerge]
@@ -247,6 +247,22 @@ setMethod(f = "mergeClusters",
ape::plot.phylo(phyloObj, show.node=TRUE, edge.lty=edgeLty, tip.color=tip.color,...)
}
}
## If want to try to add plotCluster information, from example of phydataplot in ape package:
# ## use type = "mosaic" on a 30x5 matrix:
# tr <- rtree(n <- 30)
# p <- 5
# x <- matrix(sample(3, size = n*p, replace = TRUE), n, p)
# dimnames(x) <- list(paste0("t", 1:n), LETTERS[1:p])
# plot(tr, x.lim = 35, align.tip = TRUE, adj = 1)
# phydataplot(x, tr, "m", 2)
# ## change the aspect:
# plot(tr, x.lim = 35, align.tip = TRUE, adj = 1)
# phydataplot(x, tr, "m", 2, width = 2, border = "white", lwd = 3, legend = "side")
# ## user-defined colour:
# f <- function(n) c("yellow", "blue", "red")
# phydataplot(x, tr, "m", 18, width = 2, border = "white", lwd = 3,
# legend = "side", funcol = f)


#' @rdname mergeClusters
#' @export
227 changes: 227 additions & 0 deletions R/plotBarplot.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,227 @@
#' Barplot of 1 or 2 clusterings
#'
#' Make a barplot of sample's assignments to clusters for single clustering, or
#' cross comparison for two clusterings.
#'
#' @aliases plotBarplot
#' @docType methods
#' @param clusters A matrix of with each column corresponding to a clustering
#' and each row a sample or a \code{\link{ClusterExperiment}} object.
#' @param colPalette a vector of colors used for the different clusters. Must be
#' as long as the maximum number of clusters found in any single
#' clustering/column given in \code{clusters} or will otherwise return an
#' error.
#' @param xNames names for the first clusters (on x-axis). By default uses
#' values in 1st cluster of clusters matrix
#' @param legNames names for the first clusters (in legend). By default uses
#' values in 2nd cluster of clusters matrix
#' @param legend whether to plot the legend
#' @param xlab label for x-axis. By default or if equal NULL the column name of
#' the 1st cluster of clusters matrix
#' @param legend.title label for legend. By default or if equal NULL the column
#' name of the 2st cluster of clusters matrix
#' @param labels if clusters is a clusterExperiment object, then labels defines
#' whether the clusters will be identified by their names values in
#' clusterLegend (labels="names", the default) or by their clusterIds value in
#' clusterLegend (labels="ids").
#' @param ... for \code{plotBarplot} arguments passed either to the method
#' of \code{plotBarplot} for matrices or ultimately to \code{\link{barplot}}.
#' @details The first column of the cluster matrix will be on the x-axis and the
#' second column will separate the groups of the first column.
#' @details All arguments of the matrix version can be passed to the
#' \code{ClusterExperiment} version. As noted above, however, some arguments
#' have different interpretations.
#' @details If \code{whichClusters = "workflow"}, then the most recent two
#' clusters of the workflow will be chosen where recent is based on the
#' following order (most recent first): final, mergeClusters, combineMany,
#' clusterMany.
#'
#' @author Elizabeth Purdom
#' @inheritParams plotClusters,ClusterExperiment,character-method

#' @export
#'
#' @examples
#' #clustering using pam: try using different dimensions of pca and different k
#' data(simData)
#'
#' cl <- clusterMany(simData, nPCADims=c(5, 10, 50), dimReduce="PCA",
#' clusterFunction="pam", ks=2:4, findBestK=c(TRUE,FALSE),
#' removeSil=c(TRUE,FALSE))
#'
#' plotBarplot(cl)
#' plotBarplot(cl,whichClusters=1:2)
#'
#' @rdname plotBarplot
setMethod(
f = "plotBarplot",
signature = signature(clusters = "ClusterExperiment",whichClusters="character"),
definition = function(clusters, whichClusters,...)
{
wh<-head(.TypeIntoIndices(clusters,whClusters=whichClusters),2)
return(plotBarplot(clusters,whichClusters=wh,...))

})

#' @rdname plotBarplot
#' @export
setMethod(
f = "plotBarplot",
signature = signature(clusters = "ClusterExperiment",whichClusters="missing"),
definition = function(clusters, whichClusters,...)
{
plotBarplot(clusters,whichClusters="primaryCluster")

})

#' @rdname plotBarplot
#' @export
setMethod(
f = "plotBarplot",
signature = signature(clusters = "ClusterExperiment",whichClusters="numeric"),
definition = function(clusters, whichClusters,labels=c("names","ids"),...)
{
labels<-match.arg(labels)
legend<-clusterLegend(clusters)[[tail(whichClusters,1)]]
colPalette<-legend[,"color"]
numClusterMat<-clusterMatrix(clusters,whichClusters=whichClusters)
if(labels=="names"){
clusterMat<-convertClusterLegend(clusters,output="matrixNames")[,whichClusters]
names(colPalette)<-legend[,"name"]
#make sure "-1" stays "-1"
clusterMat[numClusterMat== -1]<- "-1"
clusterMat[numClusterMat== -2]<- "-2"
if(any(legend[,"clusterIds"]== "-1")){
names(colPalette)[which(legend[,"clusterIds"]== "-1")]<-"-1"
}
if(any(legend[,"clusterIds"]== "-2")){
names(colPalette)[which(legend[,"clusterIds"]== "-2")]<-"-2"
}
}
else{
clusterMat<-numClusterMat
names(colPalette)<-legend[,"clusterIds"]
}
args<-list(...)
if(!"unassignedColor" %in% names(args) & any(legend[,"clusterIds"]== "-1")){
args$unassignedColor<-legend[legend[,"clusterIds"]== "-1","color"]
}
if(!"missingColor" %in% names(args) & any(legend[,"clusterIds"]== "-2")){
args$missingColor<-legend[legend[,"clusterIds"]== "-2","color"]
}
#browser()
do.call("plotBarplot",c(list(clusters=clusterMat,colPalette=colPalette),args))

})

#' @rdname plotBarplot
setMethod(
f = "plotBarplot",
signature = signature(clusters = "ClusterExperiment",whichClusters="missing"),
definition = function(clusters, whichClusters,...)
{
plotBarplot(clusters,whichClusters="primaryCluster",...)
})



#' @rdname plotBarplot
setMethod(
f = "plotBarplot",
signature = signature(clusters = "vector",whichClusters="missing"),
definition = function(clusters, whichClusters, ...){
plotBarplot(matrix(clusters,ncol=1),...)
})

#' @rdname plotBarplot
setMethod(
f = "plotBarplot",
signature = signature(clusters = "matrix",whichClusters="missing"),
definition = function(clusters, whichClusters, xNames=NULL, legNames=NULL, legend=TRUE, xlab=NULL, legend.title=NULL, unassignedColor="white", missingColor="grey", colPalette=bigPalette,...){
if(ncol(clusters)>2) stop("clusters must at most 2 clusters (i.e. 2 columns)")
clLeg<-clusters[,1]
if(is.null(xlab)) xlab<-colnames(clusters)[1]
if(ncol(clusters)==2){
pair<-TRUE
clX<-clusters[,2]
x<-t(table(clLeg,clX)) #references is on the columns, alt on rows
if(is.null(legend.title)) legend.title<-colnames(clusters)[2]
#browser()

if(is.null(names(colPalette))) colPalette<-rep(colPalette,length=nrow(x))
else colPalette<-colPalette[rownames(x)]
#change name and color of missing/unassigned
whAltNotAssigned<-which(row.names(x)=="-1")
whAltMissing<-which(row.names(x)=="-2")
whRefNotAssigned<-which(colnames(x)=="-1")
whRefMissing<-which(colnames(x)=="-2")
if(length(whAltNotAssigned)>0){
row.names(x)[whAltNotAssigned]<-"Not Assigned"
colPalette[whRefNotAssigned]<-unassignedColor
}
if(length(whAltMissing)>0){
row.names(x)[whAltMissing]<-"Not Included in Clustering"
colPalette[whRefMissing]<-missingColor
}
if(length(whRefNotAssigned)>0){
colnames(x)[whRefNotAssigned]<-"Not Assigned"
}
if(length(whRefMissing)>0){
colnames(x)[whRefMissing]<-"Not Included in Clustering"
}
#change order so those are last
if(any(length(whAltNotAssigned)>0 | length(whAltMissing)>0)){
nm<-row.names(x)
wh<-c(whAltNotAssigned,whAltMissing)
x<-rbind(x[-wh,,drop=FALSE],x[wh,,drop=FALSE])
rownames(x)<-c(nm[-wh],nm[wh]) #annoying, but otherwise still loose the names
}
if(any(length(whRefNotAssigned)>0 | length(whRefMissing)>0)){
nm<-colnames(x)
wh<-c(whRefNotAssigned,whRefMissing)
x<-cbind(x[,-wh,drop=FALSE],x[,wh,drop=FALSE])
colPalette<-c(colPalette[-wh],colPalette[wh])
colnames(x)<-c(nm[-wh],nm[wh]) #annoying, but otherwise still loose the names
}
if(is.null(legNames)){
legNames<-colnames(x)
names(legNames)<-colnames(x)
labs<-legNames
}
else{
if(is.null(names(legNames))) stop("must give names to legNames that match values of reference cluster")
if(length(legNames)!=ncol(x)) stop("Invalid reference cluster names -- not same length as number of reference clusters")
if(!all(sort(names(legNames))==sort(colnames(x)))) stop("Invalid names for reference cluster names -- not match names of reference clusters")
#put in same order
legNames<-legNames[colnames(x)]
labs<-paste(legNames," (",colnames(x),")",sep="")
}
}
else{
x<-table(clLeg)
if(is.null(names(colPalette))) colPalette<-rep(colPalette,length=length(x))
else colPalette<-colPalette[names(x)]
if(is.null(legNames)){
legNames<-names(x)
names(legNames)<-names(x)
labs<-legNames
}
else{
if(is.null(names(legNames))) stop("must give names to legNames that match values of reference cluster")
if(length(legNames)!=ncol(x)) stop("Invalid reference cluster names -- not same length as number of reference clusters")
if(!all(sort(names(legNames))==sort(names(x)))) stop("Invalid names for reference cluster names -- not match names of reference clusters")
#put in same order
legNames<-legNames[names(x)]
labs<-paste(legNames," (",names(x),")",sep="")
}

}
par(mar=c(9.1,4.1,4.1,1.1),las=2)
bp<-barplot(x,col=colPalette,legend=legend,args.legend=list(title=legend.title), names.arg=rep("",length(labs)),xlab="",...)
xsize<-diff(par("usr")[3:4])
text(bp, par("usr")[3]+.0*xsize, labels=labs, srt=45, adj=c(1,2), xpd=TRUE)
title(xlab=xlab,line=7)

})


Loading

0 comments on commit 19ecc5e

Please sign in to comment.