Skip to content

Commit

Permalink
v1.0.1 Added option to store only tested genes in DEcombn / DEvsRest.
Browse files Browse the repository at this point in the history
  • Loading branch information
@innesbre
innesbre committed Feb 21, 2019
1 parent 8b6f7f2 commit fe3a766
Show file tree
Hide file tree
Showing 8 changed files with 110 additions and 76 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: scClustViz
Type: Package
Title: Differential Expression-based scRNAseq Cluster Assessment and Viewing
Version: 1.0.0
Version: 1.0.1
Date: 2019-02-13
Authors@R: c(as.person("Brendan T. Innes <[email protected]> [aut,cre]"),
as.person("Gary D. Bader [aut,ths]"))
Expand Down
75 changes: 53 additions & 22 deletions R/deTest.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -65,6 +65,11 @@ NULL
#' differentially expressed genes between nearest neighbouring clusters,
#' assuming \code{testAll} is set FALSE If \code{testAll} is TRUE, this
#' argument is unused.
#' @param storeAllDE Default = TRUE. A logical vector of length 1 indicating
#' whether to calculate and store effect size information for all genes in the
#' comparison (TRUE), or just those passing the detection rate threshold for
#' the Wilcoxon rank-sum test (FALSE). Setting this to FALSE will reduce the
#' size of the output sCVdata object.
#' @param calcSil Default = TRUE. A logical vector of length 1. If TRUE,
#' silhouette widths (a cluster cohesion/separation metric) will be calculated
#' for all cells. This calculation is performed using the function
Expand Down Expand Up @@ -144,6 +149,7 @@ CalcAllSCV <- function(inD,
DRthresh=0.1,
testAll=TRUE,
FDRthresh=0.05,
storeAllDE=T,
calcSil=T,
calcDEvsRest=T,
calcDEcombn=T) {
Expand Down Expand Up @@ -207,6 +213,7 @@ CalcAllSCV <- function(inD,
exponent=exponent,
pseudocount=pseudocount,
DRthresh=DRthresh,
storeAllDE=storeAllDE,
calcSil=calcSil,
calcDEvsRest=calcDEvsRest,
calcDEcombn=calcDEcombn)
Expand Down Expand Up @@ -268,6 +275,11 @@ CalcAllSCV <- function(inD,
#' differential expression testing. A gene will be included if it is detected
#' in at least this proportion of cells in at least one of the clusters being
#' compared.
#' @param storeAllDE Default = TRUE. A logical vector of length 1 indicating
#' whether to calculate and store effect size information for all genes in the
#' comparison (TRUE), or just those passing the detection rate threshold for
#' the Wilcoxon rank-sum test (FALSE). Setting this to FALSE will reduce the
#' size of the output sCVdata object.
#' @param calcSil Default = TRUE. A logical vector of length 1. If TRUE,
#' silhouette widths (a cluster cohesion/separation metric) will be calculated
#' for all cells. This calculation is performed using the function
Expand Down Expand Up @@ -304,18 +316,18 @@ CalcAllSCV <- function(inD,
#' @examples
#' \dontrun{
#' ## This example shows integration of scClustViz with Seurat clustering ##
#'
#'
#' DE_bw_clust <- TRUE
#' seurat_resolution <- 0
#' sCVdata_list <- list()
#'
#'
#' while(DE_bw_clust) {
#' seurat_resolution <- seurat_resolution + 0.2
#' # ^ iteratively incrementing resolution parameter
#'
#' seurat_resolution <- seurat_resolution + 0.2
#' # ^ iteratively incrementing resolution parameter
#'
#' your_seurat_obj <- Seurat::FindClusters(your_seurat_obj,
#' resolution=seurat_resolution)
#'
#'
#' curr_sCVdata <- CalcSCV(inD=your_seurat_obj,
#' clusterDF=Seurat::Idents(your_seurat_obj),
#' assayType=NULL,
Expand All @@ -326,16 +338,16 @@ CalcAllSCV <- function(inD,
#' calcSil=T,
#' calcDEvsRest=T,
#' calcDEcombn=T)
#'
#'
#' DE_bw_NN <- sapply(DEneighb(curr_sCVdata,0.05),length)
#' # ^ counts # of DE genes between neighbouring clusters at 5% FDR
#'
#'
#' if (min(DE_bw_NN) < 1) { DE_bw_clust <- FALSE }
#' # ^ If no DE genes between nearest neighbours, don't loop again.
#'
#'
#' sCVdata_list[[paste0("res.",seurat_resolution)]] <- curr_sCVdata
#' }
#'
#'
#' save(your_seurat_obj,sCVdata_list,
#' file="for_scClustViz.RData")
#'
Expand All @@ -357,6 +369,7 @@ CalcSCV <- function(inD,
exponent=2,
pseudocount=1,
DRthresh=0.1,
storeAllDE=T,
calcSil=T,
calcDEvsRest=T,
calcDEcombn=T) {
Expand Down Expand Up @@ -408,11 +421,11 @@ CalcSCV <- function(inD,
ClustGeneStats(out) <- CalcCGS(out,inD) #this is not optional, since everything depends on it.

if (calcDEvsRest) {
DEvsRest(out) <- CalcDEvsRest(out,inD)
DEvsRest(out) <- CalcDEvsRest(out,inD,storeAllDE)
}

if (calcDEcombn) {
DEcombn(out) <- CalcDEcombn(out,inD)
DEcombn(out) <- CalcDEcombn(out,inD,storeAllDE)
}
return(out)
}
Expand Down Expand Up @@ -690,6 +703,11 @@ fx_calcDEvsRest <- function(nge,cl,deTes) {
#' classes are not currently supported.
#' \href{https://github.com/BaderLab/scClustViz/issues}{Please submit requests
#' for other data objects here!}
#' @param storeAllDE A logical vector of length 1 indicating whether to
#' calculate and store effect size information for all genes in the comparison
#' (TRUE), or just those passing the detection rate threshold for the Wilcoxon
#' rank-sum test (FALSE). Setting this to FALSE will reduce the size of the
#' output sCVdata object.
#'
#' @return A named list of data frames, one entry for each level in
#' \code{Clusters(sCVd)} (with corresponding name).Each entry is data frame
Expand Down Expand Up @@ -738,14 +756,14 @@ fx_calcDEvsRest <- function(nge,cl,deTes) {
#' @export
#'

setGeneric("CalcDEvsRest",function(sCVd,inD) standardGeneric("CalcDEvsRest"))
setGeneric("CalcDEvsRest",function(sCVd,inD,storeAllDE) standardGeneric("CalcDEvsRest"))


#' @describeIn CalcDEvsRest Calculate one vs. all DE tests for sCVdata
#' @export

setMethod("CalcDEvsRest",signature("sCVdata","ANY"),
function(sCVd,inD) {
setMethod("CalcDEvsRest","sCVdata",
function(sCVd,inD,storeAllDE) {
if (!is(inD)[1] %in% findMethodSignatures(getExpr)) {
stop(paste("The input data object must be one of:",
paste(findMethodSignatures(getExpr),collapse=", "),
Expand All @@ -757,6 +775,9 @@ setMethod("CalcDEvsRest",signature("sCVdata","ANY"),
exponent=Param(sCVd,"exponent"),
pseudocount=Param(sCVd,"pseudocount"),
DRthresh=Param(sCVd,"DRthresh"))
if (!storeAllDE) {
deTes <- sapply(deTes,function(X) X[X$overThreshold,],simplify=F)
}
deTes <- fx_calcDEvsRest(nge=getExpr(inD,Param(sCVd,"assayType")),
cl=Clusters(sCVd),
deTes=deTes)
Expand Down Expand Up @@ -880,6 +901,11 @@ fx_calcDEcombn <- function(nge,cl,deMes) {
#' classes are not currently supported.
#' \href{https://github.com/BaderLab/scClustViz/issues}{Please submit requests
#' for other data objects here!}
#' @param storeAllDE A logical vector of length 1 indicating whether to
#' calculate and store effect size information for all genes in the comparison
#' (TRUE), or just those passing the detection rate threshold for the Wilcoxon
#' rank-sum test (FALSE). Setting this to FALSE will reduce the size of the
#' output sCVdata object.
#'
#' @return A named list of data frames, one entry for each pairwise combination
#' of levels in \code{Clusters(sCVd)} (with corresponding name where levels
Expand Down Expand Up @@ -946,14 +972,14 @@ fx_calcDEcombn <- function(nge,cl,deMes) {
#' @export
#'

setGeneric("CalcDEcombn",function(sCVd,inD) standardGeneric("CalcDEcombn"))
setGeneric("CalcDEcombn",function(sCVd,inD,storeAllDE) standardGeneric("CalcDEcombn"))


#' @describeIn CalcDEcombn Calculate DE between cluster pairs
#' @export

setMethod("CalcDEcombn",signature("sCVdata","ANY"), #ANY should be a supported single-cell object
function(sCVd,inD) {
setMethod("CalcDEcombn","sCVdata",
function(sCVd,inD,storeAllDE) {
if (!is(inD)[1] %in% findMethodSignatures(getExpr)) {
stop(paste("The input data object must be one of:",
paste(findMethodSignatures(getExpr),collapse=", "),
Expand All @@ -962,6 +988,9 @@ setMethod("CalcDEcombn",signature("sCVdata","ANY"), #ANY should be a supported s
deMes <- fx_calcEScombn(cl=Clusters(sCVd),
CGS=ClustGeneStats(sCVd),
DRthresh=Param(sCVd,"DRthresh"))
if (!storeAllDE) {
deMes <- sapply(deMes,function(X) X[X$overThreshold,],simplify=F)
}
deMes <- fx_calcDEcombn(nge=getExpr(inD,Param(sCVd,"assayType")),
cl=Clusters(sCVd),
deMes=deMes)
Expand Down Expand Up @@ -1084,10 +1113,12 @@ fx_calcDist_numDE <- function(deVS,FDRthresh) {
#'

fx_calcDist_scoreDE <- function(deVS) {
temp <- sapply(deVS,function(X) -log10(X$FDR))
temp[is.na(temp)] <- 0
temp[temp == Inf] <- max(temp[temp < Inf]) + 1
d <- colSums(temp^2)^.5
d <- vapply(deVS,function(X) {
temp <- -log10(X$FDR)
temp[is.na(temp)] <- 0
temp[temp == Inf] <- max(temp[temp < Inf]) + 1
return(sum(temp^2))
},FUN.VALUE=numeric(1))^0.5
cb <- strsplit(names(deVS),"-")
cl <- unique(unlist(cb))
tempOut <- matrix(nrow=length(cl),ncol=length(cl),dimnames=list(cl,cl))
Expand Down
12 changes: 5 additions & 7 deletions R/runViz.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -626,9 +626,9 @@ runShiny <- function(filePath,outPath,cellMarkers,annotationDB,rownameKeytype,..
choices=c("Most significant"="de",
"Most different"="diff",
"From gene search"="search")),
uiOutput("diffLabelChoice"),
checkboxGroupInput("scatterLabelAngle",label="Plot options:",
choices=c("Flip label angle"="flip"))
uiOutput("diffLabelChoice")
# checkboxGroupInput("scatterLabelAngle",label="Plot options:",
# choices=c("Flip label angle"="flip"))
)
)
),
Expand Down Expand Up @@ -1665,8 +1665,7 @@ runShiny <- function(filePath,outPath,cellMarkers,annotationDB,rownameKeytype,..
labType=input$diffLabelType,
labTypeDiff=input$diffLabelChoice,
labNum=input$diffCount,
labGenes=GOI(),
labAngle=input$scatterLabelAngle)
labGenes=GOI())
}
)

Expand All @@ -1682,8 +1681,7 @@ runShiny <- function(filePath,outPath,cellMarkers,annotationDB,rownameKeytype,..
labType=input$diffLabelType,
labTypeDiff=input$diffLabelChoice,
labNum=input$diffCount,
labGenes=GOI(),
labAngle=input$scatterLabelAngle)
labGenes=GOI())
dev.off()
}
}
Expand Down
44 changes: 12 additions & 32 deletions R/shinyModules.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -863,26 +863,27 @@ compareClusts_DF <- function(sCVd,clA,clB,dataType) {
ClustGeneStats(sCVd)[[clB]][,dataType],
y_mean=rowMeans(cbind(ClustGeneStats(sCVd)[[clA]][,dataType],
ClustGeneStats(sCVd)[[clB]][,dataType])),
logGER=DEcombn(sCVd)[[loc]]$logGER,
FDR=DEcombn(sCVd)[[loc]]$FDR,
dir=c(clB,clA)[(tempW * loc1 > 0) + 1])
logGER=NA,FDR=NA,dir=NA)
rownames(temp) <- rownames(ClustGeneStats(sCVd)[[clA]])
temp[rownames(DEcombn(sCVd)[[loc]]),"logGER"] <- DEcombn(sCVd)[[loc]]$logGER
temp[rownames(DEcombn(sCVd)[[loc]]),"FDR"] <- DEcombn(sCVd)[[loc]]$FDR
temp[rownames(DEcombn(sCVd)[[loc]]),"dir"] <- c(clB,clA)[(tempW * loc1 > 0) + 1]
return(temp)
} else if (dataType %in% c("GERvDDR","logGER","dDR")) {
loc1 <- which(c(paste(clA,clB,sep="-"),paste(clB,clA,sep="-")) %in% names(DEcombn(sCVd)))
if (loc1 == 2) { loc1 <- -1 }
loc <- which(names(DEcombn(sCVd)) %in% c(paste(clA,clB,sep="-"),paste(clB,clA,sep="-")))
temp <- DEcombn(sCVd)[[loc]][,c("logGER","dDR","FDR")]
temp <- as.data.frame(mapply("*",temp,c(loc1,loc1,1)))
rownames(temp) <- rownames(ClustGeneStats(sCVd)[[clA]])
rownames(temp) <- rownames(DEcombn(sCVd)[[loc]])
tempW <- DEcombn(sCVd)[[loc]]$Wstat -
DEcombn(sCVd)[[loc]]$Wstat[which.max(DEcombn(sCVd)[[loc]]$pVal)]
temp$dir <- c(clB,clA)[(tempW * loc1 > 0) + 1]
return(temp)
}
}

plot_compareClusts_MAplot <- function(sCVd,clA,clB,dataType,labType,labNum,labGenes,labAngle) {
plot_compareClusts_MAplot <- function(sCVd,clA,clB,dataType,labType,labNum,labGenes) {
# ^ setup -----
CGS <- compareClusts_DF(sCVd,clA,clB,dataType)
temp_exp <- switch(as.character(Param(sCVd,"exponent") == exp(1)),
Expand All @@ -892,13 +893,6 @@ plot_compareClusts_MAplot <- function(sCVd,clA,clB,dataType,labType,labNum,labGe
"MGE"=paste("mean normalized gene expression",temp_exp),
"MDGE"=paste("mean normalized gene expression where detected",temp_exp),
"DR"="proportion of cells in which gene was detected")
if ("flip" %in% labAngle) {
temp_adjB <- c(-0.1,0.5)
temp_adjA <- c(1.1,0.5)
} else {
temp_adjB <- c(1.1,0.5)
temp_adjA <- c(-0.1,0.5)
}
if (labType == "diff") {
gnA <- rownames(head(CGS[order(CGS$x_diff,decreasing=T),],labNum))
gnB <- rownames(tail(CGS[order(CGS$x_diff,decreasing=T),],labNum))
Expand Down Expand Up @@ -962,19 +956,12 @@ plot_compareClusts_MAplot <- function(sCVd,clA,clB,dataType,labType,labNum,labGe
}

plot_compareClusts_DEscatter <- function(sCVd,clA,clB,dataType,labType,
labTypeDiff,labNum,labGenes,labAngle) {
labTypeDiff,labNum,labGenes) {
# ^ setup -----
CGS <- compareClusts_DF(sCVd,clA,clB,dataType)
temp_exp <- switch(as.character(Param(sCVd,"exponent") == exp(1)),
"TRUE"="(natural log scale)",
"FALSE"=paste0("(log",Param(sCVd,"exponent")," scale)"))
if ("flip" %in% labAngle) {
temp_adjB <- c(-0.1,0.5)
temp_adjA <- c(1.1,0.5)
} else {
temp_adjB <- c(1.1,0.5)
temp_adjA <- c(-0.1,0.5)
}
if (labType == "diff") {
gnA <- rownames(head(CGS[order(CGS[[labTypeDiff]],decreasing=T),],labNum))
gnB <- rownames(tail(CGS[order(CGS[[labTypeDiff]],decreasing=T),],labNum))
Expand Down Expand Up @@ -1030,21 +1017,14 @@ plot_compareClusts_DEscatter <- function(sCVd,clA,clB,dataType,labType,
col=rainbow2(length(levels(Clusters(sCVd))))[which(levels(Clusters(sCVd)) == clB)])
}

plot_compareClusts_volcano <- function(sCVd,clA,clB,dataType,labType,labNum,labGenes,labAngle) {
plot_compareClusts_volcano <- function(sCVd,clA,clB,dataType,labType,labNum,labGenes) {
# ^ setup -----
CGS <- compareClusts_DF(sCVd,clA,clB,dataType)
CGS <- CGS[!is.na(CGS$FDR),]
CGS$FDR <- -log10(CGS$FDR)
temp_exp <- switch(as.character(Param(sCVd,"exponent") == exp(1)),
"TRUE"="(natural log scale)",
"FALSE"=paste0("(log",Param(sCVd,"exponent")," scale)"))
if ("flip" %in% labAngle) {
temp_adjB <- c(-0.1,0.5)
temp_adjA <- c(1.1,0.5)
} else {
temp_adjB <- c(1.1,0.5)
temp_adjA <- c(-0.1,0.5)
}
if (labType == "diff") {
gnA <- rownames(head(CGS[order(CGS[[dataType]],decreasing=T),],labNum))
gnB <- rownames(tail(CGS[order(CGS[[dataType]],decreasing=T),],labNum))
Expand Down Expand Up @@ -1095,15 +1075,15 @@ plot_compareClusts_volcano <- function(sCVd,clA,clB,dataType,labType,labNum,labG
}


plot_compareClusts <- function(sCVd,clA,clB,dataType,labType,labTypeDiff,labNum,labGenes,labAngle) {
plot_compareClusts <- function(sCVd,clA,clB,dataType,labType,labTypeDiff,labNum,labGenes) {
if (clA %in% levels(Clusters(sCVd)) &
clB %in% levels(Clusters(sCVd))) {
if (dataType %in% c("MGE","MDGE","DR")) {
plot_compareClusts_MAplot(sCVd,clA,clB,dataType,labType,labNum,labGenes,labAngle)
plot_compareClusts_MAplot(sCVd,clA,clB,dataType,labType,labNum,labGenes)
} else if (dataType == "GERvDDR") {
plot_compareClusts_DEscatter(sCVd,clA,clB,dataType,labType,labTypeDiff,labNum,labGenes,labAngle)
plot_compareClusts_DEscatter(sCVd,clA,clB,dataType,labType,labTypeDiff,labNum,labGenes)
} else if (dataType %in% c("logGER","dDR")) {
plot_compareClusts_volcano(sCVd,clA,clB,dataType,labType,labNum,labGenes,labAngle)
plot_compareClusts_volcano(sCVd,clA,clB,dataType,labType,labNum,labGenes)
}
} else {
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
Expand Down
9 changes: 8 additions & 1 deletion man/CalcAllSCV.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

0 comments on commit fe3a766

Please sign in to comment.