Skip to content

Support custom plot order in ggcyto. #111

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
djhammill wants to merge 1 commit into
base: devel
Choose a base branch
from
Open

Support custom plot order in ggcyto. #111

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
105 changes: 53 additions & 52 deletions R/autoplot.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@
#' @param y define the y dimension of the plot. Default is NULL, which means 1d densityplot.
#' @param bins passed to geom_hex
#' @param axis_inverse_trans logical flag indicating whether to add \link{axis_x_inverse_trans} and axis_x_inverse_trans layers.
#' @param pData Optional data.frame to use in place of the flowSet/GatingSet pData during plotting. Must have the same sample names (rownames) as the original pData. Columns can have different classes (e.g., factors with custom levels) to control plotting order. The original pData is not modified.
#' @param ... other arguments passed to ggplot
#'
#' @rdname autoplot
Expand Down Expand Up @@ -44,26 +45,26 @@
#' #autoplot(gh , strip.text = "gate")
#' @export
#' @export autoplot
autoplot.flowSet <- function(object, x, y = NULL, bins = 30, ...){

autoplot.flowSet <- function(object, x, y = NULL, bins = 30, pData = NULL, ...){
# check the dimensions
if(missing(x))
stop("'x' must be supplied to ggplot!")
if(is.null(y)){
p <- ggcyto(object, aes_q(x = as.symbol(x)), ...) #aes_string doesn't play well with special character (e.g. '-')
p <- ggcyto(object, aes_q(x = as.symbol(x)), pData = pData, ...) #aes_string doesn't play well with special character (e.g. '-')
p <- p + geom_density(fill = "black")
}else{
p <- ggcyto(object, aes_q(x = as.symbol(x), y = as.symbol(y)), ...)
p <- ggcyto(object, aes_q(x = as.symbol(x), y = as.symbol(y)), pData = pData, ...)
p <- p + geom_hex(bins = bins)

}

# apply boundary filter to remove outliers
# if(margin){
# g <- boundaryFilter(x = dims, tol = 1e-5)
# object <- Subset(object, g)
# }

# if(margin){
# g <- boundaryFilter(x = dims, tol = 1e-5)
# object <- Subset(object, g)
# }
p
}

Expand Down Expand Up @@ -94,33 +95,33 @@ autoplot.flowFrame <- function(object, x, ...){
object <- fortify_fs(object)
autoplot(object, x = x, ...)
}

}

density_fr_all <- function(fr, strip.text = c("both", "channel", "marker"), ...){

#plot each individual channel
Objs <- sapply(colnames(fr), function(chnl){
p <- autoplot(fr, chnl, ...)
p <- p + labs(title = NULL)
myTheme <- theme(axis.title = element_text(color = gray(0.3), size = 8)
, axis.text = element_text(color = gray(0.3), size = 6)
, axis.title.y = element_blank()
, strip.text = element_blank()
, plot.margin = unit(c(0,0,0,0), "cm")
, panel.spacing = unit(0, "cm")
)
p <- p + myTheme
attr(p$data, "strip.text") <- chnl
p
}, simplify = FALSE)
p <- autoplot(fr, chnl, ...)
p <- p + labs(title = NULL)
myTheme <- theme(axis.title = element_text(color = gray(0.3), size = 8)
, axis.text = element_text(color = gray(0.3), size = 6)
, axis.title.y = element_blank()
, strip.text = element_blank()
, plot.margin = unit(c(0,0,0,0), "cm")
, panel.spacing = unit(0, "cm")
)
p <- p + myTheme
attr(p$data, "strip.text") <- chnl
p
}, simplify = FALSE)


#convert it to a special class to dispatch the dedicated print method
Objs <- as(Objs, "ggcyto_GatingLayout")
Objs@arrange.main <- identifier(fr)


Objs


Expand All @@ -135,7 +136,7 @@ autoplot.GatingSetList <- function(object, ...){
#' @param gate the gate to be plotted
#' @export
#' @rdname autoplot
autoplot.GatingSet <- function(object, gate, x = NULL, y = "SSC-A", bins = 30, axis_inverse_trans = TRUE, ...){
autoplot.GatingSet <- function(object, gate, x = NULL, y = "SSC-A", bins = 30, axis_inverse_trans = TRUE, pData = NULL, ...){
if(missing(gate))
stop("Must specifiy 'gate'!")
g <- gh_pop_get_gate(object[[1]], gate[1])
Expand All @@ -160,15 +161,15 @@ autoplot.GatingSet <- function(object, gate, x = NULL, y = "SSC-A", bins = 30,
}else
stop("invalid nDims: ", nDims)
}

mapping <- aes_q(x = as.symbol(x), y = as.symbol(y))

p <- ggcyto(object, mapping, ...) + geom_hex(bins = bins) + geom_gate(gate) + geom_stats()
p <- ggcyto(object, mapping, pData = pData, ...) + geom_hex(bins = bins) + geom_gate(gate) + geom_stats()
p <- p + ggcyto_par_set(limits = "instrument")
if(axis_inverse_trans)
p <- p + axis_x_inverse_trans() + axis_y_inverse_trans()
p

}

#' @param bool whether to plot boolean gates
Expand All @@ -182,47 +183,47 @@ autoplot.GatingSet <- function(object, gate, x = NULL, y = "SSC-A", bins = 30,
#' @export
#' @rdname autoplot
autoplot.GatingHierarchy <- function(object, gate, y = "SSC-A", bool=FALSE
, arrange.main = sampleNames(object), arrange=TRUE, merge=TRUE
, projections = list()
, strip.text = c("parent", "gate")
, path = "auto"
, ...){
, arrange.main = sampleNames(object), arrange=TRUE, merge=TRUE
, projections = list()
, strip.text = c("parent", "gate")
, path = "auto"
, ...){
strip.text <- match.arg(strip.text)
if(missing(gate)){
gate <- gs_get_pop_paths(object, path = path)
gate <- setdiff(gate,"root")
}else if (is.numeric(gate)){
gate <- gs_get_pop_paths(object, path = path)[gate]
}

#match given axis to channel names
fr <- gh_pop_get_data(object, use.exprs = FALSE)
projections <- lapply(projections, function(thisPrj){
sapply(thisPrj, function(thisAxis)getChannelMarker(fr, thisAxis)[["name"]])
})


plotList <- flowWorkspace:::.mergeGates(object, gate, bool, merge, projections = projections)
Objs <- lapply(plotList,function(plotObjs){

if(is.list(plotObjs)){
gate <- plotObjs[["popIds"]]
parent <- plotObjs[["parentId"]]
myPrj <- projections[[as.character(gate[1])]]

}else{
gate <- plotObjs
parent <- gs_pop_get_parent(object, gate, path = path)
myPrj <- projections[[as.character(gate)]]
}


if(is.null(myPrj)){
p <- autoplot.GatingSet(object, gate, y = y, ...)
}else{
p <- autoplot.GatingSet(object, gate, x = myPrj[["x"]], y = myPrj[["y"]], ...)
}

p <- p + labs(title = NULL)
myTheme <- theme(axis.title = element_text(color = gray(0.3), size = 8)
, axis.text = element_text(color = gray(0.3), size = 6)
Expand All @@ -232,26 +233,26 @@ autoplot.GatingHierarchy <- function(object, gate, y = "SSC-A", bool=FALSE
, legend.position = 'none'
)
p <- p + myTheme

#rename sample name with parent or current pop name in order to display it in strip

if(strip.text == "parent"){
popName <- parent
}else{
popName <- paste(gate, collapse = "|")
}
attr(p$data, "strip.text") <- popName

p

})

if(arrange){
#convert it to a special class to dispatch the dedicated print method
Objs <- as(Objs, "ggcyto_GatingLayout")
Objs@arrange.main <- arrange.main
}

Objs

}
22 changes: 14 additions & 8 deletions R/compute_stats.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@
#' @param gates a list of filters
#' @param type a vector of strings to specify the stats types. can be any or multiple values of "percent", "count", "gate_name", or "MFI" (MFI is currently not supported yet).
#' @param value the pre-calculated stats value. when supplied, the stats computing is skipped.
#' @param pData Optional custom pData to use instead of pData(fs) to control the plot order.
#' @param ... other arguments passed to stat_position function
#' @return
#' a data.table that contains percent and centroid locations as well as pData
Expand All @@ -21,7 +22,7 @@
#' rect.gates <- sapply(sampleNames(fs), function(sn)rect.g)
#' compute_stats(fs, rect.gates)
#' compute_stats(fs, rect.gates, type = c("gate_name", "percent"))
compute_stats <- function(fs = NULL, gates, type = "percent", value = NULL, ...){
compute_stats <- function(fs = NULL, gates, type = "percent", value = NULL, pData = NULL, ...){

if(is.null(fs)&&(is.null(value)))
stop("fs must be provided when 'value' is not supplied!")
Expand All @@ -46,12 +47,17 @@ compute_stats <- function(fs = NULL, gates, type = "percent", value = NULL, ...)
stats <- Reduce(function(x,y){
val <- paste(x[, value], y[, value], sep = "\n")
x[, value := val]
}, x = stats.list)
}, x = stats.list)

centroids <- stat_position(gates, ...)

stats <- merge(centroids, stats, by = ".rownames") # merge stats with centroid
merge(stats, .pd2dt(pData(fs)), by = ".rownames") # merge with pdata

# Get pData and use data.table join to preserve factor levels
pd <- .pd2dt(pData(fs), pData = pData)
setkeyv(pd, ".rownames")
setkeyv(stats, ".rownames")
pd[stats, on = ".rownames"]
}

.stat_gate_name <- function(fs, gates, value = NULL, ...){
Expand All @@ -76,14 +82,14 @@ compute_stats <- function(fs = NULL, gates, type = "percent", value = NULL, ...)
if(negated)
p = 1 - p
p
}, simplify = FALSE)
}, simplify = FALSE)
}
sn <- names(value)
value <- unlist(value)
#format the calculated stats values
value <- paste(format(value *100,digits=digits),"%",sep="")
stats <- data.table(value = value, .rownames = sn)

stats
}

Expand All @@ -99,12 +105,12 @@ compute_stats <- function(fs = NULL, gates, type = "percent", value = NULL, ...)
if(negated)
ind <- !ind
sum(ind)
}, simplify = FALSE)
}, simplify = FALSE)
}
sn <- names(value)
value <- unlist(value)
stats <- data.table(value = value, .rownames = sn)

stats
}

Expand All @@ -115,5 +121,5 @@ compute_stats <- function(fs = NULL, gates, type = "percent", value = NULL, ...)
.stat_MFI <- function(fs, gates, digits = 3, negated = FALSE, ...){
stop("MFI not supported yet!")
fs_sub <- Subset(fs, gates)

}
Loading