├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── LICENCE ├── NAMESPACE ├── NEWS.md ├── R ├── generateMask.R └── mascarade-package.R ├── README.Rmd ├── README.md ├── data-raw └── exampleMascarade.R ├── data └── exampleMascarade.rda ├── inst └── exampleCombinedPlot.R ├── man ├── exampleMascarade.Rd └── generateMask.Rd ├── tests ├── testthat.R └── testthat │ └── test-generateMask.R └── vignettes ├── mascarade-gallery.Rmd └── mascarade-tutorial.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^data-raw$ 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: mascarade 2 | Type: Package 3 | Title: Generating Cluster Masks for Single-Cell Dimensional Reduction Plots 4 | Version: 0.2.1 5 | Authors@R: person("Alexey", "Sergushichev", email = "alsergbox@gmail.com", role = c("aut", "cre")) 6 | Description: This package implements a procedure to automatically generate 2D masks 7 | for clusters on single-cell dimensional reduction plots like t-SNE or UMAP. 8 | Imports: 9 | data.table, 10 | spatstat.geom, 11 | spatstat.explore, 12 | lifecycle 13 | License: MIT + file LICENCE 14 | Encoding: UTF-8 15 | LazyData: true 16 | RoxygenNote: 7.3.2 17 | Depends: 18 | R (>= 2.10) 19 | Suggests: 20 | testthat (>= 3.0.0), 21 | rmarkdown, 22 | knitr, 23 | ggplot2, 24 | ggforce, 25 | patchwork, 26 | Seurat, 27 | SeuratData, 28 | ggnewscale, 29 | ggsci 30 | Config/testthat/edition: 3 31 | VignetteBuilder: knitr 32 | URL: https://github.com/alserglab/mascarade/ 33 | BugReports: https://github.com/alserglab/mascarade/issues 34 | Remotes: satijalab/seurat-data 35 | -------------------------------------------------------------------------------- /LICENCE: -------------------------------------------------------------------------------- 1 | YEAR: 2024 2 | COPYRIGHT HOLDER: Alexey Sergushichev 3 | 4 | Permission is hereby granted, free of charge, to any person obtaining a copy 5 | of this software and associated documentation files (the "Software"), to deal 6 | in the Software without restriction, including without limitation the rights 7 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 8 | copies of the Software, and to permit persons to whom the Software is 9 | furnished to do so, subject to the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included in all 12 | copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 19 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 20 | SOFTWARE. 21 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(generateMask) 4 | import(spatstat.explore) 5 | import(spatstat.geom) 6 | importFrom(data.table,data.table) 7 | importFrom(data.table,rbindlist) 8 | importFrom(data.table,setnames) 9 | importFrom(spatstat.geom,as.polygonal) 10 | importFrom(spatstat.geom,connected) 11 | importFrom(spatstat.geom,tess) 12 | importFrom(spatstat.geom,tiles) 13 | importFrom(utils,head) 14 | importFrom(utils,tail) 15 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # mascarade 0.2.0 2 | 3 | * Major rewrite of generateMask function, with a change of interface 4 | -------------------------------------------------------------------------------- /R/generateMask.R: -------------------------------------------------------------------------------- 1 | expandedRange2d <- function(x, y, fraction=0.05, fixAspectRatio=TRUE) { 2 | xRange <- range(x) 3 | xWidth <- (xRange[2] - xRange[1]) * (1 + fraction) 4 | 5 | yRange <- range(y) 6 | yWidth <- (yRange[2] - yRange[1]) * (1 + fraction) 7 | 8 | if (fixAspectRatio) { 9 | xWidth <- yWidth <- max(xWidth, yWidth) 10 | } 11 | 12 | xCenter <- mean(xRange) 13 | yCenter <- mean(yRange) 14 | 15 | return( 16 | c(xCenter - xWidth/2, xCenter + xWidth/2, 17 | yCenter - yWidth/2, yCenter + yWidth/2)) 18 | } 19 | 20 | makeGridWindow <- function(dims, gridSize, fraction=0.05) { 21 | xyRanges <- apply(dims, 2, range) 22 | 23 | xyWidths <- (xyRanges[2,] - xyRanges[1,]) * (1 + fraction) 24 | 25 | xyCenters <- colMeans(xyRanges) 26 | 27 | gridStep <- sqrt(prod(xyWidths))/gridSize 28 | 29 | # switch yx and xy 30 | xyResolution <- ceiling(xyWidths/gridStep) 31 | 32 | xyWidths <- gridStep*xyResolution 33 | 34 | window <- spatstat.geom::as.mask( 35 | spatstat.geom::owin(xrange = c(xyCenters[1]-xyWidths[1]/2, xyCenters[1]+xyWidths[1]/2), 36 | yrange = c(xyCenters[2]-xyWidths[2]/2, xyCenters[2]+xyWidths[2]/2)), 37 | dimyx=rev(xyResolution)) 38 | } 39 | 40 | #' @importFrom spatstat.geom tiles tess connected as.polygonal 41 | #' @importFrom data.table rbindlist 42 | borderTableFromMask <- function(curMask, curDensity, minSize=10, keepMax=TRUE) { 43 | parts <- tiles(tess(image=connected(curMask))) 44 | 45 | curBorderTable <- list() 46 | 47 | # partSizes <- vapply(parts, function(part) { 48 | # sum(as.matrix(part) * as.matrix(curDensity)) 49 | # }, FUN.VALUE = numeric(1)) 50 | # 51 | # parts <- parts[partSizes >= min(minSize, max(partSizes))] 52 | # 53 | 54 | for (partIdx in seq_along(parts)) { 55 | part <- parts[[partIdx]] 56 | 57 | partBoundary <- as.polygonal(part) 58 | lines <- partBoundary$bdry 59 | 60 | curBorderTable <- c(curBorderTable, lapply(seq_along(lines), function(lineIdx) { 61 | curLine <- lines[[lineIdx]] 62 | xs <- curLine$x 63 | ys <- curLine$y 64 | 65 | # make lines closed 66 | xs <- c(xs, xs[1]) 67 | ys <- c(ys, ys[1]) 68 | 69 | # remove steps 70 | xs <- (head(xs, -1) + tail(xs, -1)) / 2 71 | ys <- (head(ys, -1) + tail(ys, -1)) / 2 72 | 73 | # make lines closed again 74 | xs <- c(xs, xs[1]) 75 | ys <- c(ys, ys[1]) 76 | 77 | res <- data.table(x=xs, y=ys) 78 | res[, part := partIdx] 79 | res[, group := lineIdx] 80 | res[] 81 | })) 82 | } 83 | rbindlist(curBorderTable) 84 | } 85 | 86 | # robust to empty masks 87 | splitWhichMaxLevels <- function(whichMaxDensity, nLevels) { 88 | lapply(seq_len(nLevels), function(i) { 89 | res <- (whichMaxDensity == i) 90 | res[res == 0] <- NA # so that as.owin works as expected 91 | res <- spatstat.geom::as.owin(res) 92 | }) 93 | } 94 | 95 | # TODO window argument shouldn't be really needed 96 | removeMaskIntersections <- function(curMasks, window) { 97 | maskWeights <- lapply(seq_along(curMasks), function(i) { 98 | distmap(complement.owin(curMasks[[i]])) 99 | }) 100 | 101 | backgroundDensityOne <- spatstat.geom::as.im(window) 102 | 103 | # TODO: maybe consider cell densities here somehow 104 | whichMaxDensity <- spatstat.geom::im.apply( 105 | c(list(backgroundDensityOne*0.01), maskWeights), which.max) - 1 106 | 107 | 108 | curMasks <- splitWhichMaxLevels(whichMaxDensity, nLevels=length(curMasks)) 109 | curMasks 110 | } 111 | 112 | getConnectedParts <- function(curMask, curDensity, minSize, absolutelyMinSize=5) { 113 | parts <- tiles(tess(image=connected(curMask))) 114 | partSizes <- vapply(parts, function(part) { 115 | sum(as.matrix(part) * as.matrix(curDensity)) 116 | }, FUN.VALUE = numeric(1)) 117 | 118 | parts <- parts[partSizes >= min(minSize, max(c(partSizes, absolutelyMinSize)))] 119 | unname(parts) 120 | } 121 | 122 | 123 | #' Generate mask for clusters on 2D dimensional reduction plots 124 | #' 125 | #' Internally the function rasterizes and smoothes the density plots. 126 | #' @param dims matrix of point coordinates. 127 | #' Rows are points, columns are dimensions. Only the first two columns are used. 128 | #' @param clusters vector of cluster annotations. 129 | #' Should be the same length as the number of rows in `dims`. 130 | #' @param gridSize target width and height of the raster used internally 131 | #' @param expand distance used to expand borders, represented as a fraction of sqrt(width*height). Default: 1/200. 132 | #' @param minDensity Deprecated. Doesn't do anything. 133 | #' @param smoothSigma Deprecated. Parameter controlling smoothing and joining close cells into groups, represented as a fraction of sqrt(width*height). 134 | #' Increasing this parameter can help dealing with sparse regions. 135 | #' @param kernel Deprecated. Doesn't do anything. 136 | #' @param type Deprecated. Doesn't do anything. 137 | 138 | #' @returns data.table with points representing the mask borders. 139 | #' Each individual border line corresponds to a single level of `group` column. 140 | #' Cluster assignment is in `cluster` column. 141 | #' @importFrom data.table rbindlist data.table setnames 142 | #' @importFrom utils head tail 143 | #' @import spatstat.geom spatstat.explore 144 | #' @export 145 | #' @examples 146 | #' data("exampleMascarade") 147 | #' res <- generateMask(dims=exampleMascarade$dims, 148 | #' clusters=exampleMascarade$clusters) 149 | #' \dontrun{ 150 | #' data <- data.table(exampleMascarade$dims, 151 | #' cluster=exampleMascarade$clusters, 152 | #' exampleMascarade$features) 153 | #' ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 154 | #' geom_point(aes(color=cluster)) + 155 | #' geom_path(data=maskTable, aes(group=group)) + 156 | #' coord_fixed() + 157 | #' theme_classic() 158 | #' } 159 | generateMask <- function(dims, clusters, 160 | gridSize=200, 161 | expand=0.005, 162 | minDensity=lifecycle::deprecated(), 163 | smoothSigma=NA, 164 | minSize=10, 165 | kernel=lifecycle::deprecated(), 166 | type=lifecycle::deprecated()) { 167 | 168 | if (lifecycle::is_present(minDensity)) { 169 | lifecycle::deprecate_warn( 170 | when = "0.2", 171 | what = "generateMask(minDensity)", 172 | details = paste("minDensity is not used anymore.", 173 | "If you need to expand the borders, use `expand` argument instead.") 174 | ) 175 | } 176 | 177 | if (lifecycle::is_present(kernel)) { 178 | lifecycle::deprecate_warn( 179 | when = "0.2", 180 | what = "generateMask(kernel)" 181 | ) 182 | } 183 | 184 | if (lifecycle::is_present(type)) { 185 | lifecycle::deprecate_warn( 186 | when = "0.2", 187 | what = "generateMask(type)", 188 | details = paste("Independent mask generation is not supported anymore", 189 | "Please contact the maintainer if you need this argument to be returned.") 190 | ) 191 | } 192 | 193 | 194 | if (!is.na(smoothSigma)) { 195 | lifecycle::deprecate_soft( 196 | when = "0.2", 197 | what = "generateMask(smoothSigma)", 198 | details = paste("Automatic calculation of smoothSigma should work in most cases.", 199 | "The argument will be fully deprecated, unless an example comes up where it's useful.", 200 | "Please contact the maintainer if you need this argument to be kept.") 201 | ) 202 | } 203 | 204 | clusterLevels <- unique(clusters) 205 | 206 | dims <- dims[, 1:2] 207 | if (is.null(colnames(dims))) { 208 | colnames(dims) <- c("x", "y") 209 | } 210 | 211 | window <- makeGridWindow(dims, gridSize=gridSize) 212 | 213 | pixelSize <- window$xstep 214 | smoothSigma <- smoothSigma * sqrt(area(window)) 215 | expand <- expand * sqrt(area(window)) 216 | windowHD <- makeGridWindow(dims, gridSize=max(gridSize, 1000)) 217 | 218 | 219 | points <- spatstat.geom::ppp(dims[, 1], dims[, 2], window=window) 220 | 221 | 222 | allDensities <- lapply(clusterLevels, function(cluster) { 223 | res <- spatstat.geom::pixellate(points[clusters == cluster], xy=window) 224 | res 225 | }) 226 | 227 | # getting initial masks 228 | curMasks <- lapply(seq_along(clusterLevels), function(i) { 229 | partPoints <- points[clusters == clusterLevels[i]] 230 | 231 | partSigma <- sqrt(bw.nrd(partPoints$x) * bw.nrd(partPoints$y)) * 1.5 232 | if (!is.na(smoothSigma)) { 233 | partSigma <- sqrt(partSigma * smoothSigma) 234 | } 235 | 236 | partMask <- pixellate(partPoints, xy=window) 237 | partMask[partMask == 0] <- NA 238 | partMask <- as.owin(partMask) 239 | partMaskV <- dilation(partMask, r = 2*partSigma + 1.5*pixelSize, polygonal=T) 240 | partMaskV <- erosion(partMaskV, r = 2*partSigma, polygonal=T) 241 | partMask <- as.mask(partMaskV, xy=window) 242 | partMask 243 | }) 244 | 245 | nIter <- 3 246 | 247 | for (iter in seq_len(nIter)) { 248 | allDensitiesSmoothed <- lapply(seq_along(clusterLevels), function(i) { 249 | # message(i) 250 | curMask <- curMasks[[i]] 251 | curDensity <- allDensities[[i]] 252 | 253 | smoothed <- spatstat.geom::as.im(window) * 0 254 | 255 | if (area(curMask) == 0) { 256 | # lost the cluster, don't do anything 257 | return(smoothed) 258 | } 259 | 260 | parts <- getConnectedParts(curMask, curDensity, minSize = minSize) 261 | 262 | curPoints <- points[clusters == clusterLevels[i]] 263 | 264 | 265 | if (iter == nIter) { 266 | # smoothed <- spatstat.geom::as.im(windowHD) * 0 267 | } 268 | 269 | for (part in parts) { 270 | partPoints <- curPoints[part][window] 271 | 272 | partSigma <- sqrt(bw.nrd(partPoints$x) * bw.nrd(partPoints$y)) * 1.5 273 | if (!is.na(smoothSigma)) { 274 | partSigma <- sqrt(partSigma * smoothSigma) 275 | } 276 | 277 | partPoints <- curPoints[dilation(part, r=2*partSigma)][window] 278 | 279 | partMask <- pixellate(partPoints, xy=window) 280 | partMask[partMask == 0] <- NA 281 | partMask <- as.owin(partMask) 282 | partMaskV <- dilation(partMask, r = 2*partSigma + 1.5*pixelSize, polygonal=T) 283 | partMaskV <- erosion(partMaskV, r = 2*partSigma, polygonal=T) 284 | partMask <- as.mask(partMaskV, xy=window) 285 | 286 | partBorder <- setminus.owin( 287 | dilation(partMask, r=pixelSize*0, tight=FALSE), 288 | erosion(partMask, r=pixelSize*1.5, tight=FALSE)) 289 | partBorder <- intersect.owin(partBorder, window) 290 | 291 | partDensity <- density.ppp(partPoints, sigma=partSigma, xy=window) 292 | t <- median(partDensity[partBorder]) 293 | 294 | if (iter == nIter) { 295 | # better but slower way of smoothing borders 296 | # partDensity <- density.ppp(partPoints[windowHD], sigma=partSigma, xy=windowHD) 297 | } 298 | 299 | smoothed <- smoothed + partDensity*(partDensity > t) 300 | } 301 | smoothed 302 | }) 303 | 304 | backgroundDensityOne <- spatstat.geom::as.im(as.owin(allDensitiesSmoothed[[1]])) 305 | 306 | whichMaxDensity <- spatstat.geom::im.apply( 307 | c(list(backgroundDensityOne*0.01), allDensitiesSmoothed), which.max) - 1 308 | 309 | # plot(whichMaxDensity) 310 | 311 | curMasks <- splitWhichMaxLevels(whichMaxDensity, nLevels=length(clusterLevels)) 312 | } 313 | 314 | # smooth borders and expand a little (in vector) 315 | # TODO: important details can be removed here 316 | curMasks <- lapply(curMasks, closing, r=10*pixelSize, polygonal=TRUE) 317 | 318 | curMasks <- lapply(curMasks, dilation, r=expand, polygonal=TRUE) 319 | 320 | # switch to high-res 321 | curMasks <- lapply(curMasks, as.mask, xy = windowHD) 322 | 323 | curMasks <- removeMaskIntersections(curMasks, windowHD) 324 | 325 | borderTable <- rbindlist(lapply(seq_along(clusterLevels), function(i) { 326 | curMask <- curMasks[[i]] 327 | if (area(curMask) == 0) { 328 | warning(sprintf("Mask is empty for cluster %s", clusterLevels[i])) 329 | return(NULL) 330 | } 331 | curTable <- borderTableFromMask(curMask, allDensities[[i]]) 332 | curTable[, cluster := clusterLevels[i]] 333 | curTable[, part := paste0(cluster, "#", part)] 334 | curTable[, group := paste0(part, "#", group)] 335 | curTable[] 336 | })) 337 | 338 | setnames(borderTable, c("x", "y"), colnames(dims)) 339 | 340 | return(borderTable) 341 | } 342 | -------------------------------------------------------------------------------- /R/mascarade-package.R: -------------------------------------------------------------------------------- 1 | #' Example data with UMAP points from PBMC3K dataset. 2 | #' 3 | #' The object is a list with three elements: 4 | #' 1) `dims` -- matrix of UMAP coordinates of the cells, 5 | #' 2) `clusters` -- vector of cell population annotations, 6 | #' 3) `features` -- matrix withgene expression for several genes. 7 | #' 8 | #' @docType data 9 | #' @name exampleMascarade 10 | NULL 11 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | ```{r setup, include=FALSE} 6 | knitr::opts_chunk$set(echo = TRUE) 7 | ``` 8 | 9 | # mascarade 10 | 11 | `mascarade` package implements a procedure to automatically generate 2D masks 12 | for clusters on single-cell dimensional reduction plots like t-SNE or UMAP. 13 | 14 | See the [tutorial](https://rpubs.com/asergushichev/mascarade-tutorial) for usage details 15 | and [gallery](https://rpubs.com/asergushichev/mascarade-gallery) for examples 16 | on different datasets. 17 | 18 | 19 | ## Installation 20 | 21 | The package can be installed from GitHub: 22 | 23 | ```{r eval=FALSE} 24 | remotes::install_github("alserglab/mascarade") 25 | ``` 26 | 27 | ## Quick run 28 | 29 | Loading neccessary libraries: 30 | 31 | ```{r} 32 | library(mascarade) 33 | library(ggplot2) 34 | library(data.table) 35 | ``` 36 | 37 | Loading example data: 38 | 39 | ```{r} 40 | data("exampleMascarade") 41 | ``` 42 | 43 | Generating masks: 44 | 45 | ```{r} 46 | maskTable <- generateMask(dims=exampleMascarade$dims, 47 | clusters=exampleMascarade$clusters) 48 | ``` 49 | 50 | Plotting with `ggplot2`: 51 | 52 | ```{r readme-basic, fig.show="hide"} 53 | data <- data.table(exampleMascarade$dims, 54 | cluster=exampleMascarade$clusters, 55 | exampleMascarade$features) 56 | 57 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 58 | geom_point(aes(color=cluster)) + 59 | geom_path(data=maskTable, aes(group=group)) + 60 | coord_fixed() + 61 | theme_classic() 62 | ``` 63 | 64 | 65 | 66 | Fancy version, showing NGLY gene being specific to NK cells: 67 | 68 | ```{r readme-fancy, fig.show="hide"} 69 | library(ggforce) 70 | library(ggnewscale) 71 | fancyMask <- list( 72 | ggforce::geom_shape(data=maskTable, aes(group=group, color=cluster), 73 | linewidth=1, fill=NA, expand=unit(-1, "pt"), show.legend = FALSE), 74 | ggforce::geom_mark_hull(data=maskTable, fill = NA, aes(group=cluster, color=cluster, label = cluster), 75 | linewidth=0, 76 | radius=0, expand=0, con.cap=0, con.type = "straight", 77 | label.fontsize = 10, label.buffer = unit(0, "cm"), 78 | label.fontface = "plain", 79 | label.minwidth = 0, 80 | label.margin = margin(2, 2, 2, 2, "pt"), 81 | label.lineheight = 0, 82 | con.colour = "inherit", 83 | show.legend = FALSE), 84 | # expanding to give a bit more space for labels 85 | scale_x_continuous(expand = expansion(mult = 0.1)), 86 | scale_y_continuous(expand = expansion(mult = 0.1)) 87 | ) 88 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 89 | geom_point(aes(color=GNLY), size=0.5) + 90 | scale_color_gradient2(low = "#404040", high="red") + 91 | new_scale_color() + 92 | fancyMask + 93 | coord_fixed() + 94 | theme_classic() 95 | ``` 96 | 97 | 98 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | # mascarade 3 | 4 | `mascarade` package implements a procedure to automatically generate 2D 5 | masks for clusters on single-cell dimensional reduction plots like t-SNE 6 | or UMAP. 7 | 8 | See the [tutorial](https://rpubs.com/asergushichev/mascarade-tutorial) 9 | for usage details and 10 | [gallery](https://rpubs.com/asergushichev/mascarade-gallery) for 11 | examples on different datasets. 12 | 13 | ## Installation 14 | 15 | The package can be installed from GitHub: 16 | 17 | ``` r 18 | remotes::install_github("alserglab/mascarade") 19 | ``` 20 | 21 | ## Quick run 22 | 23 | Loading neccessary libraries: 24 | 25 | ``` r 26 | library(mascarade) 27 | library(ggplot2) 28 | library(data.table) 29 | ``` 30 | 31 | Loading example data: 32 | 33 | ``` r 34 | data("exampleMascarade") 35 | ``` 36 | 37 | Generating masks: 38 | 39 | ``` r 40 | maskTable <- generateMask(dims=exampleMascarade$dims, 41 | clusters=exampleMascarade$clusters) 42 | ``` 43 | 44 | Plotting with `ggplot2`: 45 | 46 | ``` r 47 | data <- data.table(exampleMascarade$dims, 48 | cluster=exampleMascarade$clusters, 49 | exampleMascarade$features) 50 | 51 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 52 | geom_point(aes(color=cluster)) + 53 | geom_path(data=maskTable, aes(group=group)) + 54 | coord_fixed() + 55 | theme_classic() 56 | ``` 57 | 58 | 59 | 60 | Fancy version, showing NGLY gene being specific to NK cells: 61 | 62 | ``` r 63 | library(ggforce) 64 | library(ggnewscale) 65 | fancyMask <- list( 66 | ggforce::geom_shape(data=maskTable, aes(group=group, color=cluster), 67 | linewidth=1, fill=NA, expand=unit(-1, "pt"), show.legend = FALSE), 68 | ggforce::geom_mark_hull(data=maskTable, fill = NA, aes(group=cluster, color=cluster, label = cluster), 69 | linewidth=0, 70 | radius=0, expand=0, con.cap=0, con.type = "straight", 71 | label.fontsize = 10, label.buffer = unit(0, "cm"), 72 | label.fontface = "plain", 73 | label.minwidth = 0, 74 | label.margin = margin(2, 2, 2, 2, "pt"), 75 | label.lineheight = 0, 76 | con.colour = "inherit", 77 | show.legend = FALSE), 78 | # expanding to give a bit more space for labels 79 | scale_x_continuous(expand = expansion(mult = 0.1)), 80 | scale_y_continuous(expand = expansion(mult = 0.1)) 81 | ) 82 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 83 | geom_point(aes(color=GNLY), size=0.5) + 84 | scale_color_gradient2(low = "#404040", high="red") + 85 | new_scale_color() + 86 | fancyMask + 87 | coord_fixed() + 88 | theme_classic() 89 | ``` 90 | 91 | 92 | -------------------------------------------------------------------------------- /data-raw/exampleMascarade.R: -------------------------------------------------------------------------------- 1 | ## code to prepare `exampleMascarade` dataset goes here 2 | library(SeuratData) 3 | library(Seurat) 4 | 5 | InstallData("pbmc3k") 6 | LoadData("pbmc3k") 7 | 8 | pbmc3k.final <- Seurat::UpdateSeuratObject(pbmc3k.final) 9 | 10 | featureList <- c("MS4A1", "GNLY", "CD3E", "CD14", "FCER1A", "FCGR3A", "LYZ", "PPBP", 11 | "CD8A") 12 | 13 | exampleMascarade <- list( 14 | dims=Embeddings(pbmc3k.final, "umap"), 15 | clusters=pbmc3k.final$seurat_annotations, 16 | features=t(pbmc3k.final[["RNA"]]@scale.data[featureList, ]) 17 | ) 18 | 19 | usethis::use_data(exampleMascarade, overwrite = TRUE) 20 | -------------------------------------------------------------------------------- /data/exampleMascarade.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/alserglab/mascarade/d364de3d33105df0d16726c5aac0f777cc57ad10/data/exampleMascarade.rda -------------------------------------------------------------------------------- /inst/exampleCombinedPlot.R: -------------------------------------------------------------------------------- 1 | library(data.table) 2 | library(patchwork) 3 | library(ggnewscale) 4 | library(mascarade) 5 | 6 | data <- data.table(exampleMascarade$dims, 7 | cluster=as.factor(exampleMascarade$clusters), 8 | exampleMascarade$features) 9 | 10 | maskTable <- generateMask(dims=exampleMascarade$dims, 11 | clusters=as.factor(exampleMascarade$clusters)) 12 | 13 | 14 | p1 <- ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 15 | geom_point(aes(color=cluster), size=0.25) + 16 | coord_fixed() + 17 | theme_classic() 18 | 19 | p1 20 | 21 | 22 | p2 <- ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 23 | geom_point(aes(color=GNLY), size=0.25) + 24 | scale_color_gradient2(low = "#404040", high="red") + 25 | new_scale_color() + 26 | geom_path(data=maskTable, aes(group=group, color=cluster), linewidth=0.5) + 27 | scale_color_discrete(guide="none") + 28 | coord_fixed() + 29 | theme_classic() 30 | 31 | p <- p1 + p2 32 | p 33 | 34 | ggsave(p, file="combined_plot.png", width=8, height=3) 35 | -------------------------------------------------------------------------------- /man/exampleMascarade.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mascarade-package.R 3 | \docType{data} 4 | \name{exampleMascarade} 5 | \alias{exampleMascarade} 6 | \title{Example data with UMAP points from PBMC3K dataset.} 7 | \description{ 8 | The object is a list with three elements: 9 | 1) `dims` -- matrix of UMAP coordinates of the cells, 10 | 2) `clusters` -- vector of cell population annotations, 11 | 3) `features` -- matrix withgene expression for several genes. 12 | } 13 | -------------------------------------------------------------------------------- /man/generateMask.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generateMask.R 3 | \name{generateMask} 4 | \alias{generateMask} 5 | \title{Generate mask for clusters on 2D dimensional reduction plots} 6 | \usage{ 7 | generateMask( 8 | dims, 9 | clusters, 10 | gridSize = 200, 11 | expand = 0.005, 12 | minDensity = lifecycle::deprecated(), 13 | smoothSigma = NA, 14 | minSize = 10, 15 | kernel = lifecycle::deprecated(), 16 | type = lifecycle::deprecated() 17 | ) 18 | } 19 | \arguments{ 20 | \item{dims}{matrix of point coordinates. 21 | Rows are points, columns are dimensions. Only the first two columns are used.} 22 | 23 | \item{clusters}{vector of cluster annotations. 24 | Should be the same length as the number of rows in `dims`.} 25 | 26 | \item{gridSize}{target width and height of the raster used internally} 27 | 28 | \item{expand}{distance used to expand borders, represented as a fraction of sqrt(width*height). Default: 1/200.} 29 | 30 | \item{minDensity}{Deprecated. Doesn't do anything.} 31 | 32 | \item{smoothSigma}{Deprecated. Parameter controlling smoothing and joining close cells into groups, represented as a fraction of sqrt(width*height). 33 | Increasing this parameter can help dealing with sparse regions.} 34 | 35 | \item{kernel}{Deprecated. Doesn't do anything.} 36 | 37 | \item{type}{Deprecated. Doesn't do anything.} 38 | } 39 | \value{ 40 | data.table with points representing the mask borders. 41 | Each individual border line corresponds to a single level of `group` column. 42 | Cluster assignment is in `cluster` column. 43 | } 44 | \description{ 45 | Internally the function rasterizes and smoothes the density plots. 46 | } 47 | \examples{ 48 | data("exampleMascarade") 49 | res <- generateMask(dims=exampleMascarade$dims, 50 | clusters=exampleMascarade$clusters) 51 | \dontrun{ 52 | data <- data.table(exampleMascarade$dims, 53 | cluster=exampleMascarade$clusters, 54 | exampleMascarade$features) 55 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 56 | geom_point(aes(color=cluster)) + 57 | geom_path(data=maskTable, aes(group=group)) + 58 | coord_fixed() + 59 | theme_classic() 60 | } 61 | } 62 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | # This file is part of the standard setup for testthat. 2 | # It is recommended that you do not modify it. 3 | # 4 | # Where should you do additional test configuration? 5 | # Learn more about the roles of various files in: 6 | # * https://r-pkgs.org/testing-design.html#sec-tests-files-overview 7 | # * https://testthat.r-lib.org/articles/special-files.html 8 | 9 | library(testthat) 10 | library(mascarade) 11 | 12 | test_check("mascarade") 13 | -------------------------------------------------------------------------------- /tests/testthat/test-generateMask.R: -------------------------------------------------------------------------------- 1 | test_that("generateMask works on example data", { 2 | data("exampleMascarade") 3 | res <- generateMask(dims=exampleMascarade$dims, 4 | clusters=exampleMascarade$clusters) 5 | expect_true(!is.null(res)) 6 | }) 7 | -------------------------------------------------------------------------------- /vignettes/mascarade-gallery.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Gallery of mascarade-generaded masks" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Using mascarade package} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | knitr::opts_chunk$set(echo = TRUE, fig.width = 7, fig.height=5) 12 | knitr::opts_knit$set(root.dir = rprojroot::find_rstudio_root_file()) 13 | ``` 14 | 15 | ### Loading necessary libraries 16 | 17 | ```{r} 18 | library(mascarade) 19 | library(data.table) 20 | library(ggplot2) 21 | library(ggsci) 22 | ``` 23 | 24 | 25 | ### PBMC-3K UMAP 26 | 27 | ```{r} 28 | example <- readRDS(url("https://alserglab.wustl.edu/files/mascarade/examples/pbmc3k_umap.rds")) 29 | data <- data.table(example$dims, 30 | cluster=example$clusters) 31 | 32 | maskTable <- generateMask(dims=example$dims, 33 | clusters=example$clusters) 34 | 35 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 36 | geom_point(aes(color=cluster)) + 37 | geom_path(data=maskTable, aes(group=group)) + 38 | coord_fixed() + 39 | theme_classic() 40 | 41 | ``` 42 | 43 | ### PBMC-3K t-SNE 44 | 45 | ```{r} 46 | example <- readRDS(url("https://alserglab.wustl.edu/files/mascarade/examples/pbmc3k_tsne.rds")) 47 | data <- data.table(example$dims, 48 | cluster=example$clusters) 49 | 50 | maskTable <- generateMask(dims=example$dims, 51 | clusters=example$clusters) 52 | 53 | ggplot(data, aes(x=tSNE_1, y=tSNE_2)) + 54 | geom_point(aes(color=cluster)) + 55 | geom_path(data=maskTable, aes(group=group)) + 56 | coord_fixed() + 57 | theme_classic() 58 | 59 | ``` 60 | 61 | ### Aya 62 | 63 | ```{r} 64 | example <- readRDS(url("https://alserglab.wustl.edu/files/mascarade/examples/aya.rds")) 65 | data <- data.table(example$dims, 66 | cluster=example$clusters) 67 | 68 | maskTable <- generateMask(dims=example$dims, 69 | clusters=example$clusters) 70 | 71 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 72 | geom_point(aes(color=cluster), size=0.5) + 73 | geom_path(data=maskTable, aes(group=group)) + 74 | coord_fixed() + 75 | theme_classic() 76 | 77 | ``` 78 | 79 | ### Chia-Jung 80 | 81 | ```{r} 82 | example <- readRDS(url("https://alserglab.wustl.edu/files/mascarade/examples/chiajung1.rds")) 83 | data <- data.table(example$dims, 84 | cluster=example$clusters) 85 | 86 | maskTable <- generateMask(dims=example$dims, 87 | clusters=example$clusters) 88 | 89 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 90 | geom_point(aes(color=cluster), size=0.1) + 91 | scale_color_ucscgb() + 92 | geom_path(data=maskTable, aes(group=group)) + 93 | coord_fixed() + 94 | theme_classic() 95 | 96 | ``` 97 | 98 | ```{r} 99 | example <- readRDS(url("https://alserglab.wustl.edu/files/mascarade/examples/chiajung2.rds")) 100 | data <- data.table(example$dims, 101 | cluster=example$clusters) 102 | 103 | maskTable <- generateMask(dims=example$dims, 104 | clusters=example$clusters) 105 | 106 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 107 | geom_point(aes(color=cluster)) + 108 | geom_path(data=maskTable, aes(group=group)) + 109 | coord_fixed() + 110 | theme_classic() 111 | 112 | ``` 113 | 114 | ### Session info 115 | 116 | ```{r} 117 | sessionInfo() 118 | ``` 119 | -------------------------------------------------------------------------------- /vignettes/mascarade-tutorial.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Using mascarade package" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Using mascarade package} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r setup, include=FALSE} 11 | knitr::opts_chunk$set(echo = TRUE, fig.width = 7, fig.height=5) 12 | ``` 13 | 14 | This is a vignette describing usage of `mascarade` to generate masks for clusters 15 | on 2D dimensional reduction plots like UMAP or t-SNE. 16 | 17 | ### Package installation 18 | 19 | The package can be installed from GitHub: 20 | 21 | ```{r eval=FALSE} 22 | remotes::install_github("alserglab/mascarade") 23 | ``` 24 | 25 | ### Loading necessary libraries 26 | 27 | ```{r} 28 | library(mascarade) 29 | library(data.table) 30 | library(ggplot2) 31 | library(ggforce) 32 | ``` 33 | 34 | ### Example run 35 | 36 | Loading example data from PBMC 3K processed with Seurat (see below for more details). 37 | 38 | ```{r} 39 | data("exampleMascarade") 40 | ``` 41 | 42 | UMAP coordinates: 43 | 44 | ```{r} 45 | head(exampleMascarade$dims) 46 | ``` 47 | 48 | Cluster annotations: 49 | ```{r} 50 | head(exampleMascarade$clusters) 51 | ``` 52 | 53 | Expression table for several genes: 54 | ```{r} 55 | head(exampleMascarade$features) 56 | ``` 57 | 58 | Let's plot this data: 59 | 60 | ```{r} 61 | data <- data.table(exampleMascarade$dims, 62 | cluster=exampleMascarade$clusters, 63 | exampleMascarade$features) 64 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 65 | geom_point(aes(color=cluster)) + 66 | coord_fixed() + 67 | theme_classic() 68 | 69 | ``` 70 | 71 | Now let's generate cluster masks: 72 | 73 | ```{r} 74 | maskTable <- generateMask(dims=exampleMascarade$dims, 75 | clusters=exampleMascarade$clusters) 76 | ``` 77 | 78 | The `maskTable` is actually a table of cluster borders. 79 | A single cluster can have multiple connected parts, and 80 | one a single part can contain multiple border lines (groups). 81 | 82 | ```{r} 83 | head(maskTable) 84 | ``` 85 | 86 | Now we can use this table to draw the borders with `geom_path` (`group` column should be used as the group aesthetics): 87 | 88 | ```{r} 89 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 90 | geom_point(aes(color=cluster)) + 91 | geom_path(data=maskTable, aes(group=group)) + 92 | coord_fixed() + 93 | theme_classic() 94 | ``` 95 | 96 | Or we can color the borders instead of points: 97 | 98 | ```{r} 99 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 100 | geom_point(color="grey") + 101 | geom_path(data=maskTable, aes(group=group, color=cluster), linewidth=1) + 102 | coord_fixed() + 103 | theme_classic() 104 | ``` 105 | 106 | We can use `ggforce` package to make the borders touch instead of overlap: 107 | 108 | ```{r} 109 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 110 | geom_point(color="grey") + 111 | ggforce::geom_shape(data=maskTable, aes(group=group, color=cluster), 112 | linewidth=1, fill=NA, expand=unit(-1, "pt")) + 113 | coord_fixed() + 114 | theme_classic() 115 | ``` 116 | 117 | In the presence of small clusters it can help to expand the borders a bit further 118 | away from the points. 119 | 120 | ```{r} 121 | maskTable <- generateMask(dims=exampleMascarade$dims, 122 | clusters=exampleMascarade$clusters, 123 | expand=0.02) 124 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 125 | geom_point(color="grey") + 126 | ggforce::geom_shape(data=maskTable, aes(group=group, color=cluster), 127 | linewidth=1, fill=NA, expand=unit(-1, "pt")) + 128 | coord_fixed() + 129 | theme_classic() 130 | ``` 131 | 132 | With the help of `ggforce` we can also put the labels within the plot itself. 133 | For the best results use `ggforce` version from https://github.com/assaron/ggforce/tree/remove-offset. 134 | 135 | ```{r} 136 | fancyMask <- list( 137 | ggforce::geom_shape(data=maskTable, aes(group=group, color=cluster), 138 | linewidth=1, fill=NA, expand=unit(-1, "pt"), show.legend = FALSE), 139 | ggforce::geom_mark_hull(data=maskTable, fill = NA, aes(group=cluster, color=cluster, label = cluster), 140 | linewidth=0, 141 | radius=0, expand=0, con.cap=0, con.type = "straight", 142 | label.fontsize = 10, label.buffer = unit(0, "cm"), 143 | label.fontface = "plain", 144 | label.minwidth = 0, 145 | label.margin = margin(2, 2, 2, 2, "pt"), 146 | label.lineheight = 0, 147 | con.colour = "inherit", 148 | show.legend = FALSE), 149 | # expanding to give a bit more space for labels 150 | scale_x_continuous(expand = expansion(mult = 0.1)), 151 | scale_y_continuous(expand = expansion(mult = 0.1)) 152 | ) 153 | 154 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 155 | geom_point(color="grey") + 156 | fancyMask + 157 | coord_fixed() + 158 | theme_classic() 159 | ``` 160 | 161 | Now we can easily show association between cell types and 162 | expression of particular genes, such as GNLY being a good marker 163 | for NK cells in this dataset. 164 | 165 | ```{r} 166 | library(ggnewscale) # for having two color scales simultaneously 167 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 168 | geom_point(aes(color=GNLY), size=0.5) + 169 | scale_color_gradient2(low = "#404040", high="red") + 170 | new_scale_color() + 171 | fancyMask + 172 | coord_fixed() + 173 | theme_classic() 174 | ``` 175 | 176 | We can focus on a single cluster too: 177 | 178 | ```{r} 179 | ggplot(data, aes(x=UMAP_1, y=UMAP_2)) + 180 | geom_point(aes(color=GNLY), size=0.5) + 181 | scale_color_gradient2(low = "#404040", high="red") + 182 | geom_path(data=maskTable[cluster=="NK"], aes(group=group)) + 183 | coord_fixed() + 184 | theme_classic() 185 | ``` 186 | 187 | 188 | ### Working with Seurat 189 | 190 | For this part of the vignette you need `Seurat` and `SeuratData` packages (the latter can be installed with `remotes::install_github('satijalab/seurat-data')`). 191 | 192 | Loading the example dataset: 193 | 194 | ```{r message=FALSE, warning=FALSE} 195 | library(Seurat) 196 | library(SeuratData) 197 | InstallData("pbmc3k") 198 | LoadData("pbmc3k") 199 | 200 | pbmc3k.final <- Seurat::UpdateSeuratObject(pbmc3k.final) 201 | ``` 202 | 203 | Let's plot some features: 204 | ```{r} 205 | featureList <- c("MS4A1", "GNLY", "CD3E", "CD14") 206 | FeaturePlot(pbmc3k.final, features=featureList) 207 | ``` 208 | 209 | Generate masks from UMAP data: 210 | 211 | ```{r} 212 | maskTable <- generateMask( 213 | dims=Embeddings(pbmc3k.final, "umap"), 214 | clusters=pbmc3k.final$seurat_annotations) 215 | ``` 216 | 217 | Now we can plot the same features with borders (there will be some warnings due to the scale change): 218 | 219 | ```{r message=FALSE, warning=FALSE} 220 | plots <- FeaturePlot(pbmc3k.final, features=featureList, combine = FALSE) 221 | 222 | plots <- lapply(plots, `+`, 223 | list( 224 | geom_path(data=maskTable, aes(x=UMAP_1, y=UMAP_2, group=group)), 225 | # so that borders aren't cropped: 226 | scale_x_continuous(expand = expansion(mult = 0.05)), 227 | scale_y_continuous(expand = expansion(mult = 0.05))) 228 | ) 229 | 230 | patchwork::wrap_plots(plots) 231 | ``` 232 | 233 | Works with t-SNE too: 234 | 235 | ```{r message=FALSE, warning=FALSE} 236 | pbmc3k.final <- RunTSNE(pbmc3k.final) 237 | 238 | maskTable <- generateMask( 239 | dims=Embeddings(pbmc3k.final, "tsne"), 240 | clusters=pbmc3k.final$seurat_annotations) 241 | 242 | plots <- FeaturePlot(pbmc3k.final, features=featureList, combine = FALSE, reduction = "tsne") 243 | 244 | plots <- lapply(plots, `+`, 245 | list( 246 | geom_path(data=maskTable, aes(x=tSNE_1, y=tSNE_2, group=group)), 247 | # so that borders aren't cropped: 248 | scale_x_continuous(expand = expansion(mult = 0.05)), 249 | scale_y_continuous(expand = expansion(mult = 0.05))) 250 | ) 251 | 252 | patchwork::wrap_plots(plots) 253 | ``` 254 | 255 | ### Session info 256 | 257 | ```{r} 258 | sessionInfo() 259 | ``` 260 | --------------------------------------------------------------------------------