HelenaLC / CATALYST

Cytometry dATa anALYsis Tools
67 stars 31 forks source link

overlays #310

Closed jysmith6 closed 1 year ago

jysmith6 commented 1 year ago

CyTOF Workflow is wonderful - thank you.

Would it be possible to have code that overlays each sample_id fcs file onto the UMAP? This would be a useful batch effect test.

Many thanks

HelenaLC commented 1 year ago

Do you mean colouring points (= cells) by their sample ID in a 2D scatter plot of UMAP dim. 1 vs. 2? Sorry, I don't understand what you're asking for exactly...

jysmith6 commented 1 year ago

Yes. The UMAP of the concatenated cells would be color 1, then there would be n (number of samples) graphs of the color 1 UMAP overlaid with just one sample in color 2. If there were 10 samples then there would be 10 overlaid UMAPs, one for each sample. Like this (please see enclosure).[image: Helena_UMAP.png]

On Wed, Nov 16, 2022 at 9:12 AM Helena L. Crowell @.***> wrote:

Do you mean colouring points (= cells) by their sample ID in a 2D scatter plot of UMAP dim. 1 vs. 2? Sorry, I don't understand what you're asking for exactly...

— Reply to this email directly, view it on GitHub https://github.com/HelenaLC/CATALYST/issues/310#issuecomment-1317085951, or unsubscribe https://github.com/notifications/unsubscribe-auth/AJX64TFFMWE4QYFYL53EQFTWITTUPANCNFSM6AAAAAASCIXKR4 . You are receiving this because you authored the thread.Message ID: @.***>

-- Jacqueline Y. Smith

HelenaLC commented 1 year ago

I fear this is not possible directly, however, here's a solution creating one plot at a time & wrapping them together with patchwork; this gives CATALYST-style plots:

# load dependencies
library(tidyr)
library(ggplot2)
library(CATALYST)
library(patchwork)

# construct SCE & do dimension reduction
data(PBMC_fs, PBMC_panel, PBMC_md)
sce <- prepData(PBMC_fs, PBMC_panel, PBMC_md)
sce <- runDR(sce, dr = "UMAP", cells = 200)

# get logical cells x samples matrix indicating
# whether or not a cell is from a given sample
names(ids) <- ids <- levels(sce$sample_id)
mtx <- sapply(ids, \(.) sce$sample_id == .)
colData(sce) <- cbind(colData(sce), mtx)

# loop through samples coloring by one at a time
lys <- lapply(ids, \(.) {
  plt <- plotDR(sce, color_by = .) + ggtitle(.) 
  # reorder to place sample ontop
  plt$data <- plt$data[order(plt$data[[.]]), ]
  return(plt)
})

# put panels together with some cleaner aesthetics
wrap_plots(lys, nrow = 2) &
  theme(legend.position = "none") &
  scale_color_manual(values = c("grey", "tomato"))

image

Of course, you could get the same with a combination of tidyr and ggplot2:

# construct tidy-table of metadata & UMAP
df <- data.frame(colData(sce), reducedDim(sce, "UMAP"))
fd <- pivot_longer(df, all_of(ids))

plt <- ggplot(fd, aes(X1, X2, col = value)) +
  facet_wrap(~ name, nrow = 2) +
  geom_point()
# reorder to place sample ontop
plt$data <- plt$data[order(plt$data$value), ]
# basic plot; probably some more aesthetics would help... 
plt +
  theme(legend.position = "none") +
  scale_color_manual(values = c("grey", "tomato"))

image

jysmith6 commented 1 year ago

Thank you so much. You are a much-needed boon to we flow cytometrists who are R novices.

On Thu, Nov 17, 2022 at 1:25 AM Helena L. Crowell @.***> wrote:

I fear this is not possible directly, however, here's a solution creating one plot at a time & wrapping them together with patchwork; this gives CATALYST-style plots:

load dependencies

library(tidyr) library(ggplot2) library(CATALYST) library(patchwork)

construct SCE & do dimension reduction

data(PBMC_fs, PBMC_panel, PBMC_md) sce <- prepData(PBMC_fs, PBMC_panel, PBMC_md) sce <- runDR(sce, dr = "UMAP", cells = 200)

get logical cells x samples matrix indicating

whether or not a cell is from a given sample

names(ids) <- ids <- levels(sce$sample_id) mtx <- sapply(ids, (.) sce$sample_id == .) colData(sce) <- cbind(colData(sce), mtx)

loop through samples coloring by one at a time

lys <- lapply(ids, (.) { plt <- plotDR(sce, color_by = .) + ggtitle(.)

reorder to place sample ontop

plt$data <- plt$data[order(plt$data[[.]]), ] return(plt) })

put panels together with some cleaner aesthetics

wrap_plots(lys, nrow = 2) & theme(legend.position = "none") & scale_color_manual(values = c("grey", "tomato"))

[image: image] https://user-images.githubusercontent.com/14542264/202371773-828e818e-d944-4bf9-b8b9-654c48f4457a.png

Of course, you could get the same with a combination of tidyr and ggplot2:

construct tidy-table of metadata & UMAP

df <- data.frame(colData(sce), reducedDim(sce, "UMAP")) fd <- pivot_longer(df, all_of(ids))

plt <- ggplot(fd, aes(X1, X2, col = value)) + facet_wrap(~ name, nrow = 2) + geom_point()

reorder to place sample ontop

plt$data <- plt$data[order(plt$data$value), ]

basic plot; probably some more aesthetics would help...

plt + theme(legend.position = "none") + scale_color_manual(values = c("grey", "tomato"))

[image: image] https://user-images.githubusercontent.com/14542264/202371942-134e3ee9-5df2-4bd5-92e7-4dcc44b9993c.png

— Reply to this email directly, view it on GitHub https://github.com/HelenaLC/CATALYST/issues/310#issuecomment-1318146819, or unsubscribe https://github.com/notifications/unsubscribe-auth/AJX64TAJ6FEGY5XG3JVNBR3WIXFUFANCNFSM6AAAAAASCIXKR4 . You are receiving this because you authored the thread.Message ID: @.***>

-- Jacqueline Y. Smith

HelenaLC commented 1 year ago

Awe, thanks. No problem, happy & here to help.