R/5_plotFunctions.R
In SofieVG/FlowSOM: Using self-organizing maps for visualization and interpretation of cytometry data
Defines functions
PlotOutliers
AddAnnotation
FlowSOMmary
gg_color_hue
AddStars
AddPies
AddScale
AddBackground
AddNodes
AddLabels
AddStarsPies
AddMST
AutoMaxNodeSize
ScaleStarHeights
ParseQuery
ParseArcs
ParseNodeSize
ParseLayout
ParseEdges
PlotStarLegend
PlotSD
QueryMultiple
QueryStarPlot
Plot2DScatters
PlotManualBars
PlotDimRed
PlotVariable
PlotMarker
PlotNumbers
PlotLabels
PlotPies
PlotStars
FlowSOM_colors
PlotFlowSOM
Documented in
AddAnnotation
AddBackground
AddLabels
AddMST
AddNodes
AddPies
AddScale
AddStars
AddStarsPies
AutoMaxNodeSize
FlowSOM_colors
FlowSOMmary
gg_color_hue
ParseArcs
ParseEdges
ParseLayout
ParseNodeSize
ParseQuery
Plot2DScatters
PlotDimRed
PlotFlowSOM
PlotLabels
PlotManualBars
PlotMarker
PlotNumbers
PlotOutliers
PlotPies
PlotSD
PlotStarLegend
PlotStars
PlotVariable
QueryMultiple
QueryStarPlot
ScaleStarHeights
#' PlotFlowSOM
#'
#' Base layer to plot a FlowSOM result
#'
#' Base layer of the FlowSOM plot, where you can choose layout (MST, grid or
#' coordinates of your own choosing), background colors and node size. Can
#' then be extended by e.g. \code{\link{AddStars}}, \code{\link{AddLabels}},
#' \code{\link{AddPies}}, ...
#'
#' @param fsom FlowSOM object, as created by \code{\link{FlowSOM}}
#' @param view Preferred view, options: "MST", "grid" or "matrix"
#' with a matrix/dataframe consisting of coordinates.
#' Default = "MST"
#' @param nodeSizes A vector containing node sizes. These will
#' automatically be scaled between 0 and maxNodeSize
#' and transformed with a sqrt. Default = fsom$MST$sizes
#' @param maxNodeSize Determines the maximum node size. Default is 1.
#' @param refNodeSize Reference for node size against which the nodeSizes
#' will be scaled. Default = max(nodeSizes)
#' @param equalNodeSize If \code{TRUE}, the nodes will be equal to
#' maxNodeSize. If \code{FALSE} (default), the nodes
#' will be scaled to the number of cells in each
#' cluster
#' @param backgroundValues Values to be used for background coloring, either
#' numerical values or something that can be made into
#' a factor (e.g. a clustering)
#' @param backgroundColors Color palette to be used for the background coloring.
#' Can be either a function or an array specifying
#' colors.
#' @param backgroundSize The size of the background. Will be multiplied by the
#' size of the nodes.
#' @param equalBackgroundSize If you want the background sizes to be the same size.
#' @param backgroundLim Only used when backgroundValues are numerical.
#' Defaults to min and max of the backgroundValues.
#' @param title Title of the plot
#'
#' @return A ggplot object with the base layer of a FlowSOM plot
#'
#' @seealso \code{\link{PlotStars}}, \code{\link{PlotVariable}},
#' \code{\link{PlotMarker}}, \code{\link{PlotLabels}},
#' \code{\link{PlotNumbers}}, \code{\link{PlotPies}},
#' \code{\link{QueryStarPlot}}, \code{\link{PlotSD}}
#'
#' @examples
#' # Locate file on file system
#' fcs_file <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#'
#' # Build FlowSOM model
#' flowSOM.res <- FlowSOM(fcs_file,
#' scale = TRUE,
#' compensate = TRUE,
#' transform = TRUE,
#' toTransform = 8:18,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' # Plot with background coloring
#' PlotFlowSOM(flowSOM.res,
#' backgroundValues = flowSOM.res$metaclustering) %>%
#' AddLabels(seq(100))
#'
#'
#' @importFrom ggplot2 ggplot coord_fixed theme_void ggtitle
#'
#' @export
PlotFlowSOM <- function(fsom,
view = "MST",
nodeSizes = fsom$map$pctgs,
maxNodeSize = 1,
refNodeSize = max(nodeSizes),
equalNodeSize = FALSE,
backgroundValues = NULL,
backgroundColors = NULL,
backgroundSize = 1.5,
equalBackgroundSize = FALSE,
backgroundLim = NULL,
title = NULL)
{
#----Initialization----
requireNamespace("ggplot2")
fsom <- UpdateFlowSOM(fsom)
nNodes <- NClusters(fsom)
isEmpty <- fsom$map$pctgs == 0
#----Warnings----
if (length(nodeSizes) != nNodes){
stop(paste0("Length of 'nodeSizes' should be equal to number of clusters ",
"in FlowSOM object (", nNodes, " clusters and ",
length(nodeSizes), " node sizes)."))
}
if (length(backgroundValues) != nNodes && !is.null(backgroundValues)){
stop(paste0("Length of 'backgroundValues' should be equal to number of ",
"clusters in FlowSOM object (", nNodes, " clusters and ",
length(backgroundValues), " backgroundValues)."))
}
if (deparse(substitute(backgroundColors)) == "backgroundColor"){
warning(paste0("In the new FlowSOM version \"backgroundColors\"",
" is used instead of \"backgroundColor\""))
}
#---- Layout----
layout <- ParseLayout(fsom, view)
if(is.matrix(view) || is.data.frame(view)) view <- "matrix"
#---- Nodesize----
autoNodeSize <- AutoMaxNodeSize(layout = layout,
overlap = ifelse(view %in% c("grid"),
-0.3, 1))
maxNodeSize <- autoNodeSize * maxNodeSize
if (equalNodeSize){
scaledNodeSize <- rep(maxNodeSize, nNodes)
} else {
scaledNodeSize <- ParseNodeSize(nodeSizes, maxNodeSize, refNodeSize)
}
if (any(isEmpty)) {scaledNodeSize[isEmpty] <- min(maxNodeSize, 0.05)}
#----ggplot----
if (equalBackgroundSize){
backgroundSize <- rep(maxNodeSize, nNodes) * backgroundSize
} else {
backgroundSize <- ParseNodeSize(nodeSizes, maxNodeSize, refNodeSize) * backgroundSize
}
plot_df <- data.frame(x = layout$x,
y = layout$y,
size = scaledNodeSize,
bg_size = backgroundSize)
p <- ggplot2::ggplot(plot_df)
# Add background
if (!is.null(backgroundValues)){
p <- AddBackground(p,
backgroundValues = backgroundValues,
backgroundColors = backgroundColors,
backgroundLim = backgroundLim)
}
# Add MST
if (view == "MST"){
p <- AddMST(p, fsom)
}
# Add nodes
p <- AddNodes(p = p,
values = as.character(isEmpty),
colorPalette = c("TRUE" = "gray", "FALSE" = "white"),
showLegend = FALSE)
# Fix plotlayout
p <- p + ggplot2::coord_fixed() + ggplot2::theme_void()
if (!is.null(title)){
p <- p + ggplot2::ggtitle(title)
}
return(p)
}
#' FlowSOM default colors
#'
#' @param n Number of colors to generate
#'
#' @return array of n colors
#'
#' @importFrom grDevices colorRampPalette
#' @export
FlowSOM_colors <- function(n){
grDevices::colorRampPalette(c("#00007F",
"blue",
"#007FFF",
"cyan",
"#7FFF7F",
"yellow",
"#FF7F00",
"red",
"#7F0000"))(n)
}
#' PlotStars
#'
#' Plot star charts
#'
#' Plot FlowSOM grid or tree, where each node is represented by
#' a star chart indicating median marker values
#'
#' @param fsom FlowSOM object, as generated by \code{\link{BuildMST}}
#' @param markers Markers to plot (will be parsed by GetChannels)
#' @param colorPalette Color palette to use
#' @param list_insteadof_ggarrange If FALSE (default), the plot and the legend
#' are combined by ggarrange. If TRUE, the
#' separate elements are returned in a list,
#' to allow further customization.
#' @param ... Additional arguments to pass to \code{\link{PlotFlowSOM}}
#'
#' @return Nothing is returned. A plot is drawn in which each node is
#' represented by a star chart indicating the median fluorescence intensities.
#' Resets the layout back to 1 plot at the end.
#
#' @seealso \code{\link{PlotMarker}}, \code{\link{PlotVariable}},
#' \code{\link{PlotFlowSOM}}, \code{\link{PlotLabels}},
#' \code{\link{PlotNumbers}}, \code{\link{PlotPies}},
#' \code{\link{QueryStarPlot}}, \code{\link{PlotSD}}
#'
#' @examples
#' # Read from file, build self-organizing map and minimal spanning tree
#' fileName <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#' flowSOM.res <- FlowSOM(fileName, compensate = TRUE, transform = TRUE,
#' scale = TRUE, colsToUse = c(9, 12, 14:18))
#'
#' # Plot stars indicating the MFI of the cells present in the nodes
#' PlotStars(flowSOM.res, backgroundValues = flowSOM.res$metaclustering)
#'
#' newLayout <- igraph::layout_with_fr(flowSOM.res[["MST"]][["graph"]])
#' PlotStars(flowSOM.res, backgroundValues = flowSOM.res$metaclustering,
#' view = newLayout)
#'
#' PlotStars(flowSOM.res, backgroundValues = flowSOM.res$metaclustering,
#' view = "grid")
#'
#' @importFrom ggpubr get_legend ggarrange
#' @importFrom ggforce geom_circle
#'
#' @export
PlotStars <- function(fsom,
markers = fsom$map$colsUsed,
colorPalette = FlowSOM_colors,
list_insteadof_ggarrange = FALSE,
...){
fsom <- UpdateFlowSOM(fsom)
if (length(names(list(...))) > 0 && "backgroundColor" %in% names(list(...))){
warning(paste0("\"backgroundColor\" is deprecated, ",
"please use \"backgroundColors\" instead."))
}
channels <- GetChannels(fsom, markers)
p <- PlotFlowSOM(fsom = fsom,
...)
if(!is.null(names(colorPalette))) {
names(colorPalette) <- GetChannels(fsom, names(colorPalette))
}
p <- AddStars(p = p,
fsom = fsom,
markers = channels,
colorPalette = colorPalette)
if(!is.null(names(colorPalette))) {
names(colorPalette) <- fsom$prettyColnames[GetChannels(fsom,
names(colorPalette))]
}
l1 <- PlotStarLegend(fsom$prettyColnames[channels],
colorPalette)
l2 <- ggpubr::get_legend(p)
if (list_insteadof_ggarrange){
p <- p + ggplot2::theme(legend.position = "none")
l2 <- ggpubr::as_ggplot(l2)
return(list(tree = p,
starLegend = l1,
backgroundLegend = l2))
} else {
p <- ggpubr::ggarrange(p,
ggpubr::ggarrange(l1, l2,
ncol = 1),
NULL,
ncol = 3, widths = c(3, 1, 0.3),
legend = "none")
return(p)
}
}
#' PlotPies
#'
#' Plot comparison with other clustering
#'
#' Plot FlowSOM grid or tree, with pies indicating another clustering
#' or manual gating result
#'
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}}
#' @param cellTypes Array of factors indicating the celltypes
#' @param colorPalette Color palette to use.
#' @param ... Additional arguments to pass to \code{\link{PlotFlowSOM}}
#'
#' @return ggplot plot
#'
#' @seealso \code{\link{PlotStars}}, \code{\link{PlotVariable}},
#' \code{\link{PlotFlowSOM}}, \code{\link{PlotLabels}},
#' \code{\link{PlotNumbers}}, \code{\link{PlotMarker}},
#' \code{\link{QueryStarPlot}}, \code{\link{PlotSD}}
#'
#' @examples
#' # Identify the files
#' fcs_file <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#' gating_file <- system.file("extdata", "gatingResult.csv", package = "FlowSOM")
#'
#' # Specify the cell types of interest for assigning one label per cell
#' cellTypes <- c("B cells",
#' "gd T cells", "CD4 T cells", "CD8 T cells",
#' "NK cells", "NK T cells")
#'
#' # Load manual labels (e.g. GetFlowJoLabels can be used to extract labels from
#' # an fcs file)
#'
#' gatingResult <- as.factor(read.csv(gating_file, header = FALSE)[, 1])
#'
#'
#' # Build a FlowSOM tree
#' flowSOM.res <- FlowSOM(fcs_file,
#' scale = TRUE,
#' compensate = TRUE,
#' transform = TRUE,
#' toTransform = 8:18,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' # Plot pies indicating the percentage of cell types present in the nodes
#' PlotPies(flowSOM.res,
#' gatingResult,
#' backgroundValues = flowSOM.res$metaclustering)
#'
#' @importFrom grDevices colorRampPalette
#'
#' @export
PlotPies <- function(fsom,
cellTypes,
colorPalette = grDevices::colorRampPalette(c("white",
"#00007F",
"blue",
"#007FFF",
"cyan",
"#7FFF7F",
"yellow",
"#FF7F00",
"red",
"#7F0000")),
...){
if(length(cellTypes) != nrow(fsom$data)){
stop("There are ", nrow(fsom$data), " cells, while you provided ",
length(cellTypes), " labels. These numbers should match.")
}
p <- PlotFlowSOM(fsom = fsom,
...)
p <- AddPies(p,
fsom = fsom,
colorPalette = colorPalette,
cellLabels = cellTypes)
return(p)
}
#' PlotLabels
#'
#' Plot labels for each cluster
#'
#' Plot FlowSOM grid or tree, with in each node a label.
#' Especially useful to show metacluster numbers
#'
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}}
#' @param labels A vector of labels for every node.
#' @param maxNodeSize Determines the maximum node size. Default is 0.
#' @param textSize Size for geom_text. Default (=3.88) is from geom_text.
#' @param textColor Color for geom_text. Default = black.
#' @param ... Additional arguments to pass to \code{\link{PlotFlowSOM}}
#'
#' @return Nothing is returned. A plot is drawn in which each node is
#' represented by a label.
#'
#'
#' @seealso \code{\link{PlotStars}}, \code{\link{PlotVariable}},
#' \code{\link{PlotFlowSOM}}, \code{\link{PlotMarker}},
#' \code{\link{PlotNumbers}}, \code{\link{PlotPies}},
#' \code{\link{QueryStarPlot}}, \code{\link{PlotSD}}
#'
#' @examples
#' # Read from file, build self-organizing map and minimal spanning tree
#' fileName <- system.file("extdata", "68983.fcs", package="FlowSOM")
#' ff <- flowCore::read.FCS(fileName)
#' ff <- flowCore::compensate(ff, flowCore::keyword(ff)[["SPILL"]])
#' ff <- flowCore::transform(ff,
#' flowCore::transformList(colnames(flowCore::keyword(ff)[["SPILL"]]),
#' flowCore::logicleTransform()))
#' flowSOM.res <- FlowSOM(ff,
#' scale = TRUE,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' # Plot the node IDs
#' PlotLabels( flowSOM.res,
#' flowSOM.res$metaclustering)
#'
#' @importFrom grDevices colorRampPalette
#'
#' @export
PlotLabels <- function(fsom,
labels,
maxNodeSize = 0,
textSize = 3.88,
textColor = "black",
...){
fsom <- UpdateFlowSOM(fsom)
if(length(labels) != NClusters(fsom)) {
stop(paste0("Length of 'labels' should be equal to number of clusters in ",
"FlowSOM object (", NClusters(fsom), " clusters, ",
length(labels), " labels)."))
}
p <- PlotFlowSOM(fsom = fsom,
maxNodeSize = maxNodeSize,
...)
p <- AddLabels(p,
labels = labels,
textSize = textSize,
textColor = textColor)
return(p)
}
#' PlotNumbers
#'
#' Plot cluster ids for each cluster
#'
#' Plot FlowSOM grid or tree, with in each node the cluster id.
#'
#' @param fsom FlowSOM object
#' @param level Character string, should be either "clusters" or
#' "metaclusters". Can be abbreviated.
#' @param maxNodeSize Determines the maximum node size. Default is 0.
#' See \code{\link{PlotFlowSOM}} for more options.
#' @param ... Additional arguments to pass to \code{\link{PlotLabels}}
#' and to \code{\link{PlotFlowSOM}}
#'
#' @return Nothing is returned. A plot is drawn in which each node is
#' labeled by its cluster id.
#'
#' @seealso \code{\link{PlotStars}}, \code{\link{PlotVariable}},
#' \code{\link{PlotFlowSOM}}, \code{\link{PlotLabels}},
#' \code{\link{PlotMarker}}, \code{\link{PlotPies}},
#' \code{\link{QueryStarPlot}}, \code{\link{PlotSD}}
#'
#' @examples
#' # Read from file, build self-organizing map and minimal spanning tree
#' fileName <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#' ff <- flowCore::read.FCS(fileName)
#' ff <- flowCore::compensate(ff, flowCore::keyword(ff)[["SPILL"]])
#' ff <- flowCore::transform(ff, flowCore::estimateLogicle(ff,
#' flowCore::colnames(ff)[8:18]))
#' flowSOM.res <- FlowSOM(ff,
#' scale = TRUE,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' # Plot the node IDs
#' PlotNumbers(flowSOM.res)
#' PlotNumbers(flowSOM.res, "metaclusters")
#'
#' PlotNumbers(flowSOM.res,
#' view = "grid")
#'
#' PlotNumbers(flowSOM.res,
#' maxNodeSize = 1,
#' equalNodeSize = TRUE)
#'
#' @export
PlotNumbers <- function(fsom,
level = "clusters",
maxNodeSize = 0,
...){
level <- pmatch(level, c("clusters", "metaclusters"))
if (any(is.na(level)) | length(level) > 2){
stop("level should be \"clusters\" or \"metaclusters\"")
} else {
level <- c("clusters", "metaclusters")[level]
if (level == "clusters"){
numbers <- seq_len(NClusters(fsom))
} else if (level == "metaclusters") {
numbers <- fsom$metaclustering
}
}
p <- PlotLabels(fsom = fsom,
labels = numbers,
maxNodeSize = maxNodeSize,
...)
return(p)
}
#' PlotMarker
#'
#' Plot comparison with other clustering
#'
#' Plot FlowSOM grid or tree, colored by node values for a specific marker
#'
#' @param fsom FlowSOM object
#' @param marker A vector of markers/channels to plot.
#' @param refMarkers Is used to determine relative scale of the marker
#' that will be plotted. Default are all markers used in the
#' clustering.
#' @param title A vector with custom titles for the plot. Default is
#' the marker name.
#' @param colorPalette Color palette to use. Can be a function or a vector.
#' @param lim Limits for the scale
#' @param ... Additional arguments to pass to \code{\link{PlotFlowSOM}},
#' e.g. view, backgroundValues, equalNodeSize ...
#'
#' @return A ggplot figure is returned in which every cluster is colored
#' according to the MFI value for the specified marker
#'
#' @seealso \code{\link{PlotStars}}, \code{\link{PlotVariable}}
#'
#' @examples
#' # Build FlowSOM model
#' fileName <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#' flowSOM.res <- FlowSOM(fileName,
#' compensate = TRUE, transform = TRUE, scale = FALSE,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#' # Plot one marker
#' PlotMarker(flowSOM.res,
#' "CD19")
#'
#' PlotMarker(flowSOM.res,
#' "CD19",
#' colorPalette = c("gray", "red"))
#'
#' # Plot all markers
#' PlotMarker(flowSOM.res,
#' c(9, 12, 14:18))
#'
#' # Use specific limits if the ones from the columns used for clustering
#' # are not relevant for your marker of choice
#' PlotMarker(flowSOM.res,
#' "FSC-A",
#' lim = c(55000, 130000))
#'
#' # Example with additional FlowSOM plotting options
#' PlotMarker(flowSOM.res,
#' "CD19",
#' view = "grid",
#' equalNodeSize = TRUE,
#' backgroundValues = 1:100 == 27,
#' backgroundColors = c("white", "red"))
#'
#'
#' @importFrom grDevices colorRampPalette
#' @importFrom ggplot2 ggtitle
#'
#' @export
PlotMarker <- function(fsom,
marker,
refMarkers = fsom$map$colsUsed,
title = GetMarkers(fsom, marker),
colorPalette = FlowSOM_colors,
lim = NULL,
...){
fsom <- UpdateFlowSOM(fsom)
# Get median values to visualise
mfis <- GetClusterMFIs(fsom)
# Get column names
channels <- GetChannels(fsom, marker)
# Compute limits based on all reference markers
ref_channels <- GetChannels(fsom, refMarkers)
if (is.null(lim)) lim <- c(min(mfis[, ref_channels]),
max(mfis[, ref_channels]))
plotList <- lapply(seq_along(channels), function(channelI){
# Use MFI values as variable to plot
p <- PlotVariable(fsom,
variable = mfis[, channels[channelI]],
variableName = "MFI",
colorPalette = colorPalette,
lim = lim,
...)
# Add title
if (is.na(title[channelI])) title[channelI] <- ""
p <- p + ggplot2::ggtitle(title[channelI])
})
p <- ggpubr::ggarrange(plotlist = plotList, common.legend = TRUE,
legend = "right")
return(p)
}
#' PlotVariable
#'
#' Plot a variable for all nodes
#'
#' Plot FlowSOM grid or tree, colored by node values given in variable
#'
#' @param fsom FlowSOM object
#' @param variable A vector containing a value for every cluster
#' @param variableName Label to show on the legend
#' @param colorPalette Color palette to use. Can be a function or a vector.
#' @param lim Limits for the scale
#' @param ... Additional arguments to pass to \code{\link{PlotFlowSOM}},
#' e.g. view, backgroundValues, equalNodeSize ...
#'
#' @seealso \code{\link{PlotStars}}, \code{\link{QueryStarPlot}},
#' \code{\link{PlotFlowSOM}}, \code{\link{PlotLabels}},
#' \code{\link{PlotNumbers}}, \code{\link{PlotMarker}},
#' \code{\link{PlotPies}}, \code{\link{PlotSD}}
#'
#' @examples
#' # Build FlowSOM model
#' fileName <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#' flowSOM.res <- FlowSOM(fileName,
#' compensate = TRUE, transform = TRUE, scale = FALSE,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' # Plot some random values
#' rand <- runif(flowSOM.res$map$nNodes)
#' PlotVariable(flowSOM.res,
#' variable = rand,
#' variableName = "Random")
#'
#' PlotVariable(flowSOM.res,
#' variable = flowSOM.res$metaclustering,
#' variableName = "Metaclustering") %>%
#' AddLabels(labels = flowSOM.res$metaclustering)
#'
#' @export
PlotVariable <- function(fsom,
variable,
variableName = "",
colorPalette = FlowSOM_colors,
lim = NULL,
...){
fsom <- UpdateFlowSOM(fsom)
if (length(variable) != fsom$map$nNodes){
stop(paste0("Length of 'variable' should be equal to number of clusters in",
" FlowSOM object (", fsom$map$nNodes, " clusters and ",
length(variable), " variables)."))
}
# Base plot
p <- PlotFlowSOM(fsom = fsom,
...)
p <- AddNodes(p = p,
values = variable,
colorPalette = colorPalette,
lim = lim,
label = variableName)
return(p)
}
#' PlotDimRed
#'
#' Plot a dimensionality reduction
#'
#' Plot a dimensionality reduction of fsom$data
#'
#' @param fsom FlowSOM object, as generated by \code{\link{BuildMST}}
#' @param colsToUse The columns used for the dimensionality reduction.
#' Default = fsom$map$colsUsed.
#' @param colorBy Defines how the dimensionality reduction will be
#' colored. Can be "metaclusters" (default), "clusters"
#' (or abbreviations) or a marker/channel/index.
#' @param colors A vector of custom colors. Default returns ggplot
#' colors for categorical variables and the FlowSOM colors
#' for continuous variables. When using a categorical
#' variable, the vector must be as long as
#' the levels of the categorical variable.
#' @param lim Limits for the colorscale
#' @param cTotal The total amount of cells to be used in the
#' dimensionality reduction. Default is all the cells.
#' @param dimred A dimensionality reduction function.
#' Default = Rtsne::Rtsne. Alternatively, a data.frame or
#' matrix with either equal number of rows to the
#' fsom or an OriginalID column. Recommended to put
#' cTotal to NULL when providing a matrix (or ensuring
#' that the dimred corresponds to subsampling the
#' flowSOM data for cTotal cells with the same seed).
#' @param extractLayout A function to extract the coordinates from the results
#' of the dimred default = function(dimred){dimred$Y}.
#' @param label If label = TRUE (default), labels are added to plot.
#' @param returnLayout If TRUE, this function returns a dataframe with
#' the layout of dimred and the original IDs and the
#' plot. Default = FALSE.
#' @param seed A seed for reproducibility.
#' @param title A title for the plot.
#' @param ... Additional arguments to pass to dimred.
#'
#' @return A dimensionality reduction plot made in ggplot2
#'
#' @examples
#' file <- system.file("extdata", "68983.fcs", package="FlowSOM")
#' flowSOM.res <- FlowSOM(file, compensate = TRUE, transform = TRUE,
#' scale = TRUE,
#' colsToUse = c(9, 12, 14:18), nClus = 10, silent = FALSE,
#' xdim = 7, ydim = 7)
#' PlotDimRed(flowSOM.res, cTotal = 5000, seed = 1, title = "t-SNE")
#' PlotDimRed(flowSOM.res, cTotal = 5000, colorBy = "CD3", seed = 1,
#' title = "t-SNE")
#'
#' @import ggplot2
#' @importFrom Rtsne Rtsne
#' @importFrom tidyr pivot_longer
#'
#' @export
PlotDimRed <- function(fsom,
colsToUse = fsom$map$colsUsed,
colorBy = "metaclusters",
colors = NULL,
lim = NULL,
cTotal = NULL,
dimred = Rtsne::Rtsne,
extractLayout = function(dimred){dimred$Y},
label = TRUE,
returnLayout = FALSE,
seed = NULL,
title = NULL,
...){
dimred_data <- fsom$data
colorBy_pmatch <- pmatch(colorBy, c("metaclusters", "clusters"))
if (any(is.na(colorBy_pmatch))){
if (all(colorBy %in% colnames(dimred_data)) ||
all(colorBy %in% GetMarkers(fsom, colnames(dimred_data))) ||
all(colorBy %in% seq_len(ncol(dimred_data)))){
dimred_col <- fsom$data[, GetChannels(fsom, colorBy), drop = FALSE]
colnames(dimred_col) <- GetMarkers(fsom, colnames(dimred_col))
colorBy <- "marker"
} else {
stop(paste0("\"colorBy\" should be \"metaclusters\", \"clusters\" or a ",
"vector of channels, markers or indices"))
}
} else {
if (length(colorBy) > 1){
stop(paste0("\"colorBy\" should be \"metaclusters\", \"clusters\" or a ",
"vector of channels, markers or indices"))
}
colorBy <- c("metaclusters", "clusters")[colorBy_pmatch]
if (length(colorBy) == 1 && colorBy == "metaclusters") {
if (is.null(fsom$metaclustering)) stop("No metaclustering present")
dimred_col <- as.data.frame(GetMetaclusters(fsom))
} else if (length(colorBy) == 1 && colorBy == "clusters") {
dimred_col <- as.data.frame(as.factor(GetClusters(fsom)))
}
}
if (is.null(colors)){
if (colorBy == "marker") colors <- FlowSOM_colors(9)
else colors <- gg_color_hue(nlevels(dimred_col[, 1]))
} else {
if (length(colors) != nlevels(dimred_col[, 1]) && colorBy != "marker") {
stop(paste0("Length of \"colors\" (", length(colors), ") should be ",
"equal to the amount of levels in \"", colorBy, "\" (",
nlevels(dimred_col[, 1]), ")."))
}
}
if (!is.null(colsToUse)) dimred_data <- dimred_data[, GetChannels(fsom,
colsToUse)]
if (!is.null(seed)) set.seed(seed)
if (!is.null(cTotal) && cTotal < nrow(dimred_data)) {
downsample <- sample(seq_len(nrow(dimred_data)), cTotal)
dimred_data <- dimred_data[downsample, , drop = FALSE]
dimred_col <- dimred_col[downsample, , drop = FALSE]
} else {
downsample <- seq_len(nrow(dimred_data))
}
if (is.function(dimred)){
dimred_res <- dimred(dimred_data, ...)
dimred_layout <- as.data.frame(extractLayout(dimred_res))
if (nrow(dimred_layout) == 0 && ncol(dimred_layout) != 2) {
stop("Please use the right extraction function in extractLayout")
}
} else if((is.matrix(dimred) | is.data.frame(dimred)) &
(nrow(dimred) == nrow(dimred_data) |
any(colnames(dimred) == "Original_ID"))){
id_col <- which(colnames(dimred) == "Original_ID")
dimred_layout <- as.data.frame(dimred[,-id_col])
if("Original_ID" %in% colnames(dimred)){
dimred_data <- dimred_data[dimred[,"Original_ID"], , drop = FALSE]
dimred_col <- dimred_col[dimred[,"Original_ID"], , drop = FALSE]
}
} else stop("dimred should be a dimensionality reduction method or matrix")
colnames(dimred_layout) <- c("dimred_1", "dimred_2")
dimred_plot <- cbind(dimred_layout, dimred_col)
if (colorBy == "marker"){
dimred_plot <- dimred_plot %>% tidyr::pivot_longer(3:ncol(dimred_plot),
names_to = "markers")
if (requireNamespace("scattermore", quietly = TRUE)) {
p <- ggplot2::ggplot(dimred_plot) +
scattermore::geom_scattermore(ggplot2::aes(x = .data$dimred_1,
y = .data$dimred_2,
col = .data$value),
pointsize = 1)
} else {
message("For faster plotting with more datapoints, please install \"scattermore\"")
p <- ggplot2::ggplot(dimred_plot) +
ggplot2::geom_point(ggplot2::aes(x = .data$dimred_1,
y = .data$dimred_2,
col = .data$value),
size = 1)
}
p <- p + ggplot2::facet_wrap(~markers) +
ggplot2::theme_minimal() +
ggplot2::coord_fixed() +
ggplot2::scale_color_gradientn(colors = colors, limits = lim)
} else {
colnames(dimred_plot) <- c("dimred_1", "dimred_2", "colors")
median_x <- tapply(dimred_plot[,"dimred_1"], dimred_plot[,"colors"], median)
median_y <- tapply(dimred_plot[,"dimred_2"], dimred_plot[,"colors"], median)
if (requireNamespace("scattermore", quietly = TRUE)) {
p <- ggplot2::ggplot(dimred_plot) +
scattermore::geom_scattermore(ggplot2::aes(x = .data$dimred_1,
y = .data$dimred_2,
col = .data$colors),
pointsize = 1)
} else {
message("For faster plotting with more datapoints, please install \"scattermore\"")
p <- ggplot2::ggplot(dimred_plot) +
ggplot2::geom_point(ggplot2::aes(x = .data$dimred_1,
y = .data$dimred_2,
col = .data$colors),
size = 1)
}
p <- p + ggplot2::theme_minimal() + ggplot2::coord_fixed() +
scale_color_manual(values = colors)
if (label){
if (requireNamespace("ggrepel", quietly = TRUE)) {
p <- p + ggrepel::geom_label_repel(ggplot2::aes(x = .data$x,
y = .data$y,
label = .data$label,
color = .data$label),
data = data.frame(x = median_x,
y = median_y,
label = names(median_x)),
segment.color = "gray", force = 20,
segment.size = 0.2, point.padding = 0.5)
} else {
message("For better labels, please install \"ggrepel\"")
p <- p + ggplot2::geom_label(ggplot2::aes(x = .data$x,
y = .data$y,
label = .data$label,
color = .data$label),
data = data.frame(x = median_x,
y = median_y,
label = names(median_x)))
}
p <- p + labs(col = colorBy)
}
}
if (!is.null(title)) p <- p + ggplot2::ggtitle(title)
if (returnLayout) {
if (!is.null(cTotal)){
dimred_layout <- data.frame(dimred_layout, "Original_ID" = downsample)
}
return(list("plot" = p, "layout" = dimred_layout))
} else return(p)
}
#' PlotManualBars
#'
#' Function to plot the manual labels per FlowSOM (meta)cluster in a barplot
#'
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}} or
#' by \code{\link{NewData}}. The clusters and metaclusters
#' will be plotted in the order of the factor levels.
#' @param fcs FCS file that should be mapped on the FlowSOM object.
#' Default is NULL.
#' @param manualVector Vector with cell labels, e.g. obtained by manual gating
#' @param manualOrder Optional vector with unique cell labels to fix in which
#' order the cell labels should be shown
#' @param colors Optional color vector, should have the same length as
#' the number of unique cell labels
#' @param list_insteadof_plots If \code{FALSE} (default), it returns multiple
#' plots. If \code{TRUE}, it returns a list of
#' ggplot objects
#'
#' @return Either a plot or a ggplot objects list is returned.
#'
#' @examples
#' # Identify the files
#' fcs_file <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#' gating_file <- system.file("extdata", "gatingResult.csv", package = "FlowSOM")
#'
#' # Specify the cell types of interest for assigning one label per cell
#' cellTypes <- c("B cells",
#' "gd T cells", "CD4 T cells", "CD8 T cells",
#' "NK cells", "NK T cells")
#'
#' # Load manual labels (e.g. GetFlowJoLabels can be used to extract labels from
#' # an fcs file)
#'
#' gatingResult <- as.factor(read.csv(gating_file, header = FALSE)[, 1])
#'
#' # Build a FlowSOM object
#' flowSOM.res <- FlowSOM(fcs_file,
#' scale = TRUE,
#' compensate = TRUE,
#' transform = TRUE,
#' toTransform = 8:18,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' # Make the barplot of the manual labels
#' pdf("PlotManualBars.pdf")
#' PlotManualBars(fsom = flowSOM.res,
#' fcs = fcs_file,
#' manualVector = gatingResult,
#' manualOrder = c(cellTypes, "Unlabeled"),
#' colors = c("#F8766D", "#B79F00", "#00BA38", "#00BFC4",
#' "#619CFF", "#F564E3", "#D3D3D3"))
#' dev.off()
#'
#' @import ggplot2
#' @importFrom dplyr mutate
#'
#' @export
#'
PlotManualBars <- function(fsom, fcs = NULL,
manualVector, manualOrder = NULL,
colors = NULL, list_insteadof_plots = FALSE){
#----Warnings----
if (!is.null(manualOrder) &
!length(manualOrder) == length(unique(manualVector))){
stop(paste0("Length of the manualOrder vector (", length(manualOrder),
") should have the same length as the number of unique labels",
"in manualVector (", length(unique(manualVector)), ")."))
}
if (!is.null(colors) & !length(colors) >= length(unique(manualVector))){
stop(paste0("Length of the colors vector (", length(colors),") should have",
"at least the same length as the number of unique labels in ",
"manualVector (", length(unique(manualVector)), ")."))
}
#----Map FCS on fsom----
if (!is.null(fcs)){
fsom_tmp <- NewData(fsom, fcs)
} else {
fsom_tmp <- fsom
}
df <- data.frame("Manual" = manualVector,
"MC" = GetMetaclusters(fsom_tmp),
"C" = GetClusters(fsom_tmp),
stringsAsFactors = FALSE)
if(is.null(manualOrder)) {
manualOrder <- unique(manualVector)
}
#----Relative barplots MC----
df_s <- data.frame(table(df[, 1:2])) %>%
dplyr::mutate("Freq" = 100 * (.data$Freq / sum(.data$Freq))) %>%
dplyr::mutate("MC" = factor(.data$MC, levels = levels(fsom$metaclustering))) %>%
dplyr::mutate("Manual" = factor(.data$Manual, levels = manualOrder))
p1 <- ggplot2::ggplot(data = df_s,
ggplot2::aes(fill = .data$Manual,
y = .data$Freq,
x = .data$MC)) +
ggplot2::geom_bar(position = "stack", stat = "identity") +
ggplot2::theme_minimal() +
ggplot2::ggtitle("Manual labels per metacluster") +
ggplot2::ylab("Percentage of cells") +
ggplot2::xlab("")
if(!is.null(colors)) {
p1 <- p1 + ggplot2::scale_fill_manual(values = colors)
}
#----MC composition----
df_s <- data.frame(table(df[, 1:2]))
for (mc in levels(fsom$metaclustering)){
df_s$Freq[df_s$MC == mc] <-
df_s$Freq[df_s$MC == mc] / sum(df_s$Freq[df_s$MC == mc])
}
df_s <- df_s %>%
dplyr::mutate("MC" = factor(.data$MC, levels = levels(fsom$metaclustering))) %>%
dplyr::mutate("Manual" = factor(.data$Manual, levels = manualOrder))
p2 <- ggplot2::ggplot(data = df_s,
ggplot2::aes(fill = .data$Manual,
y = .data$Freq,
x = .data$MC)) +
ggplot2::geom_bar(position = "stack", stat = "identity") +
ggplot2::theme_minimal() +
ggplot2::ylab("") +
ggplot2::xlab("") +
ggplot2::ggtitle("Manual labels per metacluster") +
ggplot2::theme(axis.text.y = ggplot2::element_blank())
if(!is.null(colors)) {
p2 <- p2 + ggplot2::scale_fill_manual(values = colors)
}
#----Relative barplots C----
df_s <- data.frame(table(df[, c(1, 3)])) %>%
dplyr::mutate("Freq" = 100 * (.data$Freq / sum(.data$Freq))) %>%
dplyr::mutate("MC" = fsom$metaclustering[as.numeric(levels(.data$C))[.data$C]]) %>%
dplyr::mutate("MC" = factor(.data$MC, levels = levels(fsom$metaclustering))) %>%
dplyr::mutate("C" = factor(.data$C, levels = seq_len(NClusters(fsom)))) %>%
dplyr::mutate("Manual" = factor(.data$Manual, levels = manualOrder))
p3 <- ggplot2::ggplot(data = df_s,
ggplot2::aes(fill = .data$Manual,
y = .data$Freq,
x = .data$C)) +
ggplot2::geom_bar(position = "stack", stat = "identity") +
ggplot2::theme_minimal() +
ggplot2::ggtitle("Manual labels per cluster") +
ggplot2::facet_wrap(~.data$MC, scales = "free_x") +
ggplot2::ylab("Percentage of cells") +
ggplot2::xlab("") +
ggplot2::theme(strip.text = ggplot2::element_text(color = "gray"))
if(!is.null(colors)) {
p3 <- p3 + ggplot2::scale_fill_manual(values = colors)
}
#----C composition----
df_s <- data.frame(table(df[, c(1, 3)]))
for (c in seq_len(NClusters(fsom))){
df_s$Freq[df_s$C == c] <- df_s$Freq[df_s$C == c]/sum(df_s$Freq[df_s$C == c])
}
df_s <- df_s %>%
dplyr::mutate("MC" = fsom$metaclustering[as.numeric(levels(df_s$C))[df_s$C]]) %>%
dplyr::mutate("MC" = factor(.data$MC, levels = levels(fsom$metaclustering))) %>%
dplyr::mutate("C" = factor(.data$C, levels = seq_len(NClusters(fsom)))) %>%
dplyr::mutate("Manual" = factor(.data$Manual, levels = manualOrder))
p4 <- ggplot2::ggplot(data = df_s,
ggplot2::aes(fill = .data$Manual,
y = .data$Freq,
x = .data$C)) +
ggplot2::geom_bar(position = "stack", stat = "identity") +
ggplot2::theme_minimal() +
ggplot2::ylab("") +
ggplot2::xlab("") +
ggplot2::ggtitle("Manual labels per cluster") +
ggplot2::facet_wrap(~.data$MC, scales = "free_x") +
ggplot2::theme(axis.text.y = ggplot2::element_blank())
if(!is.null(colors)) {
p4 <- p4 + ggplot2::scale_fill_manual(values = colors)
}
#----Print plot or return list----
if (!list_insteadof_plots) {
print(p1)
print(p2)
print(p3)
print(p4)
} else {
return(list(p1, p2, p3, p4))
}
}
#' Plot2DScatters
#'
#' Function to draw 2D scatter plots of FlowSOM (meta)clusters
#'
#' Plot multiple 2D scatter plots in a png file. A subset of fsom$data is
#' plotted in gray, and those of the selected clusters and metaclusters are
#' plotted in color.
#'
#' @param fsom FlowSOM object, as created by \code{\link{FlowSOM}}
#' @param channelpairs List in which each element is a pair of channel
#' or marker names
#' @param clusters Vector or list (to combine multiple clusters in one
#' plot) with indices of clusters of interest
#' @param metaclusters Vector or list (to combine multiple metaclusters in
#' one plot) with indices of metaclusters of interest
#' @param maxBgPoints Maximum number of background cells to plot
#' @param sizeBgPoints Size of the background cells
#' @param maxPoints Maximum number of (meta)cluster cells to plot
#' @param sizePoints Size of the (meta)cluster cells
#' @param xLim Optional vector of a lower and upper limit of the x-axis
#' @param yLim Optional vector of a lower and upper limit of the y-axis
#' @param xyLabels Determines the label of the x- and y-axis. Can be
#' "marker" and\\or "channel" or abbrevations.
#' Default = "marker".
#' @param density Default is \code{TRUE} to color the (meta)cluster
#' points according to density. Set to \code{FALSE} to
#' use a plain color
#' @param centers Default is \code{TRUE} to show the cluster centers
#' @param colors Colors for all the cells in the selected nodes
#' (ordered list). First the clusters are colored,
#' then the metaclusters. If \code{NULL}, the default
#' ggplot colors, indexed by metacluster number, are used.
#' @param plotFile If a filepath for a png is given (default =
#' 2DScatterPlots.png), the plots will be plotted in
#' the corresponding png file. If \code{NULL}, a list
#' of ggplot objects will be returned
#'
#'
#' @return If \code{plot} is \code{TRUE}, nothing is returned and a plot is
#' drawn in which background cells are plotted in gray and the cells of
#' the selected nodes in color. If \code{plot} is \code{FALSE}, a ggplot
#' objects list is returned.
#'
#'
#' @examples
#' # Identify the files
#' fcs <- flowCore::read.FCS(system.file("extdata", "68983.fcs",
#' package = "FlowSOM"))
#'
#' # Build a FlowSOM object
#' flowSOM.res <- FlowSOM(fcs,
#' scale = TRUE,
#' compensate = TRUE,
#' transform = TRUE,
#' toTransform = 8:18,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' # Make the 2D scatter plots of the clusters and metaclusters of interest
#' Plot2DScatters(fsom = flowSOM.res,
#' channelpairs = list(c("PE-Cy7-A", "PE-Cy5-A"),
#' c("PE-Texas Red-A", "Pacific Blue-A")),
#' clusters = c(1, 48, 49, 82, 95),
#' metaclusters = list(c(1, 4), 9),
#' density = FALSE)
#'
#' Plot2DScatters(fsom = flowSOM.res,
#' channelpairs = list(c("PE-Texas Red-A", "Pacific Blue-A")),
#' metaclusters = list(c(1, 4)),
#' density = FALSE,
#' colors = list(c("red", "green")))
#'
#' @import ggplot2
#' @importFrom colorRamps matlab.like2
#' @importFrom grDevices png dev.off
#' @importFrom ggpubr ggarrange
#'
#' @export
#'
Plot2DScatters <- function(fsom,
channelpairs,
clusters = NULL,
metaclusters = NULL,
maxBgPoints = 3000,
sizeBgPoints = 0.5,
maxPoints = 1000,
sizePoints = 0.5,
xLim = NULL,
yLim = NULL,
xyLabels = c("marker"),
density = TRUE,
centers = TRUE,
colors = NULL,
plotFile = "2DScatterPlots.png"){
if(!is.null(fsom$metaclustering)){
metacluster <- as.numeric(fsom$metaclustering)
nMetaclusters <- NMetaclusters(fsom)
} else {
metacluster <- rep(1, NClusters(fsom))
nMetaclusters <- 1
}
medianValues <- fsom$map$medianValues
cellCluster <- GetClusters(fsom)
xyLabels <- pmatch(xyLabels, c("marker", "channel"))
#----Warnings----
if (density == FALSE &
!is.null(colors) &
!((length(clusters) + length(metaclusters)) == length(colors))){
stop("Length of colors list should be equal to the joined length ",
"of the clusters and metaclusters")
}
if (density == TRUE & !requireNamespace("ggpointdensity", quietly = TRUE)){
message("\"ggpointdensity\" not available. Please install.")
density <- FALSE
}
#----Join the clusters and metaclusters of interest----
i <- sample(nrow(fsom$data),
min(nrow(fsom$data), maxBgPoints))
# loop over all subsets at once
subsets <- list("Cluster" = as.list(clusters),
"Metacluster" = as.list(metaclusters))
plots_list <- list()
color_n <- 0
if (any(is.na(xyLabels)) | length(xyLabels) > 2){
stop("xyLabels should be \"marker\" and\\or \"channel\"")
} else {
xyLabels <- c("marker", "channel")[xyLabels]
}
for (group in names(subsets)){
for (subset in subsets[[group]]){
color_n <- color_n + 1
n <- as.numeric(unlist(subset))
for (channelpair in channelpairs){
channelpair <- GetChannels(fsom, channelpair)
#----background dataframe----
df_bg <- data.frame(fsom$data[i, c(channelpair[1], channelpair[2])])
#----(meta)cluster dataframe----
if(group == "Cluster") {
# dataframe with cluster's points
df_ss <- data.frame(fsom$data[cellCluster %in% n,
c(channelpair[1], channelpair[2]),
drop = FALSE],
"Population" = cellCluster[cellCluster %in% n])
# dataframe with centers
df_c <- data.frame(medianValues[n,
c(channelpair[1], channelpair[2]),
drop = FALSE],
"Population" = factor(n, levels = n))
col <- gg_color_hue(nMetaclusters)[metacluster[n]]
} else {
df_ss <- data.frame(fsom$data[which(metacluster[cellCluster] %in% n),
c(channelpair[1], channelpair[2]),
drop = FALSE],
"Population" =
metacluster[cellCluster[
which(metacluster[cellCluster] %in% n)]])
df_c_Population <- metacluster[
which(metacluster[1:nrow(medianValues)] %in% n),
drop = FALSE]
df_c <- data.frame(
medianValues[which(metacluster[1:nrow(medianValues)] %in% n),
c(channelpair[1], channelpair[2]),
drop = FALSE],
"Population" = df_c_Population)
col <- gg_color_hue(nMetaclusters)[n]
}
df_ss <- data.frame(df_ss[sample(nrow(df_ss),
min(nrow(df_ss), maxPoints)), ])
df_ss$Population <- factor(df_ss$Population, levels = subset)
df_c$Population <- factor(df_c$Population, levels = subset)
colnames(df_c) <- c("m1", "m2", "Population")
colnames(df_ss)[1:2] <- colnames(df_bg) <- c("m1", "m2")
#----ggplots----
cl_or_mcl <- paste0(group, ifelse(length(subset) > 1, "s", ""), ": ")
subset_names <- ifelse(group == "Cluster",
paste0(subset, collapse = ", "),
paste0(levels(fsom$metaclustering)[unlist(subset)],
collapse = ", "))
title <- paste0(cl_or_mcl, subset_names)
if ("marker" %in% xyLabels && length(xyLabels) == 1) {
xyLabs <- GetMarkers(fsom, channelpair)
} else if ("channel" %in% xyLabels && length(xyLabels) == 1){
xyLabs <- GetChannels(fsom, channelpair)
} else if (all(c("channel", "marker") %in% xyLabels) && length(xyLabels) == 2){
channels <- GetChannels(fsom, channelpair)
xyLabs <- paste0(GetMarkers(fsom, channelpair), " (", channels, ")")
}
p <- ggplot2::ggplot(data = df_ss,
ggplot2::aes(x = .data$m1,
y = .data$m2)) +
ggplot2::geom_point(data = df_bg,
color = "gray",
size = sizeBgPoints) + # background dot plot
ggplot2::theme_classic() +
ggplot2::ggtitle(title) +
ggplot2::xlab(xyLabs[1]) +
ggplot2::ylab(xyLabs[2]) +
ggplot2::theme(legend.position = "none")
if (!is.null(xLim)) p <- p + ggplot2::xlim(xLim)
if (!is.null(yLim)) p <- p + ggplot2::ylim(yLim)
if (density) {
# subset density plot
p <- p + ggpointdensity::geom_pointdensity(size = sizePoints) +
ggplot2::scale_color_gradientn(colors =
colorRamps::matlab.like2(10))
} else {
# if no colors are given, the default colors of ggplot are used
if (is.null(colors)){
p <- p + ggplot2::geom_point(ggplot2::aes(color = .data$Population),
size = sizePoints) +
ggplot2::scale_color_manual(values = col)
} else {
#subset plot, metacluster colors
if (length(colors[[color_n]]) != nlevels(df_ss$Population)){
stop(paste0("For \"", title, "\", we expect ",
nlevels(df_ss$Population), " colors while only ",
length(colors[[color_n]]), " are given."))
}
p <- p + ggplot2::geom_point(ggplot2::aes(color = .data$Population),
size = sizePoints) +
ggplot2::scale_color_manual(values = colors[[color_n]])
}
}
#----add cluster centers----
if (centers) {
if (!density){
if (!is.null(colors)){
col_c <- colors[[color_n]]
} else {
col_c <- col
}
} else {
col_c <- rep("white", nrow(df_c))
}
p <- p + ggplot2::geom_point(data = df_c,
shape = 21,
ggplot2::aes(fill = .data$Population),
color = "black",
size = 3,
stroke = 1) +
ggplot2::scale_fill_manual(values = col_c)
}
plots_list[[length(plots_list) + 1]] <- p
}
}
}
if (!is.null(plotFile)) {
grDevices::png(plotFile,
width = 400 * length(channelpairs),
height = 400 * (length(clusters) + length(metaclusters)))
print(ggpubr::ggarrange(plotlist = plots_list,
ncol = length(channelpairs),
nrow = (length(clusters) + length(metaclusters)),
common.legend = FALSE))
grDevices::dev.off()
} else {
return(plots_list)
}
}
#' QueryStarPlot
#'
#' Query a certain cell type
#'
#' Identify nodes in the tree which resemble a certain profile of "high"
#' or "low" marker expressions.
#'
#' @param fsom FlowSOM object, as generated by \code{\link{BuildMST}}
#' @param query Array containing "high" or "low" (or abbreviations)
#' for the specified column names of the FlowSOM data.
#' @param plot If true, a plot with a gradient of scores for the
#' nodes is shown.
#' @param colorPalette Color palette to be used for colors for "stars",
#' "pies" or "marker". Can be either a function or an
#' array specifying colors.
#' @param backgroundColors Color to use for nodes with a high score in the plot.
#' Default is red.
#' @param ... Additional arguments to pass to \code{\link{PlotFlowSOM}}
#'
#' @return A list, containing the ids of the selected nodes, the individual
#' scores for all nodes and the scores for each marker for each node
#'
#' @seealso \code{\link{PlotStars}}, \code{\link{PlotVariable}},
#' \code{\link{PlotFlowSOM}}, \code{\link{PlotLabels}},
#' \code{\link{PlotNumbers}}, \code{\link{PlotMarker}},
#' \code{\link{PlotPies}}, \code{\link{PlotSD}}
#'
#' @examples
#' file <- system.file("extdata", "68983.fcs", package="FlowSOM")
#' flowSOM.res <- FlowSOM(file, compensate = TRUE, transform = TRUE,
#' scale = TRUE, colsToUse = c(9, 12, 14:18), nClus = 10,
#' silent = FALSE, xdim = 7, ydim = 7)
#' query <- c("CD3" = "high", #CD3
#' "CD4" = "low", #TCRb
#' "CD8" = "high") #CD8
#' query_res <- QueryStarPlot(flowSOM.res, query, equalNodeSize = TRUE)
#'
#' cellTypes <- factor(rep("Unlabeled", 49),
#' levels = c("Unlabeled", "CD8 T cells"))
#' cellTypes[query_res$selected] <- "CD8 T cells"
#' PlotStars(flowSOM.res,
#' backgroundValues = cellTypes,
#' backgroundColors = c("#FFFFFF00", "#ca0020aa"))
#'
#' @importFrom grDevices colorRampPalette
#' @importFrom ggpubr ggarrange
#'
#' @export
QueryStarPlot <- function(fsom,
query,
plot = TRUE,
colorPalette = FlowSOM_colors,
backgroundColors = "#CA0020",
...){
fsom <- UpdateFlowSOM(fsom)
names(query) <- GetChannels(fsom, names(query))
markers <- names(query)
lowMarkers <- pmatch("l", query)
query <- ParseQuery(fsom, query)
if (plot){
fP <- PlotStars(fsom = fsom,
markers = markers,
backgroundColors =
grDevices::colorRampPalette(c(rep("#FFFFFF00", 3),
backgroundColors)),
backgroundValues = query$nodeScores,
list_insteadof_ggarrange = TRUE,
...)
nMarkers <- length(markers)
starHeight <- rep(1, nMarkers)
starHeight[lowMarkers] <- 0
l <- PlotStarLegend(fsom$prettyColnames[markers],
colors = colorPalette(nMarkers),
starHeight = starHeight)
p <- ggpubr::ggarrange(fP$tree,
ggpubr::ggarrange(l, fP$backgroundLegend, ncol = 1),
NULL,
ncol = 3,
widths = c(3, 1, 0.3),
legend = "none")
query$plot <- p
}
return(query)
}
#' QueryMultiple
#'
#' Function which takes a named list of multiple cell types, where every item is
#' a named vector with values "high"/"low" and the names correspond to the
#' markers or channels (e.g. as generated by parse_markertable).
#'
#' @param fsom FlowSOM object
#' @param cellTypes Description of the cell types. Named list, with one named
#' vector per cell type containing "high"/"low" values
#' @param plotFile Path to a pdf file to save the plots (default is
#' queryMultiple.pdf). If \code{NULL}, no plots will be
#' generated
#' @param ... Additional arguments to pass to \code{\link{QueryStarPlot}}
#'
#' @return A label for every FlowSOM cluster (Unknown or one of the celltype
#' names of the list, if selected by QueryStarPlot)
#'
#' @examples
#' file <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#' ff <- flowCore::read.FCS(file)
#' # Use the wrapper function to build a flowSOM object (saved in flowSOM.res)
#' # and a metaclustering (saved in flowSOM.res[["metaclustering"]])
#' flowSOM.res <- FlowSOM(ff, compensate = TRUE, transform = TRUE, scale = TRUE,
#' colsToUse = c(9, 12, 14:18), nClus = 10, silent = FALSE,
#' xdim = 7, ydim = 7)
#' cellTypes <- list("CD8 T cells" = c("PE-Cy7-A" = "high",
#' "APC-Cy7-A" = "high",
#' "Pacific Blue-A" = "high"),
#' "B cells" = c("PE-Cy5-A" = "high"),
#' "NK cells" = c("PE-A" = "high",
#' "PE-Cy7-A" = "low",
#' "APC-Cy7-A" = "low"))
#' query_res <- QueryMultiple(flowSOM.res, cellTypes, "query_multiple.pdf")
#'
#' @export
QueryMultiple <- function(fsom,
cellTypes,
plotFile = "queryMultiple.pdf",
...){
fsom <- UpdateFlowSOM(fsom)
labels <- rep("Unlabeled", fsom$map$nNodes)
plotList <- list()
plot <- ifelse(is.null(plotFile), FALSE, TRUE)
for(cell_type in names(cellTypes)){
query <- cellTypes[[cell_type]]
query_res <- QueryStarPlot(fsom,
equalNodeSize = TRUE,
query = query,
title = cell_type,
plot = plot,
...)
if (plot) plotList[[cell_type]] <- query_res$plot
labels[query_res$selected] <- cell_type
}
if (plot){
pdf(plotFile, useDingbats = FALSE)
for (p in plotList){
print(p)
}
dev.off()
}
return(labels)
}
#' PlotSD
#'
#' Plot FlowSOM grid or tree, colored by standard deviation.
#'
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}}
#' @param marker If a marker/channel is given, the sd for this marker is
#' shown. Otherwise, the maximum ratio is used.
#' @param ... Additional arguments to pass to \code{\link{PlotFlowSOM}}
#'
#' @return Nothing is returned. A plot is drawn in which each node
#' is colored depending on its standard deviation
#'
#' @seealso \code{\link{PlotStars}}, \code{\link{PlotVariable}},
#' \code{\link{PlotFlowSOM}}, \code{\link{PlotLabels}},
#' \code{\link{PlotNumbers}}, \code{\link{PlotMarker}},
#' \code{\link{PlotPies}}, \code{\link{QueryStarPlot}}
#'
#' @examples
#' # Read from file, build self-organizing map and minimal spanning tree
#' fileName <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#' flowSOM.res <- ReadInput(fileName, compensate = TRUE, transform = TRUE,
#' scale = TRUE)
#' flowSOM.res <- BuildSOM(flowSOM.res, colsToUse = c(9, 12, 14:18))
#' flowSOM.res <- BuildMST(flowSOM.res)
#'
#' PlotSD(flowSOM.res)
#'
#' @importFrom grDevices colorRampPalette
#'
#' @export
PlotSD <- function(fsom,
marker = NULL,
...){
fsom <- UpdateFlowSOM(fsom)
if(!is.null(marker)) marker <- GetChannels(fsom, marker)
SDs <- ParseSD(fsom, marker)
PlotVariable(fsom = fsom,
variable = SDs,
variableName = "SD",
...)
}
#' PlotStarLegend
#'
#' Plots star legend
#'
#' Function makes the legend of the FlowSOM star plot
#'
#' @param markers Vector of markers used in legend
#' @param colors Color palette for the legend. Can be a vector or a
#' function.
#' @param starHeight Star height. Default = 1.
#'
#' @return Returns nothing, but plots a legend for FlowSOM star plot
#'
#' @seealso \code{\link{PlotFlowSOM}}
#'
#' @examples
#' PlotStarLegend(c("CD3", "CD4", "CD8"),
#' FlowSOM_colors(3))
#'
#' @import ggplot2
#' @importFrom dplyr count
#' @importFrom grDevices colorRampPalette
#'
#' @export
PlotStarLegend <- function(markers,
colors,
starHeight = 1){
requireNamespace("ggplot2")
markers <- factor(markers, levels = markers)
nMarkers <- length(markers)
circularCoords <- seq(from = 2 * pi / (nMarkers * 2),
by = 2 * pi / nMarkers,
length.out = nMarkers)
dfSegments <- data.frame(Markers = markers,
x = sin(circularCoords),
y = cos(circularCoords),
xend = 1.1 * ifelse(sin(circularCoords) >= 0,
1, -1),
yend = NA)
nLeftRight <- dplyr::count(dfSegments, .data$x >= 0)
if (nrow(nLeftRight) != 1){
by <- ifelse(nMarkers <= 8, 1, 0.65)
left <- seq(from = 0, by = by, length.out = nLeftRight[1, 2])
right <- -seq(from = 0, by = by, length.out = nLeftRight[2, 2])
dfSegments[which(dfSegments$x < 0), ]$yend <- left - mean(left)
dfSegments[which(dfSegments$x >= 0), ]$yend <- right - mean(right)
} else {
dfSegments$yend <- -2
}
horizontalLines <- data.frame(Markers = dfSegments$Markers,
x = dfSegments$xend, y = dfSegments$yend,
xend = dfSegments$xend +
ifelse(dfSegments$xend >= 0, 0.5, -0.5),
yend = dfSegments$yend,
stringsAsFactors = FALSE)
dfSegments <- rbind(dfSegments, horizontalLines)
dfLabels <- data.frame(x = horizontalLines$xend +
ifelse(horizontalLines$xend >= 0, 0.3, -0.3),
y = horizontalLines$yend)
markers_tmp <- rep(1, nMarkers)
names(markers_tmp) <- markers
dfStar <- ParseArcs(0, 0, markers_tmp, starHeight)
dfStar$Markers <- factor(dfStar$Marker, levels = markers)
l <- ggplot2::ggplot() +
ggplot2::xlim(c(-6, 6)) +
ggplot2::coord_fixed(clip = "off") +
ggplot2::theme_void() +
ggplot2::theme(legend.position = "none")
l <- AddStarsPies(l,
dfStar,
colors)
l <- AddScale(p = l,
values = markers,
colors = colors,
showLegend = FALSE,
type = "color")
l <- l +
ggplot2::geom_segment(data = dfSegments,
ggplot2::aes(x = .data$x, y = .data$y,
xend = .data$xend,
yend = .data$yend,
color = .data$Markers),
linewidth = 0.6)
l <- AddLabels(l,
labels = markers,
layout = dfLabels,
hjust = ifelse(horizontalLines$xend >= 0, 0, 1))
return(l)
}
#' ParseEdges
#'
#' Parses edges
#'
#' Function that parses the graph edges of the FlowSOM object into a dataframe
#'
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}}
#'
#' @return A dataframe consisting of start and end coordinates of edges
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{ParseNodeSize}},
#' \code{\link{ParseArcs}}, \code{\link{ParseQuery}},
#' \code{\link{ParseSD}}, \code{\link{AddMST}}
#'
#' @importFrom igraph as_edgelist
#'
ParseEdges <- function(fsom){
edgeList <- as.data.frame(igraph::as_edgelist(fsom$MST$g),
stringsAsFactors = FALSE)
coords <- fsom$MST$l
segmentPlot <- lapply(seq_len(nrow(edgeList)), function(row_id){
node_ids <- as.numeric(edgeList[row_id, ])
row <- c(coords[node_ids[1], 1],
coords[node_ids[1], 2],
coords[node_ids[2], 1],
coords[node_ids[2], 2])
return(row)
})
segmentPlot <- do.call(rbind, segmentPlot)
colnames(segmentPlot) <- c("x", "y", "xend", "yend")
return(as.data.frame(segmentPlot))
}
#' ParseLayout
#'
#' @param fsom FlowSOM object
#' @param layout "MST", "grid" or a matrix/dataframe with 2 columns and 1 row
#' per cluster
#'
#' @return dataframe with 2 columns and 1 row per cluster
#'
ParseLayout <- function(fsom, layout){
if (is.matrix(layout) || is.data.frame(layout)){
if (nrow(layout) == NClusters(fsom) &&
ncol(layout) == 2){
layout <- as.data.frame(layout)
} else {
stop(paste0("Number of rows should be equal to number of clusters (",
NClusters(fsom), " clusters) and number of columns should be equal ",
"to two."))
}
} else if (layout == "grid"){
layout <- as.data.frame(fsom$map$grid)
} else if (layout == "MST"){
layout <- as.data.frame(fsom$MST$l)
} else {
stop(paste0("The layout should be 'MST', 'grid' or a matrix/dataframe ",
"with 2 columns and 1 row per cluster."))
}
colnames(layout) <- c("x", "y")
return(layout)
}
#' ParseNodeSize
#'
#' Parses node size
#'
#' Function that parses the mapping of the FlowSOM object into node sizes
#' relative to the abundances of cells per cluster
#'
#' Scales node size relative to the abundances of cells per cluster
#'
#' @param nodeSizes A vector with node sizes
#' @param maxNodeSize Determines the maximum node size.
#' @param refNodeSize Reference for node size against which the nodeSizes
#' will be scaled. Default = max(nodeSizes)
#'
#' @return A vector is returned consisting of node sizes
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{ParseEdges}},
#' \code{\link{AutoMaxNodeSize}}, \code{\link{ParseArcs}},
#' \code{\link{ParseQuery}}, \code{\link{ParseSD}}
#'
#' @importFrom dplyr count mutate pull
#'
#' @export
ParseNodeSize <- function(nodeSizes, maxNodeSize, refNodeSize){
if(any(is.na(nodeSizes))) nodeSizes[is.na(nodeSizes)] <- 0
nNodes <- length(nodeSizes)
if (length(unique(nodeSizes)) == 1){
return(rep(maxNodeSize, nNodes))
}
scaledNodeSize <- data.frame(size = nodeSizes) %>%
dplyr::mutate(scaled = (.data$size / refNodeSize) * maxNodeSize ^ 2) %>%
dplyr::mutate(sqrt_scaled = sqrt(.data$scaled)) %>%
dplyr::pull(.data$sqrt_scaled)
return(scaledNodeSize)
}
#' ParseArcs
#'
#' Parses stars
#'
#' Function that parses the FlowSOM object into a dataframe for the star values
#' for ggplot
#'
#' @param x x coordinate of node
#' @param y y coordinate of node
#' @param arcValues A named vector with the frequency of how the node
#' should be divided
#' @param arcHeights The heights of the arcs
#'
#' @return A dataframe ready to use with ggplot, consisting of the coordinates
#' of centers, the radius and angles of the star values
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{ParseEdges}},
#' \code{\link{ParseNodeSize}},
#' \code{\link{ParseQuery}}, \code{\link{ParseSD}}
#'
ParseArcs <- function(x, y, arcValues, arcHeights){
markers <- names(arcValues)
arcValues <- c(0, (arcValues / sum(arcValues)) * (2 * pi))
arcValues <- cumsum(arcValues)
resDf <- data.frame(Markers = markers, x0 = x, y0 = y,
start = arcValues[-length(arcValues)],
end = arcValues[-1], value = arcHeights)
return(resDf)
}
#' ParseQuery
#'
#' Parses query
#'
#' Identify nodes in the tree which resemble a certain profile of "high"
#' or "low" marker expressions.
#'
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}}
#' @param query Array containing "high" or "low" for the specified
#' column names of the FlowSOM data
#'
#' @return A list, containing the ids of the selected nodes, the individual
#' scores for all nodes and the scores for each marker for each node
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{ParseEdges}},
#' \code{\link{ParseNodeSize}}, \code{\link{ParseArcs}},
#' \code{\link{QueryStarPlot}}, \code{\link{ParseSD}}
#'
ParseQuery <- function(fsom, query){
scores <- matrix(NA, ncol = length(query), nrow = nrow(fsom$map$medianValues),
dimnames = list(NULL, names(query)))
for (marker in names(query)) {
data <- fsom$map$medianValues[, marker]
highOrLow <- pmatch(query[marker], c("high", "low"))
if (any(is.na(highOrLow)) | length(highOrLow) > 1){
stop("Only high or low marker expressions are supported at the moment")
} else {
highOrLow <- c("high", "low")[highOrLow]
if (highOrLow == "high") {
scores[, marker] = (max(data, na.rm = TRUE) - data) ^ 2
} else if (highOrLow == "low") {
scores[, marker] = (data - min(data, na.rm = TRUE)) ^ 2
}
}
}
scores <- apply(scores, 2, function(x) {
1 - ((x - min(x, na.rm = TRUE))/ (max(x, na.rm = TRUE) -
min(x, na.rm = TRUE)))
})
nodeScores <- apply(scores, 1, mean)
nodeScores[is.na(nodeScores)] <- 0
cutoff <- max(nodeScores) * 0.95
scoresCutoff <- nodeScores > cutoff
return(list(selected = which(scoresCutoff), nodeScores = nodeScores,
fullScores = scores))
}
#' ParseSD
#'
#' Parses SD in FlowSOM object
#'
#' Calculates the standard deviation of a FlowSOM object
#'
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}}
#' @param marker If a marker is given, the standard deviation for this marker
#' is shown. Otherwise, the maximum ratio is used.
#'
#' @return A vector containing the SDs
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{ParseEdges}},
#' \code{\link{ParseNodeSize}}, \code{\link{ParseArcs}},
#' \code{\link{ParseQuery}}, \code{\link{PlotSD}}
#'
#' @importFrom stats median
#'
ParseSD <-function (fsom, marker = NULL){
stdevs <- fsom$map$sdValues[, fsom$map$colsUsed]
stdev_medians <- apply(stdevs, 2, stats::median)
if (is.null(marker)) {
variable <- apply(stdevs, 1, function(x) {
max(x/stdev_medians)
})
} else {
variable <- stdevs[, marker]/stdev_medians[marker]
}
return(variable)
}
#' ScaleStarHeights
#'
#' Scales starheights
#'
#' Function that scales the star values between 0 and the node size
#'
#' @param data Median values of relevant markers extracted from
#' FlowSOM object
#' @param nodeSizes A vector that is returned from \code{ParseNodeSize}
#'
#' @return A dataframe consisting of the scaled values of the stars.
#' The stars are scaled between 0 and the maximum of all stars
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{ParseNodeSize}},
#' \code{\link{AutoMaxNodeSize}}
#'
ScaleStarHeights <- function(data, nodeSizes){
nNodes <- length(nodeSizes)
maxAllNodes <- max(data)
minAllNodes <- min(data)
for (i in 1:(nNodes)){
maxRowNodeSize <- nodeSizes[i]
scaledRow <- ((data[i, ] - minAllNodes) * maxRowNodeSize) /
(maxAllNodes - minAllNodes)
data[i, ] <- scaledRow
}
return(data)
}
#' AutoMaxNodeSize
#'
#' Calculate node size
#'
#' Function that calculates the minimum distance between the nodes
#' to use this to adapt the maxNodeSize for better plotting
#'
#' @param layout Coordinates of nodes
#' @param overlap Parameter that determines how much overlap there
#' will be. If negative the nodes will be smaller
#'
#' @return Returns the maxNodeSize with some overlap
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{ScaleStarHeights}},
#' \code{\link{ParseNodeSize}}
#'
#' @importFrom stats dist
#'
AutoMaxNodeSize <- function(layout, overlap){
overlap <- 1 + overlap
minDistance <- min(stats::dist(layout[, c(1, 2)]))
return(minDistance / 2 * overlap)
}
#' AddMST
#'
#' Function plots the MST
#'
#' @param p ggplot object
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}}
#'
#' @return Returns nothing, but plots the MST for FlowSOM MST view
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{ParseEdges}},
#' \code{\link{AddStarsPies}}, \code{\link{AddLabels}}, \code{\link{AddNodes}},
#' \code{\link{AddBackground}}, \code{\link{AddPies}}, \code{\link{AddStars}}
#'
#' @import ggplot2
#'
#' @export
AddMST <- function(p,
fsom){
requireNamespace("ggplot2")
fsom <- UpdateFlowSOM(fsom)
edges <- ParseEdges(fsom)
p <- p + ggplot2::geom_segment(data = edges,
ggplot2::aes(x = .data$x,
y = .data$y,
xend = .data$xend,
yend = .data$yend),
linewidth = 0.2)
return(p)
}
#' AddStarsPies
#'
#' Function plots stars or pies
#'
#' @param p ggplot object
#' @param arcs Dataframe that contains all the data for the plotting
#' the pies or stars
#' @param colorPalette A vector of colors or a color function
#' @param showLegend Boolean on whether to show the legend
#'
#' @return Returns nothing, but plots the stars or pies
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{AddLabels}},
#' \code{\link{AddNodes}}, \code{\link{AddBackground}}, \code{\link{AddPies}},
#' \code{\link{AddStars}}, \code{\link{ParseArcs}}, \code{\link{PlotStars}}
#' \code{\link{PlotPies}}
#'
#' @import ggplot2
#' @importFrom ggforce geom_arc_bar
#'
#' @export
AddStarsPies <- function(p, arcs, colorPalette, showLegend = TRUE){
requireNamespace("ggplot2")
p <- AddScale(p = p,
values = arcs$Markers,
colors = colorPalette,
showLegend = showLegend)
p <- p + ggforce::geom_arc_bar(data = arcs,
ggplot2::aes(x0 = .data$x0,
y0 = .data$y0,
r0 = 0,
r = .data$value,
start = .data$start,
end = .data$end,
fill = .data$Markers),
linewidth = 0.2)
return(p)
}
#' AddLabels
#'
#' @param p ggplot object
#' @param labels Labels to be added to each node
#' @param hjust Horizontal adjust for labels. Default is centered.
#' @param layout Dataframe with x and y columns. If null, the dataframe from
#' the ggplot object will be reused.
#' @param textSize Size for geom_text. Default (=3.88) is from geom_text.
#' @param textColor Color for geom_text. Default = black.
#' @param ... Additional parameters to pass to geom_text
#'
#' @return Returns the ggplot object with labels added
#'
#' @seealso \code{\link{PlotLabels}}, \code{\link{PlotNumbers}}
#'
#' @import ggplot2
#'
#' @export
AddLabels <- function(p, labels, hjust = 0.5, layout = NULL,
textSize = 3.88, textColor = "black", ...){
requireNamespace("ggplot2")
if(is.null(layout)) layout <- ggplot2::ggplot_build(p)$plot$data
p <- p + ggplot2::geom_text(data = layout,
ggplot2::aes(x = .data$x,
y = .data$y,
label = labels),
fontface = "bold",
hjust = hjust,
size = textSize,
col = textColor,
...)
return(p)
}
#' AddNodes
#'
#' Function plots the nodes
#'
#' @param p ggplot object
#' @param nodeInfo Dataframe with for every node an x, y and size value,
#' if null the dataframe from the ggplot object will be
#' reused.
#' @param values Values used for coloring the nodes. Default = NULL,
#' in which case all nodes are filled in fillColor.
#' @param lim The limits of the color scale, not used if values = NULL.
#' @param colorPalette Color palette for color in nodes, not used if values =
#' NULL. A vector of colors or a color function.
#' @param fillColor Fixed fill for node colors, default = white.
#' @param showLegend Boolean, default = TRUE.
#' @param label Title for the legend.
#' @param ... Additional arguments to pass to geom_circle
#'
#' @return Returns nothing, but plots the nodes
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{PlotMarker}},
#' \code{\link{PlotVariable}}, \code{\link{AddLabels}},
#' \code{\link{AddBackground}}, \code{\link{AddPies}},
#' \code{\link{AddStars}}, \code{\link{AddStarsPies}}
#'
#' @import ggplot2
#' @importFrom ggplot2 ggplot_build
#' @importFrom ggforce geom_circle
#' @importFrom grDevices colorRampPalette
#'
#' @export
AddNodes <- function(p,
nodeInfo = NULL,
values = NULL,
lim = NULL,
colorPalette = NULL,
fillColor = "white",
showLegend = TRUE,
label = "",
...){
requireNamespace("ggplot2")
if(is.null(nodeInfo)) nodeInfo <- ggplot2::ggplot_build(p)$plot$data
if (is.null(values)){
p <- p + ggforce::geom_circle(data = nodeInfo,
ggplot2::aes(x0 = .data$x,
y0 = .data$y,
r = .data$size),
fill = fillColor,
linewidth = 0.2,
...)
} else {
if(is.character(values) | is.logical(values)) values <- factor(values)
p <- AddScale(p,
values = values,
colors = colorPalette,
limits = lim,
labelLegend = label,
showLegend = showLegend)
p <- p + ggforce::geom_circle(ggplot2::aes(x0 = .data$x,
y0 = .data$y,
r = .data$size,
fill = values),
linewidth = 0.2,
...)
}
return(p)
}
#' AddBackground
#'
#' Function plots the background
#'
#' @param p ggplot object
#' @param backgroundValues Vector of values to be plotted as background for
#' the nodes
#' @param backgroundColors Color palette to be used for the background coloring.
#' Can be either a function or an array specifying
#' colors.
#' @param backgroundLim Background limits (can be used to ensure consistent
#' Color palette between plots). If NULL (default), will
#' be automatically adapted to the data.
#'
#'
#' @return Returns nothing, but plots the background
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{AddLabels}},
#' \code{\link{AddNodes}}, \code{\link{AddPies}}, \code{\link{AddStars}}
#'
#' @import ggplot2
#' @importFrom ggforce geom_circle
#' @importFrom ggnewscale new_scale
#' @importFrom grDevices colorRampPalette
#'
#' @export
AddBackground <- function(p,
backgroundValues,
backgroundColors = NULL,
backgroundLim = NULL){
requireNamespace("ggplot2")
if(is.character(backgroundValues)) {
backgroundValues <- factor(backgroundValues)
}
p <- AddScale(p,
backgroundValues,
backgroundColors,
backgroundLim,
labelLegend = "background")
p <- p + ggforce::geom_circle(ggplot2::aes(x0 = .data$x,
y0 = .data$y,
r = .data$bg_size,
fill = backgroundValues),
col = NA,
alpha = 0.4)
return(p)
}
#' AddScale
#'
#' @param p ggplot object
#' @param values Values used for the fill
#' @param colors Colors to use (can be a vector or a function)
#' @param limits Limits to use in the scale
#' @param showLegend Boolean on whether to show the legend
#' @param labelLegend Label to show as title of the legend
#' @param type fill (default) or color
#'
#' @return ggplot object with scale added
AddScale <- function(p,
values = NULL,
colors = NULL,
limits = NULL,
showLegend = TRUE,
labelLegend = "",
type = "fill"){
p <- p + ggnewscale::new_scale(type)
if(is.character(values) | is.logical(values)) values <- factor(values)
if (!is.null(limits) && is.null(colors)){
args <- list()
args[[type]] <- limits
p <- p + do.call(ggplot2::lims, args)
}
if(!is.null(colors)){
# Discrete values
if (is.factor(values)){
# If a function: make into the right amount of values
if(is.function(colors)){
colors <- colors(nlevels(values))
}
# Check color names vs backgroundValues
colorNames <- names(colors)
levels <- levels(values)
# If no names available, use levels
if(is.null(colorNames)){
colorNames <- levels[seq_along(colors)]
}
# If any names missing, show warning
notAvailable <- ! levels %in% colorNames
if(any(notAvailable)){
warning("You did not provide a color for ",
paste(levels[notAvailable], collapse =", "))
colors <- c(colors,
rep("#FFFFFF", sum(notAvailable)))
names(colors) <- c(colorNames,
levels[notAvailable])
}
scale_function <- eval(parse(text = paste0("ggplot2::scale_",
type,
"_manual")))
if(showLegend) {
p <- p + scale_function(values = colors)
} else {
p <- p + scale_function(values = colors,
guide = "none")
}
} else if (is.numeric(values)){ # Continuous values
if (is.function(colors)){
colors <- colors(100)
} else {
colors <- grDevices::colorRampPalette(colors)(100)
}
scale_function <- eval(parse(text = paste0("ggplot2::scale_",
type,
"_gradientn")))
if(showLegend) {
p <- p + scale_function(colors = colors,
limits = limits)
} else {
p <- p + scale_function(colors = colors,
limits = limits,
guide = "none")
}
}
}
p <- p + ggplot2::labs(fill = labelLegend)
return(p)
}
#' AddPies
#'
#' Function plots the pies
#'
#' @param p ggplot object
#' @param fsom FlowSOM object, as generated by \code{\link{BuildMST}}
#' @param cellLabels Array of factors indicating the cell labels
#' @param layout Coordinates of nodes. Uses dataframe of the ggplot
#' object if NULL.
#' @param colorPalette Color palette to be used for colors. Can be either a
#' function or an array specifying colors.
#'
#' @return ggplot object with the pies added
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{AddLabels}},
#' \code{\link{AddNodes}}, \code{\link{AddBackground}}, \code{\link{PlotPies}},
#' \code{\link{AddStars}}, \code{\link{ParseArcs}}
#'
#' @importFrom grDevices colorRampPalette
#' @importFrom dplyr filter
#'
#' @export
AddPies <- function(p,
fsom,
cellLabels,
layout = NULL,
colorPalette = NULL){
fsom <- UpdateFlowSOM(fsom)
if (is.null(layout)) layout <- ggplot2::ggplot_build(p)$plot$data
if (!is.factor(cellLabels)) cellLabels <- as.factor(cellLabels)
nNodes <- NClusters(fsom)
count <- table(factor(GetClusters(fsom), levels = seq_len(nNodes)),
factor(cellLabels, levels = c(levels(cellLabels), "Empty")))
count[rowSums(count) == 0, "Empty"] <- 1
pieValues <- lapply(seq_len(nNodes), function(cl){
nodeData <- ParseArcs(layout[cl, "x"],
layout[cl, "y"],
count[cl, ],
layout[cl, "size"])
return(nodeData)
})
pieValues <- do.call(rbind, pieValues)
pieValues$Markers <- factor(pieValues$Markers,
levels = c(levels(cellLabels), "Empty"))
p <- AddStarsPies(p, pieValues, colorPalette)
return(p)
}
#' AddStars
#'
#' Function plots the stars
#'
#' @param p ggplot object
#' @param fsom FlowSOM object, as generated by \code{\link{BuildMST}}
#' @param markers Determines which markers to plot.
#' Default = "fsom$map$colsUsed"
#' @param colorPalette Color palette to be used for colors. Can be either a
#' function or an array specifying colors.
#'
#' @return ggplot object with the stars added
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{AddLabels}},
#' \code{\link{AddNodes}}, \code{\link{AddBackground}}, \code{\link{PlotStars}},
#' \code{\link{AddPies}}, \code{\link{ParseArcs}}
#'
#' @importFrom grDevices colorRampPalette
#'
#' @export
AddStars <- function(p,
fsom,
markers = fsom$map$colsUsed,
colorPalette = NULL){
requireNamespace("ggplot2")
markers <- GetChannels(fsom, markers)
fsom <- UpdateFlowSOM(fsom)
nNodes <- NClusters(fsom)
nMarkers <- length(markers)
isEmpty <- which(fsom$map$pctgs == 0)
nodeInfo <- ggplot2::ggplot_build(p)$plot$data
nodeInfo$size[isEmpty] <- 0
data <- fsom$map$medianValues[, markers, drop = FALSE]
data[is.na(data)] <- 0
data <- ScaleStarHeights(data,
nodeInfo$size)
markers_tmp <- rep(1, ncol(data))
names(markers_tmp) <- colnames(data)
starValues <- lapply(seq_len(nNodes), function(cl){
nodeData <- ParseArcs(x = nodeInfo$x[cl],
y = nodeInfo$y[cl],
arcValues = markers_tmp,
arcHeights = data[cl, ])
return(nodeData)
})
starValues <- do.call(rbind, starValues)
starValues$Markers <- factor(starValues$Markers,
levels = colnames(data))
p <- AddStarsPies(p, starValues, colorPalette, showLegend = FALSE)
return(p)
}
#' gg_color_hue
#'
#' Helper function to get the ggplot colors
#' @param n Number of colors
#'
#' @return array with hexadecimal color values
#'
#' @importFrom grDevices hcl
gg_color_hue <- function(n) {
hues = seq(15, 375, length = n + 1)
hcl(h = hues, l = 65, c = 100)[1:n]
}
#' FlowSOMmary
#'
#' This functions plots a summary of a flowSOM object. It includes a table of
#' (meta)cluster data, the flowSOM trees and grid view, the (meta)cluster
#' labels, the markers expression, the file distribution if present,
#' the cluster per metacluster percentage, a t-SNE plot,
#' and the MFI per metacluster.
#'
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}}
#' @param plotFile Name of the pdf file that will be generated (default is
#' FlowSOMmary.pdf). If \code{NULL}, a list of ggplots will
#' be returned.
#'
#' @return Returns a summary of the FlowSOM object
#'
#'
#' @examples
#' # Identify the files
#' fcs <- flowCore::read.FCS(system.file("extdata", "68983.fcs",
#' package = "FlowSOM"))
#'
#' # Build a FlowSOM object
#' flowSOM.res <- FlowSOM(fcs,
#' scale = TRUE,
#' compensate = TRUE,
#' transform = TRUE,
#' toTransform = 8:18,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' FlowSOMmary(flowSOM.res)
#'
#' @import ggplot2
#' @importFrom ggpubr ggarrange ttheme ggtexttable
#' @importFrom dplyr count mutate group_by filter pull arrange
#' @importFrom grDevices pdf
#'
#' @export
FlowSOMmary <- function(fsom, plotFile = "FlowSOMmary.pdf"){
#----Initializing ----
fsom <- UpdateFlowSOM(fsom)
metaclustersPresent <- !is.null(fsom$metaclustering)
if (metaclustersPresent){
mfis <- GetMetaclusterMFIs(fsom, colsUsed = TRUE)
metaclusters <- GetMetaclusters(fsom)
nMetaclusters <- NMetaclusters(fsom)
}
clusters <- GetClusters(fsom)
nNodes <- seq_len(NClusters(fsom))
filePresent <- "File" %in% colnames(fsom$data)
plotList <- list()
#----Plot fsom trees and grids----
message("Plot FlowSOM trees")
for(view in c("MST", "grid")){
plotList[[paste0("stars_", view)]] <-
PlotStars(fsom, view = view, backgroundValues = fsom$metaclustering,
title = paste0("FlowSOM ", view))
if (metaclustersPresent){
p2.1 <- PlotFlowSOM(fsom, view = view, title = "FlowSOM Clusters",
equalNodeSize = TRUE) %>%
AddNodes(values = fsom$metaclustering,
showLegend = TRUE,
label = "Metaclusters") %>%
AddLabels(labels = seq_len(NClusters(fsom)))
p2.2 <- PlotFlowSOM(fsom, view = view, equalNodeSize = TRUE,
title = "FlowSOM Metaclusters") %>%
AddNodes(values = fsom$metaclustering, showLegend = TRUE,
label = "Metaclusters") %>%
AddLabels(labels = as.numeric(fsom$metaclustering))
} else {
p2.1 <- PlotNumbers(fsom, view = view, title = "FlowSOM Clusters",
maxNodeSize = "auto", equalNodeSize = TRUE)
p2.2 <- NULL
}
plotList[[paste0("labels_",view)]] <-
ggpubr::ggarrange(p2.1, p2.2,
common.legend = TRUE, legend = "right")
}
#----Plot Markers----
plotList[["p5"]] <- PlotMarker(fsom, marker = fsom$map$colsUsed,
refMarkers = fsom$map$colsUsed,
equalNodeSize = TRUE)
#----File distribution----
if (filePresent){
message("Plot file distribution")
file_cols <- fsom$data[,rev(grep("File[0-9]*$", colnames(fsom$data),
value = TRUE)), drop = FALSE]
if(file_cols[1,1] != round(file_cols[1,1])){ # In case of scaled data
file_cols <- apply(file_cols, 2, function(x) as.numeric(factor(x)))
}
file_label <- apply(file_cols, 1, paste, collapse = " ")
p6 <- PlotPies(fsom, cellTypes = factor(file_label),
equalNodeSize = TRUE, view = "grid",
title = "File distribution per cluster",
colorPalette = FlowSOM_colors)
filesI <- as.character(unique(fsom$data[, "File"]))
expectedDistr <- c(table(file_label))
names(expectedDistr) <- filesI
arcsDf <- ParseArcs(0, 0, expectedDistr, 0.7)
arcsDf$Markers <- factor(arcsDf$Markers, levels = filesI)
plotList[["p6"]] <- AddStarsPies(p6, arcsDf, colorPalette = FlowSOM_colors(
length(filesI) + 1), showLegend = FALSE) +
ggplot2::geom_text(ggplot2::aes(x = 0, y = -1,
label = "Expected distribution"))
}
#----t-SNE----
message("Calculate t-SNE")
dimred_res <- PlotDimRed(fsom, cTotal = 5000, colorBy = fsom$map$colsUsed,
seed = 1, returnLayout = TRUE,
title = paste0("t-SNE with markers used in FlowSOM ",
"call (perplexity = 30, cells = 5000)"),
check_duplicates = FALSE)
if (metaclustersPresent){
plotList[["p7"]] <- PlotDimRed(fsom, dimred = dimred_res$layout, seed = 1,
title = paste0("t-SNE with markers used in FlowSOM ",
"call (perplexity = 30, cells = 5000)"))
}
plotList[["p8"]] <- dimred_res$plot
#----Cluster Per Metacluster----
if (metaclustersPresent){
message("Plot cluster per metacluster distribution")
clusterPerMetacluster <- data.frame(metaclusters, clusters) %>%
dplyr::group_by(metaclusters) %>%
dplyr::count(clusters) %>%
dplyr::mutate(Percentage = .data$n / sum(.data$n) * 100) %>%
dplyr::mutate(LabelPos = cumsum(.data$Percentage) - 1) %>%
as.data.frame()
clusterPerMetacluster$clusters <- factor(clusterPerMetacluster$cluster)
plotList[["p9"]] <- ggplot2::ggplot(clusterPerMetacluster,
ggplot2::aes(x = metaclusters)) +
ggplot2::geom_bar(ggplot2::aes(y = .data$Percentage, fill = metaclusters),
stat = "identity", col = "black") +
ggplot2::geom_text(ggplot2::aes(y = .data$LabelPos, label = clusters)) +
ggplot2::theme_minimal() +
ggplot2::theme(panel.grid.major.x = ggplot2::element_blank(),
panel.grid.minor.x = ggplot2::element_blank(),
legend.position = "none") +
ggplot2::ggtitle("Percentages clusters per metacluster")
#----Median expression per metacluster----
message("Plot heatmap")
colnames(mfis) <- fsom$prettyColnames[colnames(mfis)]
rownames(mfis) <- levels(metaclusters)
mfis_scaled <- scale(mfis)
mfis_scaled[is.na(mfis_scaled)] <- 0
plotList[["empty"]] <- ggplot2::ggplot() + ggplot2::theme_minimal()
if (requireNamespace("pheatmap", quietly = TRUE)) {
plotList[["p10"]] <-
pheatmap::pheatmap(mfis_scaled, scale = "none",
display_numbers = round(mfis, 2),
main = "Median expression per metacluster",
silent = TRUE)
} else {
message("Please install \"pheatmap\" to add a heatmap to the FlowSOMmary")
}
}
#----Table----
message("Make tables")
datatable1 <- data.frame("Total number of cells" = nrow(fsom$data),
check.names = FALSE)
rownames(datatable1) <- "FlowSOMmary"
if (metaclustersPresent) {
datatable1[, "Total number of metaclusters"] <- nMetaclusters
}
markersInFlowSOM <- split(fsom$prettyColnames[fsom$map$colsUsed],
rep(seq_len(ceiling(length(fsom$prettyColnames[
fsom$map$colsUsed])/5)),
each = 5)[seq_len(length(fsom$prettyColnames[
fsom$map$colsUsed]))]) %>%
sapply(paste, collapse =", ") %>%
paste(collapse = ",\n")
datatable1 <- cbind(datatable1,
"Total number of clusters" = fsom$map$nNodes,
"Markers used for FlowSOM" = markersInFlowSOM)
datatable1 <- format(datatable1, digits = 2)
t1 <- ggpubr::ggtexttable(t(datatable1), theme = ggpubr::ttheme("minimal"))
if (metaclustersPresent){
freqMetaclusters <- data.frame(metaclusters =
as.character(metaclusters)) %>%
dplyr::count(.data$metaclusters) %>%
dplyr::mutate(percentage = .data$n / sum(.data$n) * 100) %>%
as.data.frame()
datatable2 <- data.frame("Metacluster" = levels(metaclusters),
"Number of cells" = 0,
"Percentage of cells" = 0,
"Number of clusters" = 0,
"Clusters" = "",
check.names = FALSE)
rownames(datatable2) <- datatable2$Metacluster
datatable2[freqMetaclusters[,"metaclusters"], "Number of cells"] <-
freqMetaclusters[,"n"]
datatable2[freqMetaclusters[,"metaclusters"], "Percentage of cells"] <-
freqMetaclusters[,"percentage"]
datatable2[, "Number of clusters"] <-
sapply(levels(metaclusters), function(x){
which(fsom$metaclustering == x) %>% length()})
datatable2[, "Clusters"] <-
sapply(levels(metaclusters), function(x){
cl_selected <- which(fsom$metaclustering == x)
clusters_string <- split(cl_selected,
rep(seq_len(ceiling(length(cl_selected)/25)),
each = 25)[seq_len(length(cl_selected))]) %>%
sapply(paste, collapse =", ") %>%
paste(collapse = ",\n")
return(clusters_string)
})
datatable2 <- format(datatable2, digits = 2)
split_datatable2 <- split(datatable2, rep(seq_len(
ceiling(nrow(datatable2) / 30)), each = 30,
length.out=nrow(datatable2)))
}
freqClusters <- as.data.frame(clusters) %>%
dplyr::count(.data$clusters) %>%
dplyr::mutate(freq = .data$n / sum(.data$n) * 100) %>%
as.data.frame()
datatable3 <- data.frame("Cluster" = factor(nNodes),
"Number of cells" = 0,
"Percentage of cells" = 0,
check.names = FALSE)
datatable3[freqClusters[, "clusters"], "Number of cells"] <-
freqClusters[, "n"]
datatable3[freqClusters[, "clusters"], "Percentage of cells"] <-
freqClusters[, "freq"]
if (metaclustersPresent){
datatable3 <- cbind(datatable3,
"Belongs to metacluster" = fsom$metaclustering,
"Percentage in metacluster" = 0)
datatable3[as.numeric(as.character(clusterPerMetacluster[,"clusters"])),
"Percentage in metacluster"] <-
clusterPerMetacluster[, "Percentage"]
}
datatable3 <- format(datatable3, digits = 2)
split_datatable3 <- split(datatable3, rep(seq_len(
ceiling(nrow(datatable3) / 30)), each = 30,
length.out = nrow(datatable3)))
#----Printing----
message("Printing")
if (!is.null(plotFile)){
grDevices::pdf(plotFile, width = 17, height = 10)
print(t1)
if (metaclustersPresent){
for (table2 in split_datatable2) {
print(ggpubr::ggtexttable(table2, theme = ggpubr::ttheme("minimal"),
rows = NULL))
}
}
for (table3 in split_datatable3){
print(ggpubr::ggtexttable(table3, theme = ggpubr::ttheme("minimal"),
rows = NULL))
}
for (plot in plotList){
print(plot)
}
dev.off()
} else {
return(plotList)
}
}
#' AddAnnotation
#'
#' Add annotation to a FlowSOM plot
#'
#' @param p Plot to add annotation to. When using \code{\link{PlotStars}},
#' please use list_insteadof_ggarrange = TRUE.
#' @param fsom FlowSOM object that goes with the plot.
#' @param toAnnotate A named list with "metaclusters" and/or "clusters" as names
#' and a vector with the (meta)clusters that need to be
#' annotated. Names can be abbreviated. Use a named vector with
#' the old names as values and new labels as names for custom
#' labeling.
#' @param prefix Prefix to be added to labels. Default is "MCL " and "CL " for
#' metaclusters and clusters respectively.
#' @param ... Arguments passed to geom_text_repel.
#'
#' @return The updated plot
#'
#' @examples
#'
#' # Identify the files
#' fcs <- flowCore::read.FCS(system.file("extdata", "68983.fcs",
#' package = "FlowSOM"))
#' # Build a FlowSOM object
#' flowSOM.res <- FlowSOM(fcs,
#' scale = TRUE,
#' compensate = TRUE,
#' transform = TRUE,
#' toTransform = 8:18,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' p <- PlotStars(flowSOM.res, backgroundValues = flowSOM.res$metaclustering,
#' list_insteadof_ggarrange = TRUE)
#' annotationList <- list("metaclusters" = c("CD8 T cells" = "1", "B cells" = "8"),
#' "clusters" = c(97))
#' AddAnnotation(p, flowSOM.res, toAnnotate = annotationList,
#' prefix = list("metaclusters" = "", clusters = "CL "))
#'
#' @import ggplot2
#' @importFrom dplyr group_by filter slice
#' @importFrom ggpubr ggarrange
#'
#' @export
AddAnnotation <- function(p,
fsom,
toAnnotate = NULL,
prefix = list("metaclusters" = "MCL ", "clusters" = "CL "),
...){
# Initialize
if (is.null(toAnnotate)) stop("Please add a named list to \"toAnnotate\"")
if (is(p, "ggarrange")){
stop(paste0("Please set \"list_insteadof_ggarrange = TRUE\" when using this",
" function in combination with PlotStars"))
}
listOrGGplot <- "tree" %in% names(p)
if (listOrGGplot) {
l1 <- p[["starLegend"]]
l2 <- p [["backgroundLegend"]]
p <- p[["tree"]]
}
abb_toAnnotate <- abb_prefix <- NULL
fsom <- UpdateFlowSOM(fsom)
for (toAnnotate_prefix in c("toAnnotate", "prefix")){
toCheck <- get(toAnnotate_prefix)
abbreviations <- pmatch(names(toCheck), c("clusters", "metaclusters"))
assign(paste0("abb_", toAnnotate_prefix), abbreviations)
if (any(is.na(abbreviations))){
stop(paste0("Please use \"clusters\" and/or \"metaclusters\" or abbrevations",
" as names of the \"", toAnnotate_prefix,"\" list"))
}
}
names(toAnnotate) <- c("clusters", "metaclusters")[abb_toAnnotate]
names(prefix) <- c("clusters", "metaclusters")[abb_prefix]
oldClNames <- toAnnotate$clusters
if (any(!oldClNames %in% seq(NClusters(fsom)))){
stop("Cluster name is not present in the fsom object")
}
oldMclNames <- toAnnotate$metaclusters
layout <- as.data.frame(ggplot2::ggplot_build(p)$plot$data)[, seq(2)]
colnames(layout) <- c("V1", "V2")
clusterLabels <- data.frame(layout,
cl = as.character(seq_len(fsom$map$nNodes)),
metacl = as.character(fsom$metaclustering))
labels <- list()
if (!is.null(oldMclNames)){
metaclusterLabels <- clusterLabels %>%
dplyr::group_by(.data$metacl) %>%
dplyr::slice(1) %>%
as.data.frame() %>%
mutate(label = .data$metacl)
newMCLNames <- names(oldMclNames)
oldMclNames <- match(oldMclNames, metaclusterLabels$metacl)
if (any(is.na(oldMclNames))){
stop("Old metacluster name is not present in the fsom object")
}
if (!is.null(newMCLNames)){
names(oldMclNames) <- newMCLNames
metaclusterLabels$label[oldMclNames] <- newMCLNames
}
metaclusterLabels$label <- paste0(prefix$metaclusters, metaclusterLabels$label)
labels[["metaclusters"]] <- metaclusterLabels[oldMclNames, ]
}
if (!is.null(oldClNames)){
clusterLabels <- clusterLabels %>% mutate(label = .data$cl)
newCLNames <- names(oldClNames)
if (!is.null(newCLNames)){
clusterLabels$label[as.numeric(oldClNames)] <- newCLNames
}
clusterLabels$label <- paste0(prefix$clusters, clusterLabels$label)
labels[["clusters"]] <- clusterLabels[oldClNames, ]
}
labels <- do.call(rbind, labels) %>% as.data.frame()
emptyString <- clusterLabels %>% mutate(label = "")
labels <- rbind(labels, emptyString)
if (requireNamespace("ggrepel", quietly = TRUE)) {
p <- p + ggrepel::geom_text_repel(data = labels,
ggplot2::aes(x = .data$V1, y = .data$V2,
label = .data$label),
segment.color = "gray", force = 20,
segment.size = 0.2, point.padding = 0.5, size = 5,
...)
} else {
p <- p + ggplot2::geom_text(data = labels,
ggplot2::aes(x = .data$V1, y = .data$V2,
label = .data$label), nudge_y = 0.5,
nudge_x = 0.5, ...)
message("Please install \"ggrepel\" for more clear annotation.")
}
if (listOrGGplot){
p <- ggpubr::ggarrange(p, ggpubr::ggarrange(l1, l2, ncol = 1), NULL,
ncol = 3, widths = c(3, 1, 0.3), legend = "none")
}
return(p)
}
#' PlotOutliers
#'
#' Visual overview of outliers
#'
#' @param fsom FlowSOM object.
#' @param outlierReport Outlier overview as generated by TestOutliers()
#'
#' @return Plot
#'
#' @examples
#'
#' # Identify the files
#' fcs <- flowCore::read.FCS(system.file("extdata", "68983.fcs",
#' package = "FlowSOM"))
#' # Build a FlowSOM object
#' flowSOM.res <- FlowSOM(fcs,
#' scale = TRUE,
#' compensate = TRUE,
#' transform = TRUE,
#' toTransform = 8:18,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#' outlierReport <- TestOutliers(flowSOM.res)
#' p <- PlotOutliers(flowSOM.res, outlierReport)
#'
#' @import ggplot2
#' @importFrom ggpubr ggarrange
#'
#' @export
PlotOutliers <- function(fsom, outlierReport){
xdim <- fsom$map$xdim
ydim <- fsom$map$ydim
plotList <- lapply(seq_len(xdim * ydim), function(i) {
ids <- which(GetClusters(fsom) == i)
values <- fsom$map$mapping[ids, 2]
if (length(values) > 1) {
nOutliers <- sum(values > outlierReport$Threshold[i])
p <- suppressMessages(ggplot2::ggplot() +
ggplot2::geom_histogram(ggplot2::aes(values),
fill = "grey90",
col = "black",
size = 0.2) +
ggplot2::geom_vline(ggplot2::aes(xintercept = outlierReport$Median_distance[i]),
col = "black") +
ggplot2::geom_vline(ggplot2::aes(xintercept = outlierReport$Threshold[i]),
col = "red") +
ggplot2::ggtitle(paste0(i,
" (", nOutliers, ")")) +
ggplot2::theme_minimal() +
ggplot2::theme(axis.title.x = ggplot2::element_blank()) +
ggplot2::ylab("Frequency"))
return(p)
}
})
p <- suppressMessages(ggpubr::ggarrange(plotlist = plotList))
return(p)
}
SofieVG/FlowSOM documentation built on Feb. 1, 2024, 11:33 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions PlotOutliers AddAnnotation FlowSOMmary gg_color_hue AddStars AddPies AddScale AddBackground AddNodes AddLabels AddStarsPies AddMST AutoMaxNodeSize ScaleStarHeights ParseQuery ParseArcs ParseNodeSize ParseLayout ParseEdges PlotStarLegend PlotSD QueryMultiple QueryStarPlot Plot2DScatters PlotManualBars PlotDimRed PlotVariable PlotMarker PlotNumbers PlotLabels PlotPies PlotStars FlowSOM_colors PlotFlowSOM
Documented in AddAnnotation AddBackground AddLabels AddMST AddNodes AddPies AddScale AddStars AddStarsPies AutoMaxNodeSize FlowSOM_colors FlowSOMmary gg_color_hue ParseArcs ParseEdges ParseLayout ParseNodeSize ParseQuery Plot2DScatters PlotDimRed PlotFlowSOM PlotLabels PlotManualBars PlotMarker PlotNumbers PlotOutliers PlotPies PlotSD PlotStarLegend PlotStars PlotVariable QueryMultiple QueryStarPlot ScaleStarHeights
#' PlotFlowSOM
#'
#' Base layer to plot a FlowSOM result
#'
#' Base layer of the FlowSOM plot, where you can choose layout (MST, grid or
#' coordinates of your own choosing), background colors and node size. Can
#' then be extended by e.g. \code{\link{AddStars}}, \code{\link{AddLabels}},
#' \code{\link{AddPies}}, ...
#'
#' @param fsom FlowSOM object, as created by \code{\link{FlowSOM}}
#' @param view Preferred view, options: "MST", "grid" or "matrix"
#' with a matrix/dataframe consisting of coordinates.
#' Default = "MST"
#' @param nodeSizes A vector containing node sizes. These will
#' automatically be scaled between 0 and maxNodeSize
#' and transformed with a sqrt. Default = fsom$MST$sizes
#' @param maxNodeSize Determines the maximum node size. Default is 1.
#' @param refNodeSize Reference for node size against which the nodeSizes
#' will be scaled. Default = max(nodeSizes)
#' @param equalNodeSize If \code{TRUE}, the nodes will be equal to
#' maxNodeSize. If \code{FALSE} (default), the nodes
#' will be scaled to the number of cells in each
#' cluster
#' @param backgroundValues Values to be used for background coloring, either
#' numerical values or something that can be made into
#' a factor (e.g. a clustering)
#' @param backgroundColors Color palette to be used for the background coloring.
#' Can be either a function or an array specifying
#' colors.
#' @param backgroundSize The size of the background. Will be multiplied by the
#' size of the nodes.
#' @param equalBackgroundSize If you want the background sizes to be the same size.
#' @param backgroundLim Only used when backgroundValues are numerical.
#' Defaults to min and max of the backgroundValues.
#' @param title Title of the plot
#'
#' @return A ggplot object with the base layer of a FlowSOM plot
#'
#' @seealso \code{\link{PlotStars}}, \code{\link{PlotVariable}},
#' \code{\link{PlotMarker}}, \code{\link{PlotLabels}},
#' \code{\link{PlotNumbers}}, \code{\link{PlotPies}},
#' \code{\link{QueryStarPlot}}, \code{\link{PlotSD}}
#'
#' @examples
#' # Locate file on file system
#' fcs_file <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#'
#' # Build FlowSOM model
#' flowSOM.res <- FlowSOM(fcs_file,
#' scale = TRUE,
#' compensate = TRUE,
#' transform = TRUE,
#' toTransform = 8:18,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' # Plot with background coloring
#' PlotFlowSOM(flowSOM.res,
#' backgroundValues = flowSOM.res$metaclustering) %>%
#' AddLabels(seq(100))
#'
#'
#' @importFrom ggplot2 ggplot coord_fixed theme_void ggtitle
#'
#' @export
PlotFlowSOM <- function(fsom,
view = "MST",
nodeSizes = fsom$map$pctgs,
maxNodeSize = 1,
refNodeSize = max(nodeSizes),
equalNodeSize = FALSE,
backgroundValues = NULL,
backgroundColors = NULL,
backgroundSize = 1.5,
equalBackgroundSize = FALSE,
backgroundLim = NULL,
title = NULL)
{
#----Initialization----
requireNamespace("ggplot2")
fsom <- UpdateFlowSOM(fsom)
nNodes <- NClusters(fsom)
isEmpty <- fsom$map$pctgs == 0
#----Warnings----
if (length(nodeSizes) != nNodes){
stop(paste0("Length of 'nodeSizes' should be equal to number of clusters ",
"in FlowSOM object (", nNodes, " clusters and ",
length(nodeSizes), " node sizes)."))
}
if (length(backgroundValues) != nNodes && !is.null(backgroundValues)){
stop(paste0("Length of 'backgroundValues' should be equal to number of ",
"clusters in FlowSOM object (", nNodes, " clusters and ",
length(backgroundValues), " backgroundValues)."))
}
if (deparse(substitute(backgroundColors)) == "backgroundColor"){
warning(paste0("In the new FlowSOM version \"backgroundColors\"",
" is used instead of \"backgroundColor\""))
}
#---- Layout----
layout <- ParseLayout(fsom, view)
if(is.matrix(view) || is.data.frame(view)) view <- "matrix"
#---- Nodesize----
autoNodeSize <- AutoMaxNodeSize(layout = layout,
overlap = ifelse(view %in% c("grid"),
-0.3, 1))
maxNodeSize <- autoNodeSize * maxNodeSize
if (equalNodeSize){
scaledNodeSize <- rep(maxNodeSize, nNodes)
} else {
scaledNodeSize <- ParseNodeSize(nodeSizes, maxNodeSize, refNodeSize)
}
if (any(isEmpty)) {scaledNodeSize[isEmpty] <- min(maxNodeSize, 0.05)}
#----ggplot----
if (equalBackgroundSize){
backgroundSize <- rep(maxNodeSize, nNodes) * backgroundSize
} else {
backgroundSize <- ParseNodeSize(nodeSizes, maxNodeSize, refNodeSize) * backgroundSize
}
plot_df <- data.frame(x = layout$x,
y = layout$y,
size = scaledNodeSize,
bg_size = backgroundSize)
p <- ggplot2::ggplot(plot_df)
# Add background
if (!is.null(backgroundValues)){
p <- AddBackground(p,
backgroundValues = backgroundValues,
backgroundColors = backgroundColors,
backgroundLim = backgroundLim)
}
# Add MST
if (view == "MST"){
p <- AddMST(p, fsom)
}
# Add nodes
p <- AddNodes(p = p,
values = as.character(isEmpty),
colorPalette = c("TRUE" = "gray", "FALSE" = "white"),
showLegend = FALSE)
# Fix plotlayout
p <- p + ggplot2::coord_fixed() + ggplot2::theme_void()
if (!is.null(title)){
p <- p + ggplot2::ggtitle(title)
}
return(p)
}
#' FlowSOM default colors
#'
#' @param n Number of colors to generate
#'
#' @return array of n colors
#'
#' @importFrom grDevices colorRampPalette
#' @export
FlowSOM_colors <- function(n){
grDevices::colorRampPalette(c("#00007F",
"blue",
"#007FFF",
"cyan",
"#7FFF7F",
"yellow",
"#FF7F00",
"red",
"#7F0000"))(n)
}
#' PlotStars
#'
#' Plot star charts
#'
#' Plot FlowSOM grid or tree, where each node is represented by
#' a star chart indicating median marker values
#'
#' @param fsom FlowSOM object, as generated by \code{\link{BuildMST}}
#' @param markers Markers to plot (will be parsed by GetChannels)
#' @param colorPalette Color palette to use
#' @param list_insteadof_ggarrange If FALSE (default), the plot and the legend
#' are combined by ggarrange. If TRUE, the
#' separate elements are returned in a list,
#' to allow further customization.
#' @param ... Additional arguments to pass to \code{\link{PlotFlowSOM}}
#'
#' @return Nothing is returned. A plot is drawn in which each node is
#' represented by a star chart indicating the median fluorescence intensities.
#' Resets the layout back to 1 plot at the end.
#
#' @seealso \code{\link{PlotMarker}}, \code{\link{PlotVariable}},
#' \code{\link{PlotFlowSOM}}, \code{\link{PlotLabels}},
#' \code{\link{PlotNumbers}}, \code{\link{PlotPies}},
#' \code{\link{QueryStarPlot}}, \code{\link{PlotSD}}
#'
#' @examples
#' # Read from file, build self-organizing map and minimal spanning tree
#' fileName <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#' flowSOM.res <- FlowSOM(fileName, compensate = TRUE, transform = TRUE,
#' scale = TRUE, colsToUse = c(9, 12, 14:18))
#'
#' # Plot stars indicating the MFI of the cells present in the nodes
#' PlotStars(flowSOM.res, backgroundValues = flowSOM.res$metaclustering)
#'
#' newLayout <- igraph::layout_with_fr(flowSOM.res[["MST"]][["graph"]])
#' PlotStars(flowSOM.res, backgroundValues = flowSOM.res$metaclustering,
#' view = newLayout)
#'
#' PlotStars(flowSOM.res, backgroundValues = flowSOM.res$metaclustering,
#' view = "grid")
#'
#' @importFrom ggpubr get_legend ggarrange
#' @importFrom ggforce geom_circle
#'
#' @export
PlotStars <- function(fsom,
markers = fsom$map$colsUsed,
colorPalette = FlowSOM_colors,
list_insteadof_ggarrange = FALSE,
...){
fsom <- UpdateFlowSOM(fsom)
if (length(names(list(...))) > 0 && "backgroundColor" %in% names(list(...))){
warning(paste0("\"backgroundColor\" is deprecated, ",
"please use \"backgroundColors\" instead."))
}
channels <- GetChannels(fsom, markers)
p <- PlotFlowSOM(fsom = fsom,
...)
if(!is.null(names(colorPalette))) {
names(colorPalette) <- GetChannels(fsom, names(colorPalette))
}
p <- AddStars(p = p,
fsom = fsom,
markers = channels,
colorPalette = colorPalette)
if(!is.null(names(colorPalette))) {
names(colorPalette) <- fsom$prettyColnames[GetChannels(fsom,
names(colorPalette))]
}
l1 <- PlotStarLegend(fsom$prettyColnames[channels],
colorPalette)
l2 <- ggpubr::get_legend(p)
if (list_insteadof_ggarrange){
p <- p + ggplot2::theme(legend.position = "none")
l2 <- ggpubr::as_ggplot(l2)
return(list(tree = p,
starLegend = l1,
backgroundLegend = l2))
} else {
p <- ggpubr::ggarrange(p,
ggpubr::ggarrange(l1, l2,
ncol = 1),
NULL,
ncol = 3, widths = c(3, 1, 0.3),
legend = "none")
return(p)
}
}
#' PlotPies
#'
#' Plot comparison with other clustering
#'
#' Plot FlowSOM grid or tree, with pies indicating another clustering
#' or manual gating result
#'
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}}
#' @param cellTypes Array of factors indicating the celltypes
#' @param colorPalette Color palette to use.
#' @param ... Additional arguments to pass to \code{\link{PlotFlowSOM}}
#'
#' @return ggplot plot
#'
#' @seealso \code{\link{PlotStars}}, \code{\link{PlotVariable}},
#' \code{\link{PlotFlowSOM}}, \code{\link{PlotLabels}},
#' \code{\link{PlotNumbers}}, \code{\link{PlotMarker}},
#' \code{\link{QueryStarPlot}}, \code{\link{PlotSD}}
#'
#' @examples
#' # Identify the files
#' fcs_file <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#' gating_file <- system.file("extdata", "gatingResult.csv", package = "FlowSOM")
#'
#' # Specify the cell types of interest for assigning one label per cell
#' cellTypes <- c("B cells",
#' "gd T cells", "CD4 T cells", "CD8 T cells",
#' "NK cells", "NK T cells")
#'
#' # Load manual labels (e.g. GetFlowJoLabels can be used to extract labels from
#' # an fcs file)
#'
#' gatingResult <- as.factor(read.csv(gating_file, header = FALSE)[, 1])
#'
#'
#' # Build a FlowSOM tree
#' flowSOM.res <- FlowSOM(fcs_file,
#' scale = TRUE,
#' compensate = TRUE,
#' transform = TRUE,
#' toTransform = 8:18,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' # Plot pies indicating the percentage of cell types present in the nodes
#' PlotPies(flowSOM.res,
#' gatingResult,
#' backgroundValues = flowSOM.res$metaclustering)
#'
#' @importFrom grDevices colorRampPalette
#'
#' @export
PlotPies <- function(fsom,
cellTypes,
colorPalette = grDevices::colorRampPalette(c("white",
"#00007F",
"blue",
"#007FFF",
"cyan",
"#7FFF7F",
"yellow",
"#FF7F00",
"red",
"#7F0000")),
...){
if(length(cellTypes) != nrow(fsom$data)){
stop("There are ", nrow(fsom$data), " cells, while you provided ",
length(cellTypes), " labels. These numbers should match.")
}
p <- PlotFlowSOM(fsom = fsom,
...)
p <- AddPies(p,
fsom = fsom,
colorPalette = colorPalette,
cellLabels = cellTypes)
return(p)
}
#' PlotLabels
#'
#' Plot labels for each cluster
#'
#' Plot FlowSOM grid or tree, with in each node a label.
#' Especially useful to show metacluster numbers
#'
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}}
#' @param labels A vector of labels for every node.
#' @param maxNodeSize Determines the maximum node size. Default is 0.
#' @param textSize Size for geom_text. Default (=3.88) is from geom_text.
#' @param textColor Color for geom_text. Default = black.
#' @param ... Additional arguments to pass to \code{\link{PlotFlowSOM}}
#'
#' @return Nothing is returned. A plot is drawn in which each node is
#' represented by a label.
#'
#'
#' @seealso \code{\link{PlotStars}}, \code{\link{PlotVariable}},
#' \code{\link{PlotFlowSOM}}, \code{\link{PlotMarker}},
#' \code{\link{PlotNumbers}}, \code{\link{PlotPies}},
#' \code{\link{QueryStarPlot}}, \code{\link{PlotSD}}
#'
#' @examples
#' # Read from file, build self-organizing map and minimal spanning tree
#' fileName <- system.file("extdata", "68983.fcs", package="FlowSOM")
#' ff <- flowCore::read.FCS(fileName)
#' ff <- flowCore::compensate(ff, flowCore::keyword(ff)[["SPILL"]])
#' ff <- flowCore::transform(ff,
#' flowCore::transformList(colnames(flowCore::keyword(ff)[["SPILL"]]),
#' flowCore::logicleTransform()))
#' flowSOM.res <- FlowSOM(ff,
#' scale = TRUE,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' # Plot the node IDs
#' PlotLabels( flowSOM.res,
#' flowSOM.res$metaclustering)
#'
#' @importFrom grDevices colorRampPalette
#'
#' @export
PlotLabels <- function(fsom,
labels,
maxNodeSize = 0,
textSize = 3.88,
textColor = "black",
...){
fsom <- UpdateFlowSOM(fsom)
if(length(labels) != NClusters(fsom)) {
stop(paste0("Length of 'labels' should be equal to number of clusters in ",
"FlowSOM object (", NClusters(fsom), " clusters, ",
length(labels), " labels)."))
}
p <- PlotFlowSOM(fsom = fsom,
maxNodeSize = maxNodeSize,
...)
p <- AddLabels(p,
labels = labels,
textSize = textSize,
textColor = textColor)
return(p)
}
#' PlotNumbers
#'
#' Plot cluster ids for each cluster
#'
#' Plot FlowSOM grid or tree, with in each node the cluster id.
#'
#' @param fsom FlowSOM object
#' @param level Character string, should be either "clusters" or
#' "metaclusters". Can be abbreviated.
#' @param maxNodeSize Determines the maximum node size. Default is 0.
#' See \code{\link{PlotFlowSOM}} for more options.
#' @param ... Additional arguments to pass to \code{\link{PlotLabels}}
#' and to \code{\link{PlotFlowSOM}}
#'
#' @return Nothing is returned. A plot is drawn in which each node is
#' labeled by its cluster id.
#'
#' @seealso \code{\link{PlotStars}}, \code{\link{PlotVariable}},
#' \code{\link{PlotFlowSOM}}, \code{\link{PlotLabels}},
#' \code{\link{PlotMarker}}, \code{\link{PlotPies}},
#' \code{\link{QueryStarPlot}}, \code{\link{PlotSD}}
#'
#' @examples
#' # Read from file, build self-organizing map and minimal spanning tree
#' fileName <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#' ff <- flowCore::read.FCS(fileName)
#' ff <- flowCore::compensate(ff, flowCore::keyword(ff)[["SPILL"]])
#' ff <- flowCore::transform(ff, flowCore::estimateLogicle(ff,
#' flowCore::colnames(ff)[8:18]))
#' flowSOM.res <- FlowSOM(ff,
#' scale = TRUE,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' # Plot the node IDs
#' PlotNumbers(flowSOM.res)
#' PlotNumbers(flowSOM.res, "metaclusters")
#'
#' PlotNumbers(flowSOM.res,
#' view = "grid")
#'
#' PlotNumbers(flowSOM.res,
#' maxNodeSize = 1,
#' equalNodeSize = TRUE)
#'
#' @export
PlotNumbers <- function(fsom,
level = "clusters",
maxNodeSize = 0,
...){
level <- pmatch(level, c("clusters", "metaclusters"))
if (any(is.na(level)) | length(level) > 2){
stop("level should be \"clusters\" or \"metaclusters\"")
} else {
level <- c("clusters", "metaclusters")[level]
if (level == "clusters"){
numbers <- seq_len(NClusters(fsom))
} else if (level == "metaclusters") {
numbers <- fsom$metaclustering
}
}
p <- PlotLabels(fsom = fsom,
labels = numbers,
maxNodeSize = maxNodeSize,
...)
return(p)
}
#' PlotMarker
#'
#' Plot comparison with other clustering
#'
#' Plot FlowSOM grid or tree, colored by node values for a specific marker
#'
#' @param fsom FlowSOM object
#' @param marker A vector of markers/channels to plot.
#' @param refMarkers Is used to determine relative scale of the marker
#' that will be plotted. Default are all markers used in the
#' clustering.
#' @param title A vector with custom titles for the plot. Default is
#' the marker name.
#' @param colorPalette Color palette to use. Can be a function or a vector.
#' @param lim Limits for the scale
#' @param ... Additional arguments to pass to \code{\link{PlotFlowSOM}},
#' e.g. view, backgroundValues, equalNodeSize ...
#'
#' @return A ggplot figure is returned in which every cluster is colored
#' according to the MFI value for the specified marker
#'
#' @seealso \code{\link{PlotStars}}, \code{\link{PlotVariable}}
#'
#' @examples
#' # Build FlowSOM model
#' fileName <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#' flowSOM.res <- FlowSOM(fileName,
#' compensate = TRUE, transform = TRUE, scale = FALSE,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#' # Plot one marker
#' PlotMarker(flowSOM.res,
#' "CD19")
#'
#' PlotMarker(flowSOM.res,
#' "CD19",
#' colorPalette = c("gray", "red"))
#'
#' # Plot all markers
#' PlotMarker(flowSOM.res,
#' c(9, 12, 14:18))
#'
#' # Use specific limits if the ones from the columns used for clustering
#' # are not relevant for your marker of choice
#' PlotMarker(flowSOM.res,
#' "FSC-A",
#' lim = c(55000, 130000))
#'
#' # Example with additional FlowSOM plotting options
#' PlotMarker(flowSOM.res,
#' "CD19",
#' view = "grid",
#' equalNodeSize = TRUE,
#' backgroundValues = 1:100 == 27,
#' backgroundColors = c("white", "red"))
#'
#'
#' @importFrom grDevices colorRampPalette
#' @importFrom ggplot2 ggtitle
#'
#' @export
PlotMarker <- function(fsom,
marker,
refMarkers = fsom$map$colsUsed,
title = GetMarkers(fsom, marker),
colorPalette = FlowSOM_colors,
lim = NULL,
...){
fsom <- UpdateFlowSOM(fsom)
# Get median values to visualise
mfis <- GetClusterMFIs(fsom)
# Get column names
channels <- GetChannels(fsom, marker)
# Compute limits based on all reference markers
ref_channels <- GetChannels(fsom, refMarkers)
if (is.null(lim)) lim <- c(min(mfis[, ref_channels]),
max(mfis[, ref_channels]))
plotList <- lapply(seq_along(channels), function(channelI){
# Use MFI values as variable to plot
p <- PlotVariable(fsom,
variable = mfis[, channels[channelI]],
variableName = "MFI",
colorPalette = colorPalette,
lim = lim,
...)
# Add title
if (is.na(title[channelI])) title[channelI] <- ""
p <- p + ggplot2::ggtitle(title[channelI])
})
p <- ggpubr::ggarrange(plotlist = plotList, common.legend = TRUE,
legend = "right")
return(p)
}
#' PlotVariable
#'
#' Plot a variable for all nodes
#'
#' Plot FlowSOM grid or tree, colored by node values given in variable
#'
#' @param fsom FlowSOM object
#' @param variable A vector containing a value for every cluster
#' @param variableName Label to show on the legend
#' @param colorPalette Color palette to use. Can be a function or a vector.
#' @param lim Limits for the scale
#' @param ... Additional arguments to pass to \code{\link{PlotFlowSOM}},
#' e.g. view, backgroundValues, equalNodeSize ...
#'
#' @seealso \code{\link{PlotStars}}, \code{\link{QueryStarPlot}},
#' \code{\link{PlotFlowSOM}}, \code{\link{PlotLabels}},
#' \code{\link{PlotNumbers}}, \code{\link{PlotMarker}},
#' \code{\link{PlotPies}}, \code{\link{PlotSD}}
#'
#' @examples
#' # Build FlowSOM model
#' fileName <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#' flowSOM.res <- FlowSOM(fileName,
#' compensate = TRUE, transform = TRUE, scale = FALSE,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' # Plot some random values
#' rand <- runif(flowSOM.res$map$nNodes)
#' PlotVariable(flowSOM.res,
#' variable = rand,
#' variableName = "Random")
#'
#' PlotVariable(flowSOM.res,
#' variable = flowSOM.res$metaclustering,
#' variableName = "Metaclustering") %>%
#' AddLabels(labels = flowSOM.res$metaclustering)
#'
#' @export
PlotVariable <- function(fsom,
variable,
variableName = "",
colorPalette = FlowSOM_colors,
lim = NULL,
...){
fsom <- UpdateFlowSOM(fsom)
if (length(variable) != fsom$map$nNodes){
stop(paste0("Length of 'variable' should be equal to number of clusters in",
" FlowSOM object (", fsom$map$nNodes, " clusters and ",
length(variable), " variables)."))
}
# Base plot
p <- PlotFlowSOM(fsom = fsom,
...)
p <- AddNodes(p = p,
values = variable,
colorPalette = colorPalette,
lim = lim,
label = variableName)
return(p)
}
#' PlotDimRed
#'
#' Plot a dimensionality reduction
#'
#' Plot a dimensionality reduction of fsom$data
#'
#' @param fsom FlowSOM object, as generated by \code{\link{BuildMST}}
#' @param colsToUse The columns used for the dimensionality reduction.
#' Default = fsom$map$colsUsed.
#' @param colorBy Defines how the dimensionality reduction will be
#' colored. Can be "metaclusters" (default), "clusters"
#' (or abbreviations) or a marker/channel/index.
#' @param colors A vector of custom colors. Default returns ggplot
#' colors for categorical variables and the FlowSOM colors
#' for continuous variables. When using a categorical
#' variable, the vector must be as long as
#' the levels of the categorical variable.
#' @param lim Limits for the colorscale
#' @param cTotal The total amount of cells to be used in the
#' dimensionality reduction. Default is all the cells.
#' @param dimred A dimensionality reduction function.
#' Default = Rtsne::Rtsne. Alternatively, a data.frame or
#' matrix with either equal number of rows to the
#' fsom or an OriginalID column. Recommended to put
#' cTotal to NULL when providing a matrix (or ensuring
#' that the dimred corresponds to subsampling the
#' flowSOM data for cTotal cells with the same seed).
#' @param extractLayout A function to extract the coordinates from the results
#' of the dimred default = function(dimred){dimred$Y}.
#' @param label If label = TRUE (default), labels are added to plot.
#' @param returnLayout If TRUE, this function returns a dataframe with
#' the layout of dimred and the original IDs and the
#' plot. Default = FALSE.
#' @param seed A seed for reproducibility.
#' @param title A title for the plot.
#' @param ... Additional arguments to pass to dimred.
#'
#' @return A dimensionality reduction plot made in ggplot2
#'
#' @examples
#' file <- system.file("extdata", "68983.fcs", package="FlowSOM")
#' flowSOM.res <- FlowSOM(file, compensate = TRUE, transform = TRUE,
#' scale = TRUE,
#' colsToUse = c(9, 12, 14:18), nClus = 10, silent = FALSE,
#' xdim = 7, ydim = 7)
#' PlotDimRed(flowSOM.res, cTotal = 5000, seed = 1, title = "t-SNE")
#' PlotDimRed(flowSOM.res, cTotal = 5000, colorBy = "CD3", seed = 1,
#' title = "t-SNE")
#'
#' @import ggplot2
#' @importFrom Rtsne Rtsne
#' @importFrom tidyr pivot_longer
#'
#' @export
PlotDimRed <- function(fsom,
colsToUse = fsom$map$colsUsed,
colorBy = "metaclusters",
colors = NULL,
lim = NULL,
cTotal = NULL,
dimred = Rtsne::Rtsne,
extractLayout = function(dimred){dimred$Y},
label = TRUE,
returnLayout = FALSE,
seed = NULL,
title = NULL,
...){
dimred_data <- fsom$data
colorBy_pmatch <- pmatch(colorBy, c("metaclusters", "clusters"))
if (any(is.na(colorBy_pmatch))){
if (all(colorBy %in% colnames(dimred_data)) ||
all(colorBy %in% GetMarkers(fsom, colnames(dimred_data))) ||
all(colorBy %in% seq_len(ncol(dimred_data)))){
dimred_col <- fsom$data[, GetChannels(fsom, colorBy), drop = FALSE]
colnames(dimred_col) <- GetMarkers(fsom, colnames(dimred_col))
colorBy <- "marker"
} else {
stop(paste0("\"colorBy\" should be \"metaclusters\", \"clusters\" or a ",
"vector of channels, markers or indices"))
}
} else {
if (length(colorBy) > 1){
stop(paste0("\"colorBy\" should be \"metaclusters\", \"clusters\" or a ",
"vector of channels, markers or indices"))
}
colorBy <- c("metaclusters", "clusters")[colorBy_pmatch]
if (length(colorBy) == 1 && colorBy == "metaclusters") {
if (is.null(fsom$metaclustering)) stop("No metaclustering present")
dimred_col <- as.data.frame(GetMetaclusters(fsom))
} else if (length(colorBy) == 1 && colorBy == "clusters") {
dimred_col <- as.data.frame(as.factor(GetClusters(fsom)))
}
}
if (is.null(colors)){
if (colorBy == "marker") colors <- FlowSOM_colors(9)
else colors <- gg_color_hue(nlevels(dimred_col[, 1]))
} else {
if (length(colors) != nlevels(dimred_col[, 1]) && colorBy != "marker") {
stop(paste0("Length of \"colors\" (", length(colors), ") should be ",
"equal to the amount of levels in \"", colorBy, "\" (",
nlevels(dimred_col[, 1]), ")."))
}
}
if (!is.null(colsToUse)) dimred_data <- dimred_data[, GetChannels(fsom,
colsToUse)]
if (!is.null(seed)) set.seed(seed)
if (!is.null(cTotal) && cTotal < nrow(dimred_data)) {
downsample <- sample(seq_len(nrow(dimred_data)), cTotal)
dimred_data <- dimred_data[downsample, , drop = FALSE]
dimred_col <- dimred_col[downsample, , drop = FALSE]
} else {
downsample <- seq_len(nrow(dimred_data))
}
if (is.function(dimred)){
dimred_res <- dimred(dimred_data, ...)
dimred_layout <- as.data.frame(extractLayout(dimred_res))
if (nrow(dimred_layout) == 0 && ncol(dimred_layout) != 2) {
stop("Please use the right extraction function in extractLayout")
}
} else if((is.matrix(dimred) | is.data.frame(dimred)) &
(nrow(dimred) == nrow(dimred_data) |
any(colnames(dimred) == "Original_ID"))){
id_col <- which(colnames(dimred) == "Original_ID")
dimred_layout <- as.data.frame(dimred[,-id_col])
if("Original_ID" %in% colnames(dimred)){
dimred_data <- dimred_data[dimred[,"Original_ID"], , drop = FALSE]
dimred_col <- dimred_col[dimred[,"Original_ID"], , drop = FALSE]
}
} else stop("dimred should be a dimensionality reduction method or matrix")
colnames(dimred_layout) <- c("dimred_1", "dimred_2")
dimred_plot <- cbind(dimred_layout, dimred_col)
if (colorBy == "marker"){
dimred_plot <- dimred_plot %>% tidyr::pivot_longer(3:ncol(dimred_plot),
names_to = "markers")
if (requireNamespace("scattermore", quietly = TRUE)) {
p <- ggplot2::ggplot(dimred_plot) +
scattermore::geom_scattermore(ggplot2::aes(x = .data$dimred_1,
y = .data$dimred_2,
col = .data$value),
pointsize = 1)
} else {
message("For faster plotting with more datapoints, please install \"scattermore\"")
p <- ggplot2::ggplot(dimred_plot) +
ggplot2::geom_point(ggplot2::aes(x = .data$dimred_1,
y = .data$dimred_2,
col = .data$value),
size = 1)
}
p <- p + ggplot2::facet_wrap(~markers) +
ggplot2::theme_minimal() +
ggplot2::coord_fixed() +
ggplot2::scale_color_gradientn(colors = colors, limits = lim)
} else {
colnames(dimred_plot) <- c("dimred_1", "dimred_2", "colors")
median_x <- tapply(dimred_plot[,"dimred_1"], dimred_plot[,"colors"], median)
median_y <- tapply(dimred_plot[,"dimred_2"], dimred_plot[,"colors"], median)
if (requireNamespace("scattermore", quietly = TRUE)) {
p <- ggplot2::ggplot(dimred_plot) +
scattermore::geom_scattermore(ggplot2::aes(x = .data$dimred_1,
y = .data$dimred_2,
col = .data$colors),
pointsize = 1)
} else {
message("For faster plotting with more datapoints, please install \"scattermore\"")
p <- ggplot2::ggplot(dimred_plot) +
ggplot2::geom_point(ggplot2::aes(x = .data$dimred_1,
y = .data$dimred_2,
col = .data$colors),
size = 1)
}
p <- p + ggplot2::theme_minimal() + ggplot2::coord_fixed() +
scale_color_manual(values = colors)
if (label){
if (requireNamespace("ggrepel", quietly = TRUE)) {
p <- p + ggrepel::geom_label_repel(ggplot2::aes(x = .data$x,
y = .data$y,
label = .data$label,
color = .data$label),
data = data.frame(x = median_x,
y = median_y,
label = names(median_x)),
segment.color = "gray", force = 20,
segment.size = 0.2, point.padding = 0.5)
} else {
message("For better labels, please install \"ggrepel\"")
p <- p + ggplot2::geom_label(ggplot2::aes(x = .data$x,
y = .data$y,
label = .data$label,
color = .data$label),
data = data.frame(x = median_x,
y = median_y,
label = names(median_x)))
}
p <- p + labs(col = colorBy)
}
}
if (!is.null(title)) p <- p + ggplot2::ggtitle(title)
if (returnLayout) {
if (!is.null(cTotal)){
dimred_layout <- data.frame(dimred_layout, "Original_ID" = downsample)
}
return(list("plot" = p, "layout" = dimred_layout))
} else return(p)
}
#' PlotManualBars
#'
#' Function to plot the manual labels per FlowSOM (meta)cluster in a barplot
#'
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}} or
#' by \code{\link{NewData}}. The clusters and metaclusters
#' will be plotted in the order of the factor levels.
#' @param fcs FCS file that should be mapped on the FlowSOM object.
#' Default is NULL.
#' @param manualVector Vector with cell labels, e.g. obtained by manual gating
#' @param manualOrder Optional vector with unique cell labels to fix in which
#' order the cell labels should be shown
#' @param colors Optional color vector, should have the same length as
#' the number of unique cell labels
#' @param list_insteadof_plots If \code{FALSE} (default), it returns multiple
#' plots. If \code{TRUE}, it returns a list of
#' ggplot objects
#'
#' @return Either a plot or a ggplot objects list is returned.
#'
#' @examples
#' # Identify the files
#' fcs_file <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#' gating_file <- system.file("extdata", "gatingResult.csv", package = "FlowSOM")
#'
#' # Specify the cell types of interest for assigning one label per cell
#' cellTypes <- c("B cells",
#' "gd T cells", "CD4 T cells", "CD8 T cells",
#' "NK cells", "NK T cells")
#'
#' # Load manual labels (e.g. GetFlowJoLabels can be used to extract labels from
#' # an fcs file)
#'
#' gatingResult <- as.factor(read.csv(gating_file, header = FALSE)[, 1])
#'
#' # Build a FlowSOM object
#' flowSOM.res <- FlowSOM(fcs_file,
#' scale = TRUE,
#' compensate = TRUE,
#' transform = TRUE,
#' toTransform = 8:18,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' # Make the barplot of the manual labels
#' pdf("PlotManualBars.pdf")
#' PlotManualBars(fsom = flowSOM.res,
#' fcs = fcs_file,
#' manualVector = gatingResult,
#' manualOrder = c(cellTypes, "Unlabeled"),
#' colors = c("#F8766D", "#B79F00", "#00BA38", "#00BFC4",
#' "#619CFF", "#F564E3", "#D3D3D3"))
#' dev.off()
#'
#' @import ggplot2
#' @importFrom dplyr mutate
#'
#' @export
#'
PlotManualBars <- function(fsom, fcs = NULL,
manualVector, manualOrder = NULL,
colors = NULL, list_insteadof_plots = FALSE){
#----Warnings----
if (!is.null(manualOrder) &
!length(manualOrder) == length(unique(manualVector))){
stop(paste0("Length of the manualOrder vector (", length(manualOrder),
") should have the same length as the number of unique labels",
"in manualVector (", length(unique(manualVector)), ")."))
}
if (!is.null(colors) & !length(colors) >= length(unique(manualVector))){
stop(paste0("Length of the colors vector (", length(colors),") should have",
"at least the same length as the number of unique labels in ",
"manualVector (", length(unique(manualVector)), ")."))
}
#----Map FCS on fsom----
if (!is.null(fcs)){
fsom_tmp <- NewData(fsom, fcs)
} else {
fsom_tmp <- fsom
}
df <- data.frame("Manual" = manualVector,
"MC" = GetMetaclusters(fsom_tmp),
"C" = GetClusters(fsom_tmp),
stringsAsFactors = FALSE)
if(is.null(manualOrder)) {
manualOrder <- unique(manualVector)
}
#----Relative barplots MC----
df_s <- data.frame(table(df[, 1:2])) %>%
dplyr::mutate("Freq" = 100 * (.data$Freq / sum(.data$Freq))) %>%
dplyr::mutate("MC" = factor(.data$MC, levels = levels(fsom$metaclustering))) %>%
dplyr::mutate("Manual" = factor(.data$Manual, levels = manualOrder))
p1 <- ggplot2::ggplot(data = df_s,
ggplot2::aes(fill = .data$Manual,
y = .data$Freq,
x = .data$MC)) +
ggplot2::geom_bar(position = "stack", stat = "identity") +
ggplot2::theme_minimal() +
ggplot2::ggtitle("Manual labels per metacluster") +
ggplot2::ylab("Percentage of cells") +
ggplot2::xlab("")
if(!is.null(colors)) {
p1 <- p1 + ggplot2::scale_fill_manual(values = colors)
}
#----MC composition----
df_s <- data.frame(table(df[, 1:2]))
for (mc in levels(fsom$metaclustering)){
df_s$Freq[df_s$MC == mc] <-
df_s$Freq[df_s$MC == mc] / sum(df_s$Freq[df_s$MC == mc])
}
df_s <- df_s %>%
dplyr::mutate("MC" = factor(.data$MC, levels = levels(fsom$metaclustering))) %>%
dplyr::mutate("Manual" = factor(.data$Manual, levels = manualOrder))
p2 <- ggplot2::ggplot(data = df_s,
ggplot2::aes(fill = .data$Manual,
y = .data$Freq,
x = .data$MC)) +
ggplot2::geom_bar(position = "stack", stat = "identity") +
ggplot2::theme_minimal() +
ggplot2::ylab("") +
ggplot2::xlab("") +
ggplot2::ggtitle("Manual labels per metacluster") +
ggplot2::theme(axis.text.y = ggplot2::element_blank())
if(!is.null(colors)) {
p2 <- p2 + ggplot2::scale_fill_manual(values = colors)
}
#----Relative barplots C----
df_s <- data.frame(table(df[, c(1, 3)])) %>%
dplyr::mutate("Freq" = 100 * (.data$Freq / sum(.data$Freq))) %>%
dplyr::mutate("MC" = fsom$metaclustering[as.numeric(levels(.data$C))[.data$C]]) %>%
dplyr::mutate("MC" = factor(.data$MC, levels = levels(fsom$metaclustering))) %>%
dplyr::mutate("C" = factor(.data$C, levels = seq_len(NClusters(fsom)))) %>%
dplyr::mutate("Manual" = factor(.data$Manual, levels = manualOrder))
p3 <- ggplot2::ggplot(data = df_s,
ggplot2::aes(fill = .data$Manual,
y = .data$Freq,
x = .data$C)) +
ggplot2::geom_bar(position = "stack", stat = "identity") +
ggplot2::theme_minimal() +
ggplot2::ggtitle("Manual labels per cluster") +
ggplot2::facet_wrap(~.data$MC, scales = "free_x") +
ggplot2::ylab("Percentage of cells") +
ggplot2::xlab("") +
ggplot2::theme(strip.text = ggplot2::element_text(color = "gray"))
if(!is.null(colors)) {
p3 <- p3 + ggplot2::scale_fill_manual(values = colors)
}
#----C composition----
df_s <- data.frame(table(df[, c(1, 3)]))
for (c in seq_len(NClusters(fsom))){
df_s$Freq[df_s$C == c] <- df_s$Freq[df_s$C == c]/sum(df_s$Freq[df_s$C == c])
}
df_s <- df_s %>%
dplyr::mutate("MC" = fsom$metaclustering[as.numeric(levels(df_s$C))[df_s$C]]) %>%
dplyr::mutate("MC" = factor(.data$MC, levels = levels(fsom$metaclustering))) %>%
dplyr::mutate("C" = factor(.data$C, levels = seq_len(NClusters(fsom)))) %>%
dplyr::mutate("Manual" = factor(.data$Manual, levels = manualOrder))
p4 <- ggplot2::ggplot(data = df_s,
ggplot2::aes(fill = .data$Manual,
y = .data$Freq,
x = .data$C)) +
ggplot2::geom_bar(position = "stack", stat = "identity") +
ggplot2::theme_minimal() +
ggplot2::ylab("") +
ggplot2::xlab("") +
ggplot2::ggtitle("Manual labels per cluster") +
ggplot2::facet_wrap(~.data$MC, scales = "free_x") +
ggplot2::theme(axis.text.y = ggplot2::element_blank())
if(!is.null(colors)) {
p4 <- p4 + ggplot2::scale_fill_manual(values = colors)
}
#----Print plot or return list----
if (!list_insteadof_plots) {
print(p1)
print(p2)
print(p3)
print(p4)
} else {
return(list(p1, p2, p3, p4))
}
}
#' Plot2DScatters
#'
#' Function to draw 2D scatter plots of FlowSOM (meta)clusters
#'
#' Plot multiple 2D scatter plots in a png file. A subset of fsom$data is
#' plotted in gray, and those of the selected clusters and metaclusters are
#' plotted in color.
#'
#' @param fsom FlowSOM object, as created by \code{\link{FlowSOM}}
#' @param channelpairs List in which each element is a pair of channel
#' or marker names
#' @param clusters Vector or list (to combine multiple clusters in one
#' plot) with indices of clusters of interest
#' @param metaclusters Vector or list (to combine multiple metaclusters in
#' one plot) with indices of metaclusters of interest
#' @param maxBgPoints Maximum number of background cells to plot
#' @param sizeBgPoints Size of the background cells
#' @param maxPoints Maximum number of (meta)cluster cells to plot
#' @param sizePoints Size of the (meta)cluster cells
#' @param xLim Optional vector of a lower and upper limit of the x-axis
#' @param yLim Optional vector of a lower and upper limit of the y-axis
#' @param xyLabels Determines the label of the x- and y-axis. Can be
#' "marker" and\\or "channel" or abbrevations.
#' Default = "marker".
#' @param density Default is \code{TRUE} to color the (meta)cluster
#' points according to density. Set to \code{FALSE} to
#' use a plain color
#' @param centers Default is \code{TRUE} to show the cluster centers
#' @param colors Colors for all the cells in the selected nodes
#' (ordered list). First the clusters are colored,
#' then the metaclusters. If \code{NULL}, the default
#' ggplot colors, indexed by metacluster number, are used.
#' @param plotFile If a filepath for a png is given (default =
#' 2DScatterPlots.png), the plots will be plotted in
#' the corresponding png file. If \code{NULL}, a list
#' of ggplot objects will be returned
#'
#'
#' @return If \code{plot} is \code{TRUE}, nothing is returned and a plot is
#' drawn in which background cells are plotted in gray and the cells of
#' the selected nodes in color. If \code{plot} is \code{FALSE}, a ggplot
#' objects list is returned.
#'
#'
#' @examples
#' # Identify the files
#' fcs <- flowCore::read.FCS(system.file("extdata", "68983.fcs",
#' package = "FlowSOM"))
#'
#' # Build a FlowSOM object
#' flowSOM.res <- FlowSOM(fcs,
#' scale = TRUE,
#' compensate = TRUE,
#' transform = TRUE,
#' toTransform = 8:18,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' # Make the 2D scatter plots of the clusters and metaclusters of interest
#' Plot2DScatters(fsom = flowSOM.res,
#' channelpairs = list(c("PE-Cy7-A", "PE-Cy5-A"),
#' c("PE-Texas Red-A", "Pacific Blue-A")),
#' clusters = c(1, 48, 49, 82, 95),
#' metaclusters = list(c(1, 4), 9),
#' density = FALSE)
#'
#' Plot2DScatters(fsom = flowSOM.res,
#' channelpairs = list(c("PE-Texas Red-A", "Pacific Blue-A")),
#' metaclusters = list(c(1, 4)),
#' density = FALSE,
#' colors = list(c("red", "green")))
#'
#' @import ggplot2
#' @importFrom colorRamps matlab.like2
#' @importFrom grDevices png dev.off
#' @importFrom ggpubr ggarrange
#'
#' @export
#'
Plot2DScatters <- function(fsom,
channelpairs,
clusters = NULL,
metaclusters = NULL,
maxBgPoints = 3000,
sizeBgPoints = 0.5,
maxPoints = 1000,
sizePoints = 0.5,
xLim = NULL,
yLim = NULL,
xyLabels = c("marker"),
density = TRUE,
centers = TRUE,
colors = NULL,
plotFile = "2DScatterPlots.png"){
if(!is.null(fsom$metaclustering)){
metacluster <- as.numeric(fsom$metaclustering)
nMetaclusters <- NMetaclusters(fsom)
} else {
metacluster <- rep(1, NClusters(fsom))
nMetaclusters <- 1
}
medianValues <- fsom$map$medianValues
cellCluster <- GetClusters(fsom)
xyLabels <- pmatch(xyLabels, c("marker", "channel"))
#----Warnings----
if (density == FALSE &
!is.null(colors) &
!((length(clusters) + length(metaclusters)) == length(colors))){
stop("Length of colors list should be equal to the joined length ",
"of the clusters and metaclusters")
}
if (density == TRUE & !requireNamespace("ggpointdensity", quietly = TRUE)){
message("\"ggpointdensity\" not available. Please install.")
density <- FALSE
}
#----Join the clusters and metaclusters of interest----
i <- sample(nrow(fsom$data),
min(nrow(fsom$data), maxBgPoints))
# loop over all subsets at once
subsets <- list("Cluster" = as.list(clusters),
"Metacluster" = as.list(metaclusters))
plots_list <- list()
color_n <- 0
if (any(is.na(xyLabels)) | length(xyLabels) > 2){
stop("xyLabels should be \"marker\" and\\or \"channel\"")
} else {
xyLabels <- c("marker", "channel")[xyLabels]
}
for (group in names(subsets)){
for (subset in subsets[[group]]){
color_n <- color_n + 1
n <- as.numeric(unlist(subset))
for (channelpair in channelpairs){
channelpair <- GetChannels(fsom, channelpair)
#----background dataframe----
df_bg <- data.frame(fsom$data[i, c(channelpair[1], channelpair[2])])
#----(meta)cluster dataframe----
if(group == "Cluster") {
# dataframe with cluster's points
df_ss <- data.frame(fsom$data[cellCluster %in% n,
c(channelpair[1], channelpair[2]),
drop = FALSE],
"Population" = cellCluster[cellCluster %in% n])
# dataframe with centers
df_c <- data.frame(medianValues[n,
c(channelpair[1], channelpair[2]),
drop = FALSE],
"Population" = factor(n, levels = n))
col <- gg_color_hue(nMetaclusters)[metacluster[n]]
} else {
df_ss <- data.frame(fsom$data[which(metacluster[cellCluster] %in% n),
c(channelpair[1], channelpair[2]),
drop = FALSE],
"Population" =
metacluster[cellCluster[
which(metacluster[cellCluster] %in% n)]])
df_c_Population <- metacluster[
which(metacluster[1:nrow(medianValues)] %in% n),
drop = FALSE]
df_c <- data.frame(
medianValues[which(metacluster[1:nrow(medianValues)] %in% n),
c(channelpair[1], channelpair[2]),
drop = FALSE],
"Population" = df_c_Population)
col <- gg_color_hue(nMetaclusters)[n]
}
df_ss <- data.frame(df_ss[sample(nrow(df_ss),
min(nrow(df_ss), maxPoints)), ])
df_ss$Population <- factor(df_ss$Population, levels = subset)
df_c$Population <- factor(df_c$Population, levels = subset)
colnames(df_c) <- c("m1", "m2", "Population")
colnames(df_ss)[1:2] <- colnames(df_bg) <- c("m1", "m2")
#----ggplots----
cl_or_mcl <- paste0(group, ifelse(length(subset) > 1, "s", ""), ": ")
subset_names <- ifelse(group == "Cluster",
paste0(subset, collapse = ", "),
paste0(levels(fsom$metaclustering)[unlist(subset)],
collapse = ", "))
title <- paste0(cl_or_mcl, subset_names)
if ("marker" %in% xyLabels && length(xyLabels) == 1) {
xyLabs <- GetMarkers(fsom, channelpair)
} else if ("channel" %in% xyLabels && length(xyLabels) == 1){
xyLabs <- GetChannels(fsom, channelpair)
} else if (all(c("channel", "marker") %in% xyLabels) && length(xyLabels) == 2){
channels <- GetChannels(fsom, channelpair)
xyLabs <- paste0(GetMarkers(fsom, channelpair), " (", channels, ")")
}
p <- ggplot2::ggplot(data = df_ss,
ggplot2::aes(x = .data$m1,
y = .data$m2)) +
ggplot2::geom_point(data = df_bg,
color = "gray",
size = sizeBgPoints) + # background dot plot
ggplot2::theme_classic() +
ggplot2::ggtitle(title) +
ggplot2::xlab(xyLabs[1]) +
ggplot2::ylab(xyLabs[2]) +
ggplot2::theme(legend.position = "none")
if (!is.null(xLim)) p <- p + ggplot2::xlim(xLim)
if (!is.null(yLim)) p <- p + ggplot2::ylim(yLim)
if (density) {
# subset density plot
p <- p + ggpointdensity::geom_pointdensity(size = sizePoints) +
ggplot2::scale_color_gradientn(colors =
colorRamps::matlab.like2(10))
} else {
# if no colors are given, the default colors of ggplot are used
if (is.null(colors)){
p <- p + ggplot2::geom_point(ggplot2::aes(color = .data$Population),
size = sizePoints) +
ggplot2::scale_color_manual(values = col)
} else {
#subset plot, metacluster colors
if (length(colors[[color_n]]) != nlevels(df_ss$Population)){
stop(paste0("For \"", title, "\", we expect ",
nlevels(df_ss$Population), " colors while only ",
length(colors[[color_n]]), " are given."))
}
p <- p + ggplot2::geom_point(ggplot2::aes(color = .data$Population),
size = sizePoints) +
ggplot2::scale_color_manual(values = colors[[color_n]])
}
}
#----add cluster centers----
if (centers) {
if (!density){
if (!is.null(colors)){
col_c <- colors[[color_n]]
} else {
col_c <- col
}
} else {
col_c <- rep("white", nrow(df_c))
}
p <- p + ggplot2::geom_point(data = df_c,
shape = 21,
ggplot2::aes(fill = .data$Population),
color = "black",
size = 3,
stroke = 1) +
ggplot2::scale_fill_manual(values = col_c)
}
plots_list[[length(plots_list) + 1]] <- p
}
}
}
if (!is.null(plotFile)) {
grDevices::png(plotFile,
width = 400 * length(channelpairs),
height = 400 * (length(clusters) + length(metaclusters)))
print(ggpubr::ggarrange(plotlist = plots_list,
ncol = length(channelpairs),
nrow = (length(clusters) + length(metaclusters)),
common.legend = FALSE))
grDevices::dev.off()
} else {
return(plots_list)
}
}
#' QueryStarPlot
#'
#' Query a certain cell type
#'
#' Identify nodes in the tree which resemble a certain profile of "high"
#' or "low" marker expressions.
#'
#' @param fsom FlowSOM object, as generated by \code{\link{BuildMST}}
#' @param query Array containing "high" or "low" (or abbreviations)
#' for the specified column names of the FlowSOM data.
#' @param plot If true, a plot with a gradient of scores for the
#' nodes is shown.
#' @param colorPalette Color palette to be used for colors for "stars",
#' "pies" or "marker". Can be either a function or an
#' array specifying colors.
#' @param backgroundColors Color to use for nodes with a high score in the plot.
#' Default is red.
#' @param ... Additional arguments to pass to \code{\link{PlotFlowSOM}}
#'
#' @return A list, containing the ids of the selected nodes, the individual
#' scores for all nodes and the scores for each marker for each node
#'
#' @seealso \code{\link{PlotStars}}, \code{\link{PlotVariable}},
#' \code{\link{PlotFlowSOM}}, \code{\link{PlotLabels}},
#' \code{\link{PlotNumbers}}, \code{\link{PlotMarker}},
#' \code{\link{PlotPies}}, \code{\link{PlotSD}}
#'
#' @examples
#' file <- system.file("extdata", "68983.fcs", package="FlowSOM")
#' flowSOM.res <- FlowSOM(file, compensate = TRUE, transform = TRUE,
#' scale = TRUE, colsToUse = c(9, 12, 14:18), nClus = 10,
#' silent = FALSE, xdim = 7, ydim = 7)
#' query <- c("CD3" = "high", #CD3
#' "CD4" = "low", #TCRb
#' "CD8" = "high") #CD8
#' query_res <- QueryStarPlot(flowSOM.res, query, equalNodeSize = TRUE)
#'
#' cellTypes <- factor(rep("Unlabeled", 49),
#' levels = c("Unlabeled", "CD8 T cells"))
#' cellTypes[query_res$selected] <- "CD8 T cells"
#' PlotStars(flowSOM.res,
#' backgroundValues = cellTypes,
#' backgroundColors = c("#FFFFFF00", "#ca0020aa"))
#'
#' @importFrom grDevices colorRampPalette
#' @importFrom ggpubr ggarrange
#'
#' @export
QueryStarPlot <- function(fsom,
query,
plot = TRUE,
colorPalette = FlowSOM_colors,
backgroundColors = "#CA0020",
...){
fsom <- UpdateFlowSOM(fsom)
names(query) <- GetChannels(fsom, names(query))
markers <- names(query)
lowMarkers <- pmatch("l", query)
query <- ParseQuery(fsom, query)
if (plot){
fP <- PlotStars(fsom = fsom,
markers = markers,
backgroundColors =
grDevices::colorRampPalette(c(rep("#FFFFFF00", 3),
backgroundColors)),
backgroundValues = query$nodeScores,
list_insteadof_ggarrange = TRUE,
...)
nMarkers <- length(markers)
starHeight <- rep(1, nMarkers)
starHeight[lowMarkers] <- 0
l <- PlotStarLegend(fsom$prettyColnames[markers],
colors = colorPalette(nMarkers),
starHeight = starHeight)
p <- ggpubr::ggarrange(fP$tree,
ggpubr::ggarrange(l, fP$backgroundLegend, ncol = 1),
NULL,
ncol = 3,
widths = c(3, 1, 0.3),
legend = "none")
query$plot <- p
}
return(query)
}
#' QueryMultiple
#'
#' Function which takes a named list of multiple cell types, where every item is
#' a named vector with values "high"/"low" and the names correspond to the
#' markers or channels (e.g. as generated by parse_markertable).
#'
#' @param fsom FlowSOM object
#' @param cellTypes Description of the cell types. Named list, with one named
#' vector per cell type containing "high"/"low" values
#' @param plotFile Path to a pdf file to save the plots (default is
#' queryMultiple.pdf). If \code{NULL}, no plots will be
#' generated
#' @param ... Additional arguments to pass to \code{\link{QueryStarPlot}}
#'
#' @return A label for every FlowSOM cluster (Unknown or one of the celltype
#' names of the list, if selected by QueryStarPlot)
#'
#' @examples
#' file <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#' ff <- flowCore::read.FCS(file)
#' # Use the wrapper function to build a flowSOM object (saved in flowSOM.res)
#' # and a metaclustering (saved in flowSOM.res[["metaclustering"]])
#' flowSOM.res <- FlowSOM(ff, compensate = TRUE, transform = TRUE, scale = TRUE,
#' colsToUse = c(9, 12, 14:18), nClus = 10, silent = FALSE,
#' xdim = 7, ydim = 7)
#' cellTypes <- list("CD8 T cells" = c("PE-Cy7-A" = "high",
#' "APC-Cy7-A" = "high",
#' "Pacific Blue-A" = "high"),
#' "B cells" = c("PE-Cy5-A" = "high"),
#' "NK cells" = c("PE-A" = "high",
#' "PE-Cy7-A" = "low",
#' "APC-Cy7-A" = "low"))
#' query_res <- QueryMultiple(flowSOM.res, cellTypes, "query_multiple.pdf")
#'
#' @export
QueryMultiple <- function(fsom,
cellTypes,
plotFile = "queryMultiple.pdf",
...){
fsom <- UpdateFlowSOM(fsom)
labels <- rep("Unlabeled", fsom$map$nNodes)
plotList <- list()
plot <- ifelse(is.null(plotFile), FALSE, TRUE)
for(cell_type in names(cellTypes)){
query <- cellTypes[[cell_type]]
query_res <- QueryStarPlot(fsom,
equalNodeSize = TRUE,
query = query,
title = cell_type,
plot = plot,
...)
if (plot) plotList[[cell_type]] <- query_res$plot
labels[query_res$selected] <- cell_type
}
if (plot){
pdf(plotFile, useDingbats = FALSE)
for (p in plotList){
print(p)
}
dev.off()
}
return(labels)
}
#' PlotSD
#'
#' Plot FlowSOM grid or tree, colored by standard deviation.
#'
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}}
#' @param marker If a marker/channel is given, the sd for this marker is
#' shown. Otherwise, the maximum ratio is used.
#' @param ... Additional arguments to pass to \code{\link{PlotFlowSOM}}
#'
#' @return Nothing is returned. A plot is drawn in which each node
#' is colored depending on its standard deviation
#'
#' @seealso \code{\link{PlotStars}}, \code{\link{PlotVariable}},
#' \code{\link{PlotFlowSOM}}, \code{\link{PlotLabels}},
#' \code{\link{PlotNumbers}}, \code{\link{PlotMarker}},
#' \code{\link{PlotPies}}, \code{\link{QueryStarPlot}}
#'
#' @examples
#' # Read from file, build self-organizing map and minimal spanning tree
#' fileName <- system.file("extdata", "68983.fcs", package = "FlowSOM")
#' flowSOM.res <- ReadInput(fileName, compensate = TRUE, transform = TRUE,
#' scale = TRUE)
#' flowSOM.res <- BuildSOM(flowSOM.res, colsToUse = c(9, 12, 14:18))
#' flowSOM.res <- BuildMST(flowSOM.res)
#'
#' PlotSD(flowSOM.res)
#'
#' @importFrom grDevices colorRampPalette
#'
#' @export
PlotSD <- function(fsom,
marker = NULL,
...){
fsom <- UpdateFlowSOM(fsom)
if(!is.null(marker)) marker <- GetChannels(fsom, marker)
SDs <- ParseSD(fsom, marker)
PlotVariable(fsom = fsom,
variable = SDs,
variableName = "SD",
...)
}
#' PlotStarLegend
#'
#' Plots star legend
#'
#' Function makes the legend of the FlowSOM star plot
#'
#' @param markers Vector of markers used in legend
#' @param colors Color palette for the legend. Can be a vector or a
#' function.
#' @param starHeight Star height. Default = 1.
#'
#' @return Returns nothing, but plots a legend for FlowSOM star plot
#'
#' @seealso \code{\link{PlotFlowSOM}}
#'
#' @examples
#' PlotStarLegend(c("CD3", "CD4", "CD8"),
#' FlowSOM_colors(3))
#'
#' @import ggplot2
#' @importFrom dplyr count
#' @importFrom grDevices colorRampPalette
#'
#' @export
PlotStarLegend <- function(markers,
colors,
starHeight = 1){
requireNamespace("ggplot2")
markers <- factor(markers, levels = markers)
nMarkers <- length(markers)
circularCoords <- seq(from = 2 * pi / (nMarkers * 2),
by = 2 * pi / nMarkers,
length.out = nMarkers)
dfSegments <- data.frame(Markers = markers,
x = sin(circularCoords),
y = cos(circularCoords),
xend = 1.1 * ifelse(sin(circularCoords) >= 0,
1, -1),
yend = NA)
nLeftRight <- dplyr::count(dfSegments, .data$x >= 0)
if (nrow(nLeftRight) != 1){
by <- ifelse(nMarkers <= 8, 1, 0.65)
left <- seq(from = 0, by = by, length.out = nLeftRight[1, 2])
right <- -seq(from = 0, by = by, length.out = nLeftRight[2, 2])
dfSegments[which(dfSegments$x < 0), ]$yend <- left - mean(left)
dfSegments[which(dfSegments$x >= 0), ]$yend <- right - mean(right)
} else {
dfSegments$yend <- -2
}
horizontalLines <- data.frame(Markers = dfSegments$Markers,
x = dfSegments$xend, y = dfSegments$yend,
xend = dfSegments$xend +
ifelse(dfSegments$xend >= 0, 0.5, -0.5),
yend = dfSegments$yend,
stringsAsFactors = FALSE)
dfSegments <- rbind(dfSegments, horizontalLines)
dfLabels <- data.frame(x = horizontalLines$xend +
ifelse(horizontalLines$xend >= 0, 0.3, -0.3),
y = horizontalLines$yend)
markers_tmp <- rep(1, nMarkers)
names(markers_tmp) <- markers
dfStar <- ParseArcs(0, 0, markers_tmp, starHeight)
dfStar$Markers <- factor(dfStar$Marker, levels = markers)
l <- ggplot2::ggplot() +
ggplot2::xlim(c(-6, 6)) +
ggplot2::coord_fixed(clip = "off") +
ggplot2::theme_void() +
ggplot2::theme(legend.position = "none")
l <- AddStarsPies(l,
dfStar,
colors)
l <- AddScale(p = l,
values = markers,
colors = colors,
showLegend = FALSE,
type = "color")
l <- l +
ggplot2::geom_segment(data = dfSegments,
ggplot2::aes(x = .data$x, y = .data$y,
xend = .data$xend,
yend = .data$yend,
color = .data$Markers),
linewidth = 0.6)
l <- AddLabels(l,
labels = markers,
layout = dfLabels,
hjust = ifelse(horizontalLines$xend >= 0, 0, 1))
return(l)
}
#' ParseEdges
#'
#' Parses edges
#'
#' Function that parses the graph edges of the FlowSOM object into a dataframe
#'
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}}
#'
#' @return A dataframe consisting of start and end coordinates of edges
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{ParseNodeSize}},
#' \code{\link{ParseArcs}}, \code{\link{ParseQuery}},
#' \code{\link{ParseSD}}, \code{\link{AddMST}}
#'
#' @importFrom igraph as_edgelist
#'
ParseEdges <- function(fsom){
edgeList <- as.data.frame(igraph::as_edgelist(fsom$MST$g),
stringsAsFactors = FALSE)
coords <- fsom$MST$l
segmentPlot <- lapply(seq_len(nrow(edgeList)), function(row_id){
node_ids <- as.numeric(edgeList[row_id, ])
row <- c(coords[node_ids[1], 1],
coords[node_ids[1], 2],
coords[node_ids[2], 1],
coords[node_ids[2], 2])
return(row)
})
segmentPlot <- do.call(rbind, segmentPlot)
colnames(segmentPlot) <- c("x", "y", "xend", "yend")
return(as.data.frame(segmentPlot))
}
#' ParseLayout
#'
#' @param fsom FlowSOM object
#' @param layout "MST", "grid" or a matrix/dataframe with 2 columns and 1 row
#' per cluster
#'
#' @return dataframe with 2 columns and 1 row per cluster
#'
ParseLayout <- function(fsom, layout){
if (is.matrix(layout) || is.data.frame(layout)){
if (nrow(layout) == NClusters(fsom) &&
ncol(layout) == 2){
layout <- as.data.frame(layout)
} else {
stop(paste0("Number of rows should be equal to number of clusters (",
NClusters(fsom), " clusters) and number of columns should be equal ",
"to two."))
}
} else if (layout == "grid"){
layout <- as.data.frame(fsom$map$grid)
} else if (layout == "MST"){
layout <- as.data.frame(fsom$MST$l)
} else {
stop(paste0("The layout should be 'MST', 'grid' or a matrix/dataframe ",
"with 2 columns and 1 row per cluster."))
}
colnames(layout) <- c("x", "y")
return(layout)
}
#' ParseNodeSize
#'
#' Parses node size
#'
#' Function that parses the mapping of the FlowSOM object into node sizes
#' relative to the abundances of cells per cluster
#'
#' Scales node size relative to the abundances of cells per cluster
#'
#' @param nodeSizes A vector with node sizes
#' @param maxNodeSize Determines the maximum node size.
#' @param refNodeSize Reference for node size against which the nodeSizes
#' will be scaled. Default = max(nodeSizes)
#'
#' @return A vector is returned consisting of node sizes
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{ParseEdges}},
#' \code{\link{AutoMaxNodeSize}}, \code{\link{ParseArcs}},
#' \code{\link{ParseQuery}}, \code{\link{ParseSD}}
#'
#' @importFrom dplyr count mutate pull
#'
#' @export
ParseNodeSize <- function(nodeSizes, maxNodeSize, refNodeSize){
if(any(is.na(nodeSizes))) nodeSizes[is.na(nodeSizes)] <- 0
nNodes <- length(nodeSizes)
if (length(unique(nodeSizes)) == 1){
return(rep(maxNodeSize, nNodes))
}
scaledNodeSize <- data.frame(size = nodeSizes) %>%
dplyr::mutate(scaled = (.data$size / refNodeSize) * maxNodeSize ^ 2) %>%
dplyr::mutate(sqrt_scaled = sqrt(.data$scaled)) %>%
dplyr::pull(.data$sqrt_scaled)
return(scaledNodeSize)
}
#' ParseArcs
#'
#' Parses stars
#'
#' Function that parses the FlowSOM object into a dataframe for the star values
#' for ggplot
#'
#' @param x x coordinate of node
#' @param y y coordinate of node
#' @param arcValues A named vector with the frequency of how the node
#' should be divided
#' @param arcHeights The heights of the arcs
#'
#' @return A dataframe ready to use with ggplot, consisting of the coordinates
#' of centers, the radius and angles of the star values
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{ParseEdges}},
#' \code{\link{ParseNodeSize}},
#' \code{\link{ParseQuery}}, \code{\link{ParseSD}}
#'
ParseArcs <- function(x, y, arcValues, arcHeights){
markers <- names(arcValues)
arcValues <- c(0, (arcValues / sum(arcValues)) * (2 * pi))
arcValues <- cumsum(arcValues)
resDf <- data.frame(Markers = markers, x0 = x, y0 = y,
start = arcValues[-length(arcValues)],
end = arcValues[-1], value = arcHeights)
return(resDf)
}
#' ParseQuery
#'
#' Parses query
#'
#' Identify nodes in the tree which resemble a certain profile of "high"
#' or "low" marker expressions.
#'
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}}
#' @param query Array containing "high" or "low" for the specified
#' column names of the FlowSOM data
#'
#' @return A list, containing the ids of the selected nodes, the individual
#' scores for all nodes and the scores for each marker for each node
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{ParseEdges}},
#' \code{\link{ParseNodeSize}}, \code{\link{ParseArcs}},
#' \code{\link{QueryStarPlot}}, \code{\link{ParseSD}}
#'
ParseQuery <- function(fsom, query){
scores <- matrix(NA, ncol = length(query), nrow = nrow(fsom$map$medianValues),
dimnames = list(NULL, names(query)))
for (marker in names(query)) {
data <- fsom$map$medianValues[, marker]
highOrLow <- pmatch(query[marker], c("high", "low"))
if (any(is.na(highOrLow)) | length(highOrLow) > 1){
stop("Only high or low marker expressions are supported at the moment")
} else {
highOrLow <- c("high", "low")[highOrLow]
if (highOrLow == "high") {
scores[, marker] = (max(data, na.rm = TRUE) - data) ^ 2
} else if (highOrLow == "low") {
scores[, marker] = (data - min(data, na.rm = TRUE)) ^ 2
}
}
}
scores <- apply(scores, 2, function(x) {
1 - ((x - min(x, na.rm = TRUE))/ (max(x, na.rm = TRUE) -
min(x, na.rm = TRUE)))
})
nodeScores <- apply(scores, 1, mean)
nodeScores[is.na(nodeScores)] <- 0
cutoff <- max(nodeScores) * 0.95
scoresCutoff <- nodeScores > cutoff
return(list(selected = which(scoresCutoff), nodeScores = nodeScores,
fullScores = scores))
}
#' ParseSD
#'
#' Parses SD in FlowSOM object
#'
#' Calculates the standard deviation of a FlowSOM object
#'
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}}
#' @param marker If a marker is given, the standard deviation for this marker
#' is shown. Otherwise, the maximum ratio is used.
#'
#' @return A vector containing the SDs
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{ParseEdges}},
#' \code{\link{ParseNodeSize}}, \code{\link{ParseArcs}},
#' \code{\link{ParseQuery}}, \code{\link{PlotSD}}
#'
#' @importFrom stats median
#'
ParseSD <-function (fsom, marker = NULL){
stdevs <- fsom$map$sdValues[, fsom$map$colsUsed]
stdev_medians <- apply(stdevs, 2, stats::median)
if (is.null(marker)) {
variable <- apply(stdevs, 1, function(x) {
max(x/stdev_medians)
})
} else {
variable <- stdevs[, marker]/stdev_medians[marker]
}
return(variable)
}
#' ScaleStarHeights
#'
#' Scales starheights
#'
#' Function that scales the star values between 0 and the node size
#'
#' @param data Median values of relevant markers extracted from
#' FlowSOM object
#' @param nodeSizes A vector that is returned from \code{ParseNodeSize}
#'
#' @return A dataframe consisting of the scaled values of the stars.
#' The stars are scaled between 0 and the maximum of all stars
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{ParseNodeSize}},
#' \code{\link{AutoMaxNodeSize}}
#'
ScaleStarHeights <- function(data, nodeSizes){
nNodes <- length(nodeSizes)
maxAllNodes <- max(data)
minAllNodes <- min(data)
for (i in 1:(nNodes)){
maxRowNodeSize <- nodeSizes[i]
scaledRow <- ((data[i, ] - minAllNodes) * maxRowNodeSize) /
(maxAllNodes - minAllNodes)
data[i, ] <- scaledRow
}
return(data)
}
#' AutoMaxNodeSize
#'
#' Calculate node size
#'
#' Function that calculates the minimum distance between the nodes
#' to use this to adapt the maxNodeSize for better plotting
#'
#' @param layout Coordinates of nodes
#' @param overlap Parameter that determines how much overlap there
#' will be. If negative the nodes will be smaller
#'
#' @return Returns the maxNodeSize with some overlap
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{ScaleStarHeights}},
#' \code{\link{ParseNodeSize}}
#'
#' @importFrom stats dist
#'
AutoMaxNodeSize <- function(layout, overlap){
overlap <- 1 + overlap
minDistance <- min(stats::dist(layout[, c(1, 2)]))
return(minDistance / 2 * overlap)
}
#' AddMST
#'
#' Function plots the MST
#'
#' @param p ggplot object
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}}
#'
#' @return Returns nothing, but plots the MST for FlowSOM MST view
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{ParseEdges}},
#' \code{\link{AddStarsPies}}, \code{\link{AddLabels}}, \code{\link{AddNodes}},
#' \code{\link{AddBackground}}, \code{\link{AddPies}}, \code{\link{AddStars}}
#'
#' @import ggplot2
#'
#' @export
AddMST <- function(p,
fsom){
requireNamespace("ggplot2")
fsom <- UpdateFlowSOM(fsom)
edges <- ParseEdges(fsom)
p <- p + ggplot2::geom_segment(data = edges,
ggplot2::aes(x = .data$x,
y = .data$y,
xend = .data$xend,
yend = .data$yend),
linewidth = 0.2)
return(p)
}
#' AddStarsPies
#'
#' Function plots stars or pies
#'
#' @param p ggplot object
#' @param arcs Dataframe that contains all the data for the plotting
#' the pies or stars
#' @param colorPalette A vector of colors or a color function
#' @param showLegend Boolean on whether to show the legend
#'
#' @return Returns nothing, but plots the stars or pies
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{AddLabels}},
#' \code{\link{AddNodes}}, \code{\link{AddBackground}}, \code{\link{AddPies}},
#' \code{\link{AddStars}}, \code{\link{ParseArcs}}, \code{\link{PlotStars}}
#' \code{\link{PlotPies}}
#'
#' @import ggplot2
#' @importFrom ggforce geom_arc_bar
#'
#' @export
AddStarsPies <- function(p, arcs, colorPalette, showLegend = TRUE){
requireNamespace("ggplot2")
p <- AddScale(p = p,
values = arcs$Markers,
colors = colorPalette,
showLegend = showLegend)
p <- p + ggforce::geom_arc_bar(data = arcs,
ggplot2::aes(x0 = .data$x0,
y0 = .data$y0,
r0 = 0,
r = .data$value,
start = .data$start,
end = .data$end,
fill = .data$Markers),
linewidth = 0.2)
return(p)
}
#' AddLabels
#'
#' @param p ggplot object
#' @param labels Labels to be added to each node
#' @param hjust Horizontal adjust for labels. Default is centered.
#' @param layout Dataframe with x and y columns. If null, the dataframe from
#' the ggplot object will be reused.
#' @param textSize Size for geom_text. Default (=3.88) is from geom_text.
#' @param textColor Color for geom_text. Default = black.
#' @param ... Additional parameters to pass to geom_text
#'
#' @return Returns the ggplot object with labels added
#'
#' @seealso \code{\link{PlotLabels}}, \code{\link{PlotNumbers}}
#'
#' @import ggplot2
#'
#' @export
AddLabels <- function(p, labels, hjust = 0.5, layout = NULL,
textSize = 3.88, textColor = "black", ...){
requireNamespace("ggplot2")
if(is.null(layout)) layout <- ggplot2::ggplot_build(p)$plot$data
p <- p + ggplot2::geom_text(data = layout,
ggplot2::aes(x = .data$x,
y = .data$y,
label = labels),
fontface = "bold",
hjust = hjust,
size = textSize,
col = textColor,
...)
return(p)
}
#' AddNodes
#'
#' Function plots the nodes
#'
#' @param p ggplot object
#' @param nodeInfo Dataframe with for every node an x, y and size value,
#' if null the dataframe from the ggplot object will be
#' reused.
#' @param values Values used for coloring the nodes. Default = NULL,
#' in which case all nodes are filled in fillColor.
#' @param lim The limits of the color scale, not used if values = NULL.
#' @param colorPalette Color palette for color in nodes, not used if values =
#' NULL. A vector of colors or a color function.
#' @param fillColor Fixed fill for node colors, default = white.
#' @param showLegend Boolean, default = TRUE.
#' @param label Title for the legend.
#' @param ... Additional arguments to pass to geom_circle
#'
#' @return Returns nothing, but plots the nodes
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{PlotMarker}},
#' \code{\link{PlotVariable}}, \code{\link{AddLabels}},
#' \code{\link{AddBackground}}, \code{\link{AddPies}},
#' \code{\link{AddStars}}, \code{\link{AddStarsPies}}
#'
#' @import ggplot2
#' @importFrom ggplot2 ggplot_build
#' @importFrom ggforce geom_circle
#' @importFrom grDevices colorRampPalette
#'
#' @export
AddNodes <- function(p,
nodeInfo = NULL,
values = NULL,
lim = NULL,
colorPalette = NULL,
fillColor = "white",
showLegend = TRUE,
label = "",
...){
requireNamespace("ggplot2")
if(is.null(nodeInfo)) nodeInfo <- ggplot2::ggplot_build(p)$plot$data
if (is.null(values)){
p <- p + ggforce::geom_circle(data = nodeInfo,
ggplot2::aes(x0 = .data$x,
y0 = .data$y,
r = .data$size),
fill = fillColor,
linewidth = 0.2,
...)
} else {
if(is.character(values) | is.logical(values)) values <- factor(values)
p <- AddScale(p,
values = values,
colors = colorPalette,
limits = lim,
labelLegend = label,
showLegend = showLegend)
p <- p + ggforce::geom_circle(ggplot2::aes(x0 = .data$x,
y0 = .data$y,
r = .data$size,
fill = values),
linewidth = 0.2,
...)
}
return(p)
}
#' AddBackground
#'
#' Function plots the background
#'
#' @param p ggplot object
#' @param backgroundValues Vector of values to be plotted as background for
#' the nodes
#' @param backgroundColors Color palette to be used for the background coloring.
#' Can be either a function or an array specifying
#' colors.
#' @param backgroundLim Background limits (can be used to ensure consistent
#' Color palette between plots). If NULL (default), will
#' be automatically adapted to the data.
#'
#'
#' @return Returns nothing, but plots the background
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{AddLabels}},
#' \code{\link{AddNodes}}, \code{\link{AddPies}}, \code{\link{AddStars}}
#'
#' @import ggplot2
#' @importFrom ggforce geom_circle
#' @importFrom ggnewscale new_scale
#' @importFrom grDevices colorRampPalette
#'
#' @export
AddBackground <- function(p,
backgroundValues,
backgroundColors = NULL,
backgroundLim = NULL){
requireNamespace("ggplot2")
if(is.character(backgroundValues)) {
backgroundValues <- factor(backgroundValues)
}
p <- AddScale(p,
backgroundValues,
backgroundColors,
backgroundLim,
labelLegend = "background")
p <- p + ggforce::geom_circle(ggplot2::aes(x0 = .data$x,
y0 = .data$y,
r = .data$bg_size,
fill = backgroundValues),
col = NA,
alpha = 0.4)
return(p)
}
#' AddScale
#'
#' @param p ggplot object
#' @param values Values used for the fill
#' @param colors Colors to use (can be a vector or a function)
#' @param limits Limits to use in the scale
#' @param showLegend Boolean on whether to show the legend
#' @param labelLegend Label to show as title of the legend
#' @param type fill (default) or color
#'
#' @return ggplot object with scale added
AddScale <- function(p,
values = NULL,
colors = NULL,
limits = NULL,
showLegend = TRUE,
labelLegend = "",
type = "fill"){
p <- p + ggnewscale::new_scale(type)
if(is.character(values) | is.logical(values)) values <- factor(values)
if (!is.null(limits) && is.null(colors)){
args <- list()
args[[type]] <- limits
p <- p + do.call(ggplot2::lims, args)
}
if(!is.null(colors)){
# Discrete values
if (is.factor(values)){
# If a function: make into the right amount of values
if(is.function(colors)){
colors <- colors(nlevels(values))
}
# Check color names vs backgroundValues
colorNames <- names(colors)
levels <- levels(values)
# If no names available, use levels
if(is.null(colorNames)){
colorNames <- levels[seq_along(colors)]
}
# If any names missing, show warning
notAvailable <- ! levels %in% colorNames
if(any(notAvailable)){
warning("You did not provide a color for ",
paste(levels[notAvailable], collapse =", "))
colors <- c(colors,
rep("#FFFFFF", sum(notAvailable)))
names(colors) <- c(colorNames,
levels[notAvailable])
}
scale_function <- eval(parse(text = paste0("ggplot2::scale_",
type,
"_manual")))
if(showLegend) {
p <- p + scale_function(values = colors)
} else {
p <- p + scale_function(values = colors,
guide = "none")
}
} else if (is.numeric(values)){ # Continuous values
if (is.function(colors)){
colors <- colors(100)
} else {
colors <- grDevices::colorRampPalette(colors)(100)
}
scale_function <- eval(parse(text = paste0("ggplot2::scale_",
type,
"_gradientn")))
if(showLegend) {
p <- p + scale_function(colors = colors,
limits = limits)
} else {
p <- p + scale_function(colors = colors,
limits = limits,
guide = "none")
}
}
}
p <- p + ggplot2::labs(fill = labelLegend)
return(p)
}
#' AddPies
#'
#' Function plots the pies
#'
#' @param p ggplot object
#' @param fsom FlowSOM object, as generated by \code{\link{BuildMST}}
#' @param cellLabels Array of factors indicating the cell labels
#' @param layout Coordinates of nodes. Uses dataframe of the ggplot
#' object if NULL.
#' @param colorPalette Color palette to be used for colors. Can be either a
#' function or an array specifying colors.
#'
#' @return ggplot object with the pies added
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{AddLabels}},
#' \code{\link{AddNodes}}, \code{\link{AddBackground}}, \code{\link{PlotPies}},
#' \code{\link{AddStars}}, \code{\link{ParseArcs}}
#'
#' @importFrom grDevices colorRampPalette
#' @importFrom dplyr filter
#'
#' @export
AddPies <- function(p,
fsom,
cellLabels,
layout = NULL,
colorPalette = NULL){
fsom <- UpdateFlowSOM(fsom)
if (is.null(layout)) layout <- ggplot2::ggplot_build(p)$plot$data
if (!is.factor(cellLabels)) cellLabels <- as.factor(cellLabels)
nNodes <- NClusters(fsom)
count <- table(factor(GetClusters(fsom), levels = seq_len(nNodes)),
factor(cellLabels, levels = c(levels(cellLabels), "Empty")))
count[rowSums(count) == 0, "Empty"] <- 1
pieValues <- lapply(seq_len(nNodes), function(cl){
nodeData <- ParseArcs(layout[cl, "x"],
layout[cl, "y"],
count[cl, ],
layout[cl, "size"])
return(nodeData)
})
pieValues <- do.call(rbind, pieValues)
pieValues$Markers <- factor(pieValues$Markers,
levels = c(levels(cellLabels), "Empty"))
p <- AddStarsPies(p, pieValues, colorPalette)
return(p)
}
#' AddStars
#'
#' Function plots the stars
#'
#' @param p ggplot object
#' @param fsom FlowSOM object, as generated by \code{\link{BuildMST}}
#' @param markers Determines which markers to plot.
#' Default = "fsom$map$colsUsed"
#' @param colorPalette Color palette to be used for colors. Can be either a
#' function or an array specifying colors.
#'
#' @return ggplot object with the stars added
#'
#' @seealso \code{\link{PlotFlowSOM}}, \code{\link{AddLabels}},
#' \code{\link{AddNodes}}, \code{\link{AddBackground}}, \code{\link{PlotStars}},
#' \code{\link{AddPies}}, \code{\link{ParseArcs}}
#'
#' @importFrom grDevices colorRampPalette
#'
#' @export
AddStars <- function(p,
fsom,
markers = fsom$map$colsUsed,
colorPalette = NULL){
requireNamespace("ggplot2")
markers <- GetChannels(fsom, markers)
fsom <- UpdateFlowSOM(fsom)
nNodes <- NClusters(fsom)
nMarkers <- length(markers)
isEmpty <- which(fsom$map$pctgs == 0)
nodeInfo <- ggplot2::ggplot_build(p)$plot$data
nodeInfo$size[isEmpty] <- 0
data <- fsom$map$medianValues[, markers, drop = FALSE]
data[is.na(data)] <- 0
data <- ScaleStarHeights(data,
nodeInfo$size)
markers_tmp <- rep(1, ncol(data))
names(markers_tmp) <- colnames(data)
starValues <- lapply(seq_len(nNodes), function(cl){
nodeData <- ParseArcs(x = nodeInfo$x[cl],
y = nodeInfo$y[cl],
arcValues = markers_tmp,
arcHeights = data[cl, ])
return(nodeData)
})
starValues <- do.call(rbind, starValues)
starValues$Markers <- factor(starValues$Markers,
levels = colnames(data))
p <- AddStarsPies(p, starValues, colorPalette, showLegend = FALSE)
return(p)
}
#' gg_color_hue
#'
#' Helper function to get the ggplot colors
#' @param n Number of colors
#'
#' @return array with hexadecimal color values
#'
#' @importFrom grDevices hcl
gg_color_hue <- function(n) {
hues = seq(15, 375, length = n + 1)
hcl(h = hues, l = 65, c = 100)[1:n]
}
#' FlowSOMmary
#'
#' This functions plots a summary of a flowSOM object. It includes a table of
#' (meta)cluster data, the flowSOM trees and grid view, the (meta)cluster
#' labels, the markers expression, the file distribution if present,
#' the cluster per metacluster percentage, a t-SNE plot,
#' and the MFI per metacluster.
#'
#' @param fsom FlowSOM object, as generated by \code{\link{FlowSOM}}
#' @param plotFile Name of the pdf file that will be generated (default is
#' FlowSOMmary.pdf). If \code{NULL}, a list of ggplots will
#' be returned.
#'
#' @return Returns a summary of the FlowSOM object
#'
#'
#' @examples
#' # Identify the files
#' fcs <- flowCore::read.FCS(system.file("extdata", "68983.fcs",
#' package = "FlowSOM"))
#'
#' # Build a FlowSOM object
#' flowSOM.res <- FlowSOM(fcs,
#' scale = TRUE,
#' compensate = TRUE,
#' transform = TRUE,
#' toTransform = 8:18,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' FlowSOMmary(flowSOM.res)
#'
#' @import ggplot2
#' @importFrom ggpubr ggarrange ttheme ggtexttable
#' @importFrom dplyr count mutate group_by filter pull arrange
#' @importFrom grDevices pdf
#'
#' @export
FlowSOMmary <- function(fsom, plotFile = "FlowSOMmary.pdf"){
#----Initializing ----
fsom <- UpdateFlowSOM(fsom)
metaclustersPresent <- !is.null(fsom$metaclustering)
if (metaclustersPresent){
mfis <- GetMetaclusterMFIs(fsom, colsUsed = TRUE)
metaclusters <- GetMetaclusters(fsom)
nMetaclusters <- NMetaclusters(fsom)
}
clusters <- GetClusters(fsom)
nNodes <- seq_len(NClusters(fsom))
filePresent <- "File" %in% colnames(fsom$data)
plotList <- list()
#----Plot fsom trees and grids----
message("Plot FlowSOM trees")
for(view in c("MST", "grid")){
plotList[[paste0("stars_", view)]] <-
PlotStars(fsom, view = view, backgroundValues = fsom$metaclustering,
title = paste0("FlowSOM ", view))
if (metaclustersPresent){
p2.1 <- PlotFlowSOM(fsom, view = view, title = "FlowSOM Clusters",
equalNodeSize = TRUE) %>%
AddNodes(values = fsom$metaclustering,
showLegend = TRUE,
label = "Metaclusters") %>%
AddLabels(labels = seq_len(NClusters(fsom)))
p2.2 <- PlotFlowSOM(fsom, view = view, equalNodeSize = TRUE,
title = "FlowSOM Metaclusters") %>%
AddNodes(values = fsom$metaclustering, showLegend = TRUE,
label = "Metaclusters") %>%
AddLabels(labels = as.numeric(fsom$metaclustering))
} else {
p2.1 <- PlotNumbers(fsom, view = view, title = "FlowSOM Clusters",
maxNodeSize = "auto", equalNodeSize = TRUE)
p2.2 <- NULL
}
plotList[[paste0("labels_",view)]] <-
ggpubr::ggarrange(p2.1, p2.2,
common.legend = TRUE, legend = "right")
}
#----Plot Markers----
plotList[["p5"]] <- PlotMarker(fsom, marker = fsom$map$colsUsed,
refMarkers = fsom$map$colsUsed,
equalNodeSize = TRUE)
#----File distribution----
if (filePresent){
message("Plot file distribution")
file_cols <- fsom$data[,rev(grep("File[0-9]*$", colnames(fsom$data),
value = TRUE)), drop = FALSE]
if(file_cols[1,1] != round(file_cols[1,1])){ # In case of scaled data
file_cols <- apply(file_cols, 2, function(x) as.numeric(factor(x)))
}
file_label <- apply(file_cols, 1, paste, collapse = " ")
p6 <- PlotPies(fsom, cellTypes = factor(file_label),
equalNodeSize = TRUE, view = "grid",
title = "File distribution per cluster",
colorPalette = FlowSOM_colors)
filesI <- as.character(unique(fsom$data[, "File"]))
expectedDistr <- c(table(file_label))
names(expectedDistr) <- filesI
arcsDf <- ParseArcs(0, 0, expectedDistr, 0.7)
arcsDf$Markers <- factor(arcsDf$Markers, levels = filesI)
plotList[["p6"]] <- AddStarsPies(p6, arcsDf, colorPalette = FlowSOM_colors(
length(filesI) + 1), showLegend = FALSE) +
ggplot2::geom_text(ggplot2::aes(x = 0, y = -1,
label = "Expected distribution"))
}
#----t-SNE----
message("Calculate t-SNE")
dimred_res <- PlotDimRed(fsom, cTotal = 5000, colorBy = fsom$map$colsUsed,
seed = 1, returnLayout = TRUE,
title = paste0("t-SNE with markers used in FlowSOM ",
"call (perplexity = 30, cells = 5000)"),
check_duplicates = FALSE)
if (metaclustersPresent){
plotList[["p7"]] <- PlotDimRed(fsom, dimred = dimred_res$layout, seed = 1,
title = paste0("t-SNE with markers used in FlowSOM ",
"call (perplexity = 30, cells = 5000)"))
}
plotList[["p8"]] <- dimred_res$plot
#----Cluster Per Metacluster----
if (metaclustersPresent){
message("Plot cluster per metacluster distribution")
clusterPerMetacluster <- data.frame(metaclusters, clusters) %>%
dplyr::group_by(metaclusters) %>%
dplyr::count(clusters) %>%
dplyr::mutate(Percentage = .data$n / sum(.data$n) * 100) %>%
dplyr::mutate(LabelPos = cumsum(.data$Percentage) - 1) %>%
as.data.frame()
clusterPerMetacluster$clusters <- factor(clusterPerMetacluster$cluster)
plotList[["p9"]] <- ggplot2::ggplot(clusterPerMetacluster,
ggplot2::aes(x = metaclusters)) +
ggplot2::geom_bar(ggplot2::aes(y = .data$Percentage, fill = metaclusters),
stat = "identity", col = "black") +
ggplot2::geom_text(ggplot2::aes(y = .data$LabelPos, label = clusters)) +
ggplot2::theme_minimal() +
ggplot2::theme(panel.grid.major.x = ggplot2::element_blank(),
panel.grid.minor.x = ggplot2::element_blank(),
legend.position = "none") +
ggplot2::ggtitle("Percentages clusters per metacluster")
#----Median expression per metacluster----
message("Plot heatmap")
colnames(mfis) <- fsom$prettyColnames[colnames(mfis)]
rownames(mfis) <- levels(metaclusters)
mfis_scaled <- scale(mfis)
mfis_scaled[is.na(mfis_scaled)] <- 0
plotList[["empty"]] <- ggplot2::ggplot() + ggplot2::theme_minimal()
if (requireNamespace("pheatmap", quietly = TRUE)) {
plotList[["p10"]] <-
pheatmap::pheatmap(mfis_scaled, scale = "none",
display_numbers = round(mfis, 2),
main = "Median expression per metacluster",
silent = TRUE)
} else {
message("Please install \"pheatmap\" to add a heatmap to the FlowSOMmary")
}
}
#----Table----
message("Make tables")
datatable1 <- data.frame("Total number of cells" = nrow(fsom$data),
check.names = FALSE)
rownames(datatable1) <- "FlowSOMmary"
if (metaclustersPresent) {
datatable1[, "Total number of metaclusters"] <- nMetaclusters
}
markersInFlowSOM <- split(fsom$prettyColnames[fsom$map$colsUsed],
rep(seq_len(ceiling(length(fsom$prettyColnames[
fsom$map$colsUsed])/5)),
each = 5)[seq_len(length(fsom$prettyColnames[
fsom$map$colsUsed]))]) %>%
sapply(paste, collapse =", ") %>%
paste(collapse = ",\n")
datatable1 <- cbind(datatable1,
"Total number of clusters" = fsom$map$nNodes,
"Markers used for FlowSOM" = markersInFlowSOM)
datatable1 <- format(datatable1, digits = 2)
t1 <- ggpubr::ggtexttable(t(datatable1), theme = ggpubr::ttheme("minimal"))
if (metaclustersPresent){
freqMetaclusters <- data.frame(metaclusters =
as.character(metaclusters)) %>%
dplyr::count(.data$metaclusters) %>%
dplyr::mutate(percentage = .data$n / sum(.data$n) * 100) %>%
as.data.frame()
datatable2 <- data.frame("Metacluster" = levels(metaclusters),
"Number of cells" = 0,
"Percentage of cells" = 0,
"Number of clusters" = 0,
"Clusters" = "",
check.names = FALSE)
rownames(datatable2) <- datatable2$Metacluster
datatable2[freqMetaclusters[,"metaclusters"], "Number of cells"] <-
freqMetaclusters[,"n"]
datatable2[freqMetaclusters[,"metaclusters"], "Percentage of cells"] <-
freqMetaclusters[,"percentage"]
datatable2[, "Number of clusters"] <-
sapply(levels(metaclusters), function(x){
which(fsom$metaclustering == x) %>% length()})
datatable2[, "Clusters"] <-
sapply(levels(metaclusters), function(x){
cl_selected <- which(fsom$metaclustering == x)
clusters_string <- split(cl_selected,
rep(seq_len(ceiling(length(cl_selected)/25)),
each = 25)[seq_len(length(cl_selected))]) %>%
sapply(paste, collapse =", ") %>%
paste(collapse = ",\n")
return(clusters_string)
})
datatable2 <- format(datatable2, digits = 2)
split_datatable2 <- split(datatable2, rep(seq_len(
ceiling(nrow(datatable2) / 30)), each = 30,
length.out=nrow(datatable2)))
}
freqClusters <- as.data.frame(clusters) %>%
dplyr::count(.data$clusters) %>%
dplyr::mutate(freq = .data$n / sum(.data$n) * 100) %>%
as.data.frame()
datatable3 <- data.frame("Cluster" = factor(nNodes),
"Number of cells" = 0,
"Percentage of cells" = 0,
check.names = FALSE)
datatable3[freqClusters[, "clusters"], "Number of cells"] <-
freqClusters[, "n"]
datatable3[freqClusters[, "clusters"], "Percentage of cells"] <-
freqClusters[, "freq"]
if (metaclustersPresent){
datatable3 <- cbind(datatable3,
"Belongs to metacluster" = fsom$metaclustering,
"Percentage in metacluster" = 0)
datatable3[as.numeric(as.character(clusterPerMetacluster[,"clusters"])),
"Percentage in metacluster"] <-
clusterPerMetacluster[, "Percentage"]
}
datatable3 <- format(datatable3, digits = 2)
split_datatable3 <- split(datatable3, rep(seq_len(
ceiling(nrow(datatable3) / 30)), each = 30,
length.out = nrow(datatable3)))
#----Printing----
message("Printing")
if (!is.null(plotFile)){
grDevices::pdf(plotFile, width = 17, height = 10)
print(t1)
if (metaclustersPresent){
for (table2 in split_datatable2) {
print(ggpubr::ggtexttable(table2, theme = ggpubr::ttheme("minimal"),
rows = NULL))
}
}
for (table3 in split_datatable3){
print(ggpubr::ggtexttable(table3, theme = ggpubr::ttheme("minimal"),
rows = NULL))
}
for (plot in plotList){
print(plot)
}
dev.off()
} else {
return(plotList)
}
}
#' AddAnnotation
#'
#' Add annotation to a FlowSOM plot
#'
#' @param p Plot to add annotation to. When using \code{\link{PlotStars}},
#' please use list_insteadof_ggarrange = TRUE.
#' @param fsom FlowSOM object that goes with the plot.
#' @param toAnnotate A named list with "metaclusters" and/or "clusters" as names
#' and a vector with the (meta)clusters that need to be
#' annotated. Names can be abbreviated. Use a named vector with
#' the old names as values and new labels as names for custom
#' labeling.
#' @param prefix Prefix to be added to labels. Default is "MCL " and "CL " for
#' metaclusters and clusters respectively.
#' @param ... Arguments passed to geom_text_repel.
#'
#' @return The updated plot
#'
#' @examples
#'
#' # Identify the files
#' fcs <- flowCore::read.FCS(system.file("extdata", "68983.fcs",
#' package = "FlowSOM"))
#' # Build a FlowSOM object
#' flowSOM.res <- FlowSOM(fcs,
#' scale = TRUE,
#' compensate = TRUE,
#' transform = TRUE,
#' toTransform = 8:18,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#'
#' p <- PlotStars(flowSOM.res, backgroundValues = flowSOM.res$metaclustering,
#' list_insteadof_ggarrange = TRUE)
#' annotationList <- list("metaclusters" = c("CD8 T cells" = "1", "B cells" = "8"),
#' "clusters" = c(97))
#' AddAnnotation(p, flowSOM.res, toAnnotate = annotationList,
#' prefix = list("metaclusters" = "", clusters = "CL "))
#'
#' @import ggplot2
#' @importFrom dplyr group_by filter slice
#' @importFrom ggpubr ggarrange
#'
#' @export
AddAnnotation <- function(p,
fsom,
toAnnotate = NULL,
prefix = list("metaclusters" = "MCL ", "clusters" = "CL "),
...){
# Initialize
if (is.null(toAnnotate)) stop("Please add a named list to \"toAnnotate\"")
if (is(p, "ggarrange")){
stop(paste0("Please set \"list_insteadof_ggarrange = TRUE\" when using this",
" function in combination with PlotStars"))
}
listOrGGplot <- "tree" %in% names(p)
if (listOrGGplot) {
l1 <- p[["starLegend"]]
l2 <- p [["backgroundLegend"]]
p <- p[["tree"]]
}
abb_toAnnotate <- abb_prefix <- NULL
fsom <- UpdateFlowSOM(fsom)
for (toAnnotate_prefix in c("toAnnotate", "prefix")){
toCheck <- get(toAnnotate_prefix)
abbreviations <- pmatch(names(toCheck), c("clusters", "metaclusters"))
assign(paste0("abb_", toAnnotate_prefix), abbreviations)
if (any(is.na(abbreviations))){
stop(paste0("Please use \"clusters\" and/or \"metaclusters\" or abbrevations",
" as names of the \"", toAnnotate_prefix,"\" list"))
}
}
names(toAnnotate) <- c("clusters", "metaclusters")[abb_toAnnotate]
names(prefix) <- c("clusters", "metaclusters")[abb_prefix]
oldClNames <- toAnnotate$clusters
if (any(!oldClNames %in% seq(NClusters(fsom)))){
stop("Cluster name is not present in the fsom object")
}
oldMclNames <- toAnnotate$metaclusters
layout <- as.data.frame(ggplot2::ggplot_build(p)$plot$data)[, seq(2)]
colnames(layout) <- c("V1", "V2")
clusterLabels <- data.frame(layout,
cl = as.character(seq_len(fsom$map$nNodes)),
metacl = as.character(fsom$metaclustering))
labels <- list()
if (!is.null(oldMclNames)){
metaclusterLabels <- clusterLabels %>%
dplyr::group_by(.data$metacl) %>%
dplyr::slice(1) %>%
as.data.frame() %>%
mutate(label = .data$metacl)
newMCLNames <- names(oldMclNames)
oldMclNames <- match(oldMclNames, metaclusterLabels$metacl)
if (any(is.na(oldMclNames))){
stop("Old metacluster name is not present in the fsom object")
}
if (!is.null(newMCLNames)){
names(oldMclNames) <- newMCLNames
metaclusterLabels$label[oldMclNames] <- newMCLNames
}
metaclusterLabels$label <- paste0(prefix$metaclusters, metaclusterLabels$label)
labels[["metaclusters"]] <- metaclusterLabels[oldMclNames, ]
}
if (!is.null(oldClNames)){
clusterLabels <- clusterLabels %>% mutate(label = .data$cl)
newCLNames <- names(oldClNames)
if (!is.null(newCLNames)){
clusterLabels$label[as.numeric(oldClNames)] <- newCLNames
}
clusterLabels$label <- paste0(prefix$clusters, clusterLabels$label)
labels[["clusters"]] <- clusterLabels[oldClNames, ]
}
labels <- do.call(rbind, labels) %>% as.data.frame()
emptyString <- clusterLabels %>% mutate(label = "")
labels <- rbind(labels, emptyString)
if (requireNamespace("ggrepel", quietly = TRUE)) {
p <- p + ggrepel::geom_text_repel(data = labels,
ggplot2::aes(x = .data$V1, y = .data$V2,
label = .data$label),
segment.color = "gray", force = 20,
segment.size = 0.2, point.padding = 0.5, size = 5,
...)
} else {
p <- p + ggplot2::geom_text(data = labels,
ggplot2::aes(x = .data$V1, y = .data$V2,
label = .data$label), nudge_y = 0.5,
nudge_x = 0.5, ...)
message("Please install \"ggrepel\" for more clear annotation.")
}
if (listOrGGplot){
p <- ggpubr::ggarrange(p, ggpubr::ggarrange(l1, l2, ncol = 1), NULL,
ncol = 3, widths = c(3, 1, 0.3), legend = "none")
}
return(p)
}
#' PlotOutliers
#'
#' Visual overview of outliers
#'
#' @param fsom FlowSOM object.
#' @param outlierReport Outlier overview as generated by TestOutliers()
#'
#' @return Plot
#'
#' @examples
#'
#' # Identify the files
#' fcs <- flowCore::read.FCS(system.file("extdata", "68983.fcs",
#' package = "FlowSOM"))
#' # Build a FlowSOM object
#' flowSOM.res <- FlowSOM(fcs,
#' scale = TRUE,
#' compensate = TRUE,
#' transform = TRUE,
#' toTransform = 8:18,
#' colsToUse = c(9, 12, 14:18),
#' nClus = 10,
#' seed = 1)
#' outlierReport <- TestOutliers(flowSOM.res)
#' p <- PlotOutliers(flowSOM.res, outlierReport)
#'
#' @import ggplot2
#' @importFrom ggpubr ggarrange
#'
#' @export
PlotOutliers <- function(fsom, outlierReport){
xdim <- fsom$map$xdim
ydim <- fsom$map$ydim
plotList <- lapply(seq_len(xdim * ydim), function(i) {
ids <- which(GetClusters(fsom) == i)
values <- fsom$map$mapping[ids, 2]
if (length(values) > 1) {
nOutliers <- sum(values > outlierReport$Threshold[i])
p <- suppressMessages(ggplot2::ggplot() +
ggplot2::geom_histogram(ggplot2::aes(values),
fill = "grey90",
col = "black",
size = 0.2) +
ggplot2::geom_vline(ggplot2::aes(xintercept = outlierReport$Median_distance[i]),
col = "black") +
ggplot2::geom_vline(ggplot2::aes(xintercept = outlierReport$Threshold[i]),
col = "red") +
ggplot2::ggtitle(paste0(i,
" (", nOutliers, ")")) +
ggplot2::theme_minimal() +
ggplot2::theme(axis.title.x = ggplot2::element_blank()) +
ggplot2::ylab("Frequency"))
return(p)
}
})
p <- suppressMessages(ggpubr::ggarrange(plotlist = plotList))
return(p)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.