In KChen-lab/CytoSpill: de novo CyTOF compensation
Analysis of mouse bone marrow data.
library(CytoSpill)
library(flowCore)
library(ggplot2)
library(Rtsne)
library(dplyr)
library(RColorBrewer)
library(reshape2)
library(Rphenograph)
read data
#read expression
data_Samusik <- flowCore::exprs(flowCore::read.FCS("/Users/qmiao/CytoSpill copy/data/Samusik_01_notransform.fcs", transformation = FALSE, truncate_max_range = FALSE))
#remove negative values if any
data_Samusik[which(data_Samusik<0)] <- 0
#load metals used for each channel
load("/Users/qmiao/CytoSpill copy/data/Samusik_colnames_population.Rdata")
col_names
levels(population)
Samusik_marker <- colnames(data_Samusik)
names(Samusik_marker)[1:51] <- col_names
colnames(data_Samusik)[1:51] <- col_names
select channels used for compensation and analysis
data_Samusik_temp <- data_Samusik[,9:47]
#remove duplicates
duplicates_id <- duplicated(data_Samusik_temp)
data_Samusik_temp <- data_Samusik_temp[!duplicates_id,]
use CytoSpill for compensation
#step by step code for detail investigation.
spillmat_results <- GetSpillMat(data = data_Samusik_temp, cols = 1:39, n = 20000, threshold = 0.1, flexrep = 5, neighbor = 1)
data <- data_Samusik_temp
cols <- 1:39
spillmat <- spillmat_results[[1]]
cutoffs <- spillmat_results[[2]]
data_compensated <- t(apply(data[,cols], 1, function(row) nnls::nnls(t(spillmat), row)$x))
data_colnames <- colnames(data)
data[,cols] <- data_compensated
colnames(data) <- data_colnames
compensated_Samusik <- flowFrame(data)
add back population label
##compensated exprs
compensated_Samusik_exprs <- as.data.frame(flowCore::exprs(compensated_Samusik))
compensated_Samusik_exprs[,"label"] <- as.factor(data_Samusik[,"label"][!duplicates_id])
##uncompensated exprs
data_Samusik_temp <- as.data.frame(data_Samusik_temp)
data_Samusik_temp[,"label"] <- as.factor(data_Samusik[,"label"][!duplicates_id])
downsample
# downsample for faster calculation, plotting
nsample = 20000
# subsample
set.seed(123)
rowsample <- sample(nrow(data_Samusik_temp), nsample)
compensated_Samusik_exprs_downsample <- compensated_Samusik_exprs[rowsample,]
data_Samusik_temp_downsample <- data_Samusik_temp[rowsample,]
#function to censor data, for clear heatmap
censor_dat <- function (x, a = 0.99){
q = quantile(x, a)
x[x > q] = q
return(x)
}
#function for arcsinh transform
transf <- function (x){asinh(x/5)}
Run Rphenograph
calculate_pheno <- function (data, cols, asinhtransfer = T){
if (asinhtransfer <- T) {
data[,cols] <- transf(data[,cols])
}
pheno_out <- Rphenograph::Rphenograph(data[,cols])
cluster <- igraph::membership(pheno_out[[2]])
return(cluster)
}
uncompensated_pheno <- calculate_pheno(data_Samusik_temp_downsample, cols = 1:39)
compensated_pheno <- calculate_pheno(compensated_Samusik_exprs_downsample, cols = 1:39)
calculate tsne maps on uncompensated data
calculate_tsne <- function (data, cols, asinhtransfer = T, verbose = T, dims = 2, seed = 123){
set.seed(seed)
tsne_dat <- data[,cols]
#asinh/5 transfer
if (asinhtransfer) {tsne_dat <- transf(tsne_dat)}
tsne_out <- Rtsne::Rtsne(tsne_dat, verbose = verbose, dims = dims)
return(tsne_out)
}
#calculate based on uncompensated data
uncompensated_tsne = calculate_tsne(data_Samusik_temp_downsample, cols = 1:39)
# Setup some colors for plotting
qual_col_pals = brewer.pal.info[brewer.pal.info$category == 'qual',]
col_vector = unlist(mapply(brewer.pal, qual_col_pals$maxcolors, rownames(qual_col_pals)))
plot population label on uncompensated tsne
levels(data_Samusik_temp_downsample$label) <- c(levels(population), "NA")
tclust = data_Samusik_temp_downsample[,"label"]
# nonNA <- !(data_Samusik_temp_downsample[,"label"]=="NA")
tsne_coor <- uncompensated_tsne$Y
colnames(tsne_coor) <- c("tsne_1", "tsne_2")
col_list <- c("#DC050C", "#FB8072", "#1965B0", "#7BAFDE", "#882E72",
"#B17BA6", "#FF7F00", "#FDB462", "#E7298A", "#E78AC3",
"#33A02C", "#B2DF8A", "#55A1B1", "#8DD3C7", "#A6761D",
"#E6AB02", "#7570B3", "#BEAED4", "#666666", "#999999",
"#aa8282", "#d4b7b7", "#8600bf", "gray80",
"#aeae5c", "#1e90ff", "#00bfff", "#56ff0d", "#ffff00")
p = ggplot(as.data.frame(tsne_coor), aes(x=tsne_1, y=tsne_2))+
geom_point(size=0.3, alpha=0.8, aes(color=as.factor(tclust)))+
scale_color_manual(values = col_list, name = "cell type")+
ggtitle('Samusik uncompensated data tsne')+
guides(color=guide_legend(override.aes=list(size=5)))+
theme(strip.background = element_blank(),
panel.background=element_rect(fill='white', colour = 'black'),
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.background=element_blank(),
legend.key = element_blank())
p
plot Rphenograhp cluster on uncompensated tsne
tclust = uncompensated_pheno
tsne_coor <- uncompensated_tsne$Y
colnames(tsne_coor) <- c("tsne_1", "tsne_2")
col_list <- c("#DC050C", "#FB8072", "#1965B0", "#7BAFDE", "#882E72",
"#B17BA6", "#FF7F00", "#FDB462", "#E7298A", "#E78AC3",
"#33A02C", "#B2DF8A", "#55A1B1", "#8DD3C7", "#A6761D",
"#E6AB02", "#7570B3", "#BEAED4", "#666666", "#999999",
"#aa8282", "#d4b7b7", "#8600bf", "#ba5ce3", "#808000",
"#aeae5c", "#1e90ff", "#00bfff", "#56ff0d", "#ffff00")
p = ggplot(as.data.frame(tsne_coor), aes(x=tsne_1, y=tsne_2))+
geom_point(size=0.3, alpha=0.8, aes(color=as.factor(tclust)))+
scale_color_manual(values = col_list, name = "Phenograph cluster")+
ggtitle('Samusik uncompensated data tsne with Phenograph clusters')+
guides(color=guide_legend(override.aes=list(size=5),ncol=2))+
theme(strip.background = element_blank(),
panel.background=element_rect(fill='white', colour = 'black'),
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.background=element_blank(),
legend.key = element_blank())
p
calculate tsne on compensated data
compensated_tsne = calculate_tsne(compensated_Samusik_exprs_downsample, cols = 1:39)
plot population on compensated tsne
levels(compensated_Samusik_exprs_downsample$label) <- c(levels(population), "NA")
tclust = compensated_Samusik_exprs_downsample[,"label"]
# nonNA <- !(compensated_Samusik_exprs_downsample[,"label"]=="NA")
tsne_coor <- compensated_tsne$Y
colnames(tsne_coor) <- c("tsne_1", "tsne_2")
col_list <- c("#DC050C", "#FB8072", "#1965B0", "#7BAFDE", "#882E72",
"#B17BA6", "#FF7F00", "#FDB462", "#E7298A", "#E78AC3",
"#33A02C", "#B2DF8A", "#55A1B1", "#8DD3C7", "#A6761D",
"#E6AB02", "#7570B3", "#BEAED4", "#666666", "#999999",
"#aa8282", "#d4b7b7", "#8600bf", "gray80",
"#aeae5c", "#1e90ff", "#00bfff", "#56ff0d", "#ffff00")
p = ggplot(as.data.frame(tsne_coor), aes(x=tsne_1, y=tsne_2))+
geom_point(size=0.3, alpha=0.8, aes(color=as.factor(tclust)))+
scale_color_manual(values = col_list, name = "cell type")+
ggtitle('Samusik compensated data tsne')+
guides(color=guide_legend(override.aes=list(size=5)))+
theme(strip.background = element_blank(),
panel.background=element_rect(fill='white', colour = 'black'),
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.background=element_blank(),
legend.key = element_blank())
p
plot Rphenograhp cluster on compensated tsne
tclust = compensated_pheno
tsne_coor <- compensated_tsne$Y
colnames(tsne_coor) <- c("tsne_1", "tsne_2")
col_list <- c("#DC050C", "#FB8072", "#1965B0", "#7BAFDE", "#882E72",
"#B17BA6", "#FF7F00", "#FDB462", "#E7298A", "#E78AC3",
"#33A02C", "#B2DF8A", "#55A1B1", "#8DD3C7", "#A6761D",
"#E6AB02", "#7570B3", "#BEAED4", "#666666", "#999999",
"#aa8282", "#d4b7b7", "#8600bf", "#ba5ce3", "#808000",
"#aeae5c", "#1e90ff", "#00bfff", "#56ff0d", "#ffff00")
p = ggplot(as.data.frame(tsne_coor), aes(x=tsne_1, y=tsne_2))+
geom_point(size=0.3, alpha=0.8, aes(color=as.factor(tclust)))+
scale_color_manual(values = col_list, name = "Phenograph cluster")+
ggtitle('Samusik compensated data tsne with Phenograph clusters')+
guides(color=guide_legend(override.aes=list(size=5),ncol=2))+
theme(strip.background = element_blank(),
panel.background=element_rect(fill='white', colour = 'black'),
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.background=element_blank(),
legend.key = element_blank())
p
uncompensated marker density plots
the following plots the asinh(x/5) transformed intensities were normalized between 0-1 by using the 0.99 percentile of the data.
pdat <- transf(data_Samusik_temp_downsample[,-40])
censor_pdat <- apply(pdat, 2, censor_dat)
#normalize 0-1
censor_pdat <- apply(censor_pdat, MARGIN = 2, FUN = function(X) (X - min(X))/diff(range(X)))
### add colnames
for (i in seq_along(Samusik_marker)){
names(Samusik_marker)[i] <- paste(names(Samusik_marker)[i], Samusik_marker[i], sep ='-')
}
dimnames(censor_pdat)[[2]] <- names(Samusik_marker[9:47])
censor_pdat <- as.data.frame(censor_pdat)
censor_pdat$tsne_1 <- uncompensated_tsne$Y[,1]
censor_pdat$tsne_2 <- uncompensated_tsne$Y[,2]
pdat_melt <- reshape2::melt(censor_pdat, id.vars = c("tsne_1","tsne_2"), variable.name = "channel")
p = ggplot(pdat_melt, aes(x=tsne_1, y=tsne_2, color=value))+
facet_wrap(~channel, scales = "free", ncol = 8)+
geom_point(alpha=0.5, size=0.3)+
scale_color_gradientn(colours=rev(brewer.pal(11, 'Spectral')), name='Counts', limits=c(0, 1))+
ggtitle("Uncomepensated Samusik markers")+
theme(strip.background = element_blank(),
strip.text.x = element_text(size = 11),
axis.line=element_blank(),
axis.text.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks=element_blank(),
axis.title.x=element_blank(),
axis.title.y=element_blank(),
panel.background=element_blank(),
panel.border=element_blank(),
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.background=element_blank())
p
#ggsave(filename = "/Users/qmiao/CytoSpill copy/scripts/plot/Samusik_uncompensated_marker.png", plot = p,width=15, height=6, dpi = 300)
compensatd marker density plot
pdat <- transf(compensated_Samusik_exprs_downsample[,-40])
censor_pdat <- apply(pdat, 2, censor_dat)
censor_pdat <- apply(censor_pdat, MARGIN = 2, FUN = function(X) (X - min(X))/diff(range(X)))
dimnames(censor_pdat)[[2]] <- names(Samusik_marker[9:47])
censor_pdat <- as.data.frame(censor_pdat)
censor_pdat$tsne_1 <- uncompensated_tsne$Y[,1]
censor_pdat$tsne_2 <- uncompensated_tsne$Y[,2]
pdat_melt <- reshape2::melt(censor_pdat, id.vars = c("tsne_1","tsne_2"), variable.name = "channel")
p = ggplot(pdat_melt, aes(x=tsne_1, y=tsne_2, color=value))+
facet_wrap(~channel, scales = "free", ncol = 8)+
geom_point(alpha=0.5, size=0.3)+
scale_color_gradientn(colours=rev(brewer.pal(11, 'Spectral')), name='Counts', limits=c(0, 1))+
ggtitle("Compensated Samusik markers")+
theme(strip.background = element_blank(),
strip.text.x = element_text(size = 11),
axis.line=element_blank(),
axis.text.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks=element_blank(),
axis.title.x=element_blank(),
axis.title.y=element_blank(),
panel.background=element_blank(),
panel.border=element_blank(),
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.background=element_blank())
p
#ggsave(filename = "/Users/qmiao/CytoSpill copy/scripts/plot/Samusik_compensated_marker.png", plot = p,width=15, height=6, dpi = 300)
compensatd marker density plot on compensated tsne
pdat <- transf(compensated_Samusik_exprs_downsample[,-40])
censor_pdat <- apply(pdat, 2, censor_dat)
censor_pdat <- apply(censor_pdat, MARGIN = 2, FUN = function(X) (X - min(X))/diff(range(X)))
dimnames(censor_pdat)[[2]] <- names(Samusik_marker[9:47])
censor_pdat <- as.data.frame(censor_pdat)
censor_pdat$tsne_1 <- compensated_tsne$Y[,1]
censor_pdat$tsne_2 <- compensated_tsne$Y[,2]
pdat_melt <- reshape2::melt(censor_pdat, id.vars = c("tsne_1","tsne_2"), variable.name = "channel")
p = ggplot(pdat_melt, aes(x=tsne_1, y=tsne_2, color=value))+
facet_wrap(~channel, scales = "free", ncol = 8)+
geom_point(alpha=0.5, size=0.3)+
scale_color_gradientn(colours=rev(brewer.pal(11, 'Spectral')), name='Counts', limits=c(0, 1))+
ggtitle("Compensated Samusik markers on compensated tsne")+
theme(strip.background = element_blank(),
strip.text.x = element_text(size = 11),
axis.line=element_blank(),
axis.text.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks=element_blank(),
axis.title.x=element_blank(),
axis.title.y=element_blank(),
panel.background=element_blank(),
panel.border=element_blank(),
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.background=element_blank())
p
#ggsave(filename = "/Users/qmiao/CytoSpill copy/scripts/plot/Samusik_compensated_marker_on_compensated_tsne.png", plot = p,width=15, height=6, dpi = 300)
write.FCS(flowFrame(as.matrix(data_Samusik_temp[,-40])), filename = "~/CytoSpill copy/data/flowSOM/data_Samusik_temp.fcs")
write.FCS(flowFrame(as.matrix(compensated_Samusik_exprs[,-40])), filename = "~/CytoSpill copy/data/flowSOM/compensated_Samusik_exprs.fcs")
# save.image("~/CytoSpill copy/data/Samusik_analysis.Rdata")
sessionInfo()
KChen-lab/CytoSpill documentation built on June 15, 2020, 6:12 p.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.
Analysis of mouse bone marrow data.
library(CytoSpill) library(flowCore) library(ggplot2) library(Rtsne) library(dplyr) library(RColorBrewer) library(reshape2) library(Rphenograph)
read data
#read expression data_Samusik <- flowCore::exprs(flowCore::read.FCS("/Users/qmiao/CytoSpill copy/data/Samusik_01_notransform.fcs", transformation = FALSE, truncate_max_range = FALSE)) #remove negative values if any data_Samusik[which(data_Samusik<0)] <- 0 #load metals used for each channel load("/Users/qmiao/CytoSpill copy/data/Samusik_colnames_population.Rdata") col_names levels(population) Samusik_marker <- colnames(data_Samusik) names(Samusik_marker)[1:51] <- col_names colnames(data_Samusik)[1:51] <- col_names
select channels used for compensation and analysis
data_Samusik_temp <- data_Samusik[,9:47] #remove duplicates duplicates_id <- duplicated(data_Samusik_temp) data_Samusik_temp <- data_Samusik_temp[!duplicates_id,]
use CytoSpill for compensation
#step by step code for detail investigation. spillmat_results <- GetSpillMat(data = data_Samusik_temp, cols = 1:39, n = 20000, threshold = 0.1, flexrep = 5, neighbor = 1) data <- data_Samusik_temp cols <- 1:39 spillmat <- spillmat_results[[1]] cutoffs <- spillmat_results[[2]] data_compensated <- t(apply(data[,cols], 1, function(row) nnls::nnls(t(spillmat), row)$x)) data_colnames <- colnames(data) data[,cols] <- data_compensated colnames(data) <- data_colnames compensated_Samusik <- flowFrame(data)
add back population label
##compensated exprs compensated_Samusik_exprs <- as.data.frame(flowCore::exprs(compensated_Samusik)) compensated_Samusik_exprs[,"label"] <- as.factor(data_Samusik[,"label"][!duplicates_id]) ##uncompensated exprs data_Samusik_temp <- as.data.frame(data_Samusik_temp) data_Samusik_temp[,"label"] <- as.factor(data_Samusik[,"label"][!duplicates_id])
downsample
# downsample for faster calculation, plotting nsample = 20000 # subsample set.seed(123) rowsample <- sample(nrow(data_Samusik_temp), nsample) compensated_Samusik_exprs_downsample <- compensated_Samusik_exprs[rowsample,] data_Samusik_temp_downsample <- data_Samusik_temp[rowsample,] #function to censor data, for clear heatmap censor_dat <- function (x, a = 0.99){ q = quantile(x, a) x[x > q] = q return(x) } #function for arcsinh transform transf <- function (x){asinh(x/5)}
Run Rphenograph
calculate_pheno <- function (data, cols, asinhtransfer = T){ if (asinhtransfer <- T) { data[,cols] <- transf(data[,cols]) } pheno_out <- Rphenograph::Rphenograph(data[,cols]) cluster <- igraph::membership(pheno_out[[2]]) return(cluster) } uncompensated_pheno <- calculate_pheno(data_Samusik_temp_downsample, cols = 1:39) compensated_pheno <- calculate_pheno(compensated_Samusik_exprs_downsample, cols = 1:39)
calculate tsne maps on uncompensated data
calculate_tsne <- function (data, cols, asinhtransfer = T, verbose = T, dims = 2, seed = 123){ set.seed(seed) tsne_dat <- data[,cols] #asinh/5 transfer if (asinhtransfer) {tsne_dat <- transf(tsne_dat)} tsne_out <- Rtsne::Rtsne(tsne_dat, verbose = verbose, dims = dims) return(tsne_out) } #calculate based on uncompensated data uncompensated_tsne = calculate_tsne(data_Samusik_temp_downsample, cols = 1:39) # Setup some colors for plotting qual_col_pals = brewer.pal.info[brewer.pal.info$category == 'qual',] col_vector = unlist(mapply(brewer.pal, qual_col_pals$maxcolors, rownames(qual_col_pals)))
plot population label on uncompensated tsne
levels(data_Samusik_temp_downsample$label) <- c(levels(population), "NA") tclust = data_Samusik_temp_downsample[,"label"] # nonNA <- !(data_Samusik_temp_downsample[,"label"]=="NA") tsne_coor <- uncompensated_tsne$Y colnames(tsne_coor) <- c("tsne_1", "tsne_2") col_list <- c("#DC050C", "#FB8072", "#1965B0", "#7BAFDE", "#882E72", "#B17BA6", "#FF7F00", "#FDB462", "#E7298A", "#E78AC3", "#33A02C", "#B2DF8A", "#55A1B1", "#8DD3C7", "#A6761D", "#E6AB02", "#7570B3", "#BEAED4", "#666666", "#999999", "#aa8282", "#d4b7b7", "#8600bf", "gray80", "#aeae5c", "#1e90ff", "#00bfff", "#56ff0d", "#ffff00") p = ggplot(as.data.frame(tsne_coor), aes(x=tsne_1, y=tsne_2))+ geom_point(size=0.3, alpha=0.8, aes(color=as.factor(tclust)))+ scale_color_manual(values = col_list, name = "cell type")+ ggtitle('Samusik uncompensated data tsne')+ guides(color=guide_legend(override.aes=list(size=5)))+ theme(strip.background = element_blank(), panel.background=element_rect(fill='white', colour = 'black'), panel.grid.major=element_blank(), panel.grid.minor=element_blank(), plot.background=element_blank(), legend.key = element_blank()) p
plot Rphenograhp cluster on uncompensated tsne
tclust = uncompensated_pheno tsne_coor <- uncompensated_tsne$Y colnames(tsne_coor) <- c("tsne_1", "tsne_2") col_list <- c("#DC050C", "#FB8072", "#1965B0", "#7BAFDE", "#882E72", "#B17BA6", "#FF7F00", "#FDB462", "#E7298A", "#E78AC3", "#33A02C", "#B2DF8A", "#55A1B1", "#8DD3C7", "#A6761D", "#E6AB02", "#7570B3", "#BEAED4", "#666666", "#999999", "#aa8282", "#d4b7b7", "#8600bf", "#ba5ce3", "#808000", "#aeae5c", "#1e90ff", "#00bfff", "#56ff0d", "#ffff00") p = ggplot(as.data.frame(tsne_coor), aes(x=tsne_1, y=tsne_2))+ geom_point(size=0.3, alpha=0.8, aes(color=as.factor(tclust)))+ scale_color_manual(values = col_list, name = "Phenograph cluster")+ ggtitle('Samusik uncompensated data tsne with Phenograph clusters')+ guides(color=guide_legend(override.aes=list(size=5),ncol=2))+ theme(strip.background = element_blank(), panel.background=element_rect(fill='white', colour = 'black'), panel.grid.major=element_blank(), panel.grid.minor=element_blank(), plot.background=element_blank(), legend.key = element_blank()) p
calculate tsne on compensated data
compensated_tsne = calculate_tsne(compensated_Samusik_exprs_downsample, cols = 1:39)
plot population on compensated tsne
levels(compensated_Samusik_exprs_downsample$label) <- c(levels(population), "NA") tclust = compensated_Samusik_exprs_downsample[,"label"] # nonNA <- !(compensated_Samusik_exprs_downsample[,"label"]=="NA") tsne_coor <- compensated_tsne$Y colnames(tsne_coor) <- c("tsne_1", "tsne_2") col_list <- c("#DC050C", "#FB8072", "#1965B0", "#7BAFDE", "#882E72", "#B17BA6", "#FF7F00", "#FDB462", "#E7298A", "#E78AC3", "#33A02C", "#B2DF8A", "#55A1B1", "#8DD3C7", "#A6761D", "#E6AB02", "#7570B3", "#BEAED4", "#666666", "#999999", "#aa8282", "#d4b7b7", "#8600bf", "gray80", "#aeae5c", "#1e90ff", "#00bfff", "#56ff0d", "#ffff00") p = ggplot(as.data.frame(tsne_coor), aes(x=tsne_1, y=tsne_2))+ geom_point(size=0.3, alpha=0.8, aes(color=as.factor(tclust)))+ scale_color_manual(values = col_list, name = "cell type")+ ggtitle('Samusik compensated data tsne')+ guides(color=guide_legend(override.aes=list(size=5)))+ theme(strip.background = element_blank(), panel.background=element_rect(fill='white', colour = 'black'), panel.grid.major=element_blank(), panel.grid.minor=element_blank(), plot.background=element_blank(), legend.key = element_blank()) p
plot Rphenograhp cluster on compensated tsne
tclust = compensated_pheno tsne_coor <- compensated_tsne$Y colnames(tsne_coor) <- c("tsne_1", "tsne_2") col_list <- c("#DC050C", "#FB8072", "#1965B0", "#7BAFDE", "#882E72", "#B17BA6", "#FF7F00", "#FDB462", "#E7298A", "#E78AC3", "#33A02C", "#B2DF8A", "#55A1B1", "#8DD3C7", "#A6761D", "#E6AB02", "#7570B3", "#BEAED4", "#666666", "#999999", "#aa8282", "#d4b7b7", "#8600bf", "#ba5ce3", "#808000", "#aeae5c", "#1e90ff", "#00bfff", "#56ff0d", "#ffff00") p = ggplot(as.data.frame(tsne_coor), aes(x=tsne_1, y=tsne_2))+ geom_point(size=0.3, alpha=0.8, aes(color=as.factor(tclust)))+ scale_color_manual(values = col_list, name = "Phenograph cluster")+ ggtitle('Samusik compensated data tsne with Phenograph clusters')+ guides(color=guide_legend(override.aes=list(size=5),ncol=2))+ theme(strip.background = element_blank(), panel.background=element_rect(fill='white', colour = 'black'), panel.grid.major=element_blank(), panel.grid.minor=element_blank(), plot.background=element_blank(), legend.key = element_blank()) p
uncompensated marker density plots
the following plots the asinh(x/5) transformed intensities were normalized between 0-1 by using the 0.99 percentile of the data.
pdat <- transf(data_Samusik_temp_downsample[,-40]) censor_pdat <- apply(pdat, 2, censor_dat) #normalize 0-1 censor_pdat <- apply(censor_pdat, MARGIN = 2, FUN = function(X) (X - min(X))/diff(range(X))) ### add colnames for (i in seq_along(Samusik_marker)){ names(Samusik_marker)[i] <- paste(names(Samusik_marker)[i], Samusik_marker[i], sep ='-') } dimnames(censor_pdat)[[2]] <- names(Samusik_marker[9:47]) censor_pdat <- as.data.frame(censor_pdat) censor_pdat$tsne_1 <- uncompensated_tsne$Y[,1] censor_pdat$tsne_2 <- uncompensated_tsne$Y[,2] pdat_melt <- reshape2::melt(censor_pdat, id.vars = c("tsne_1","tsne_2"), variable.name = "channel") p = ggplot(pdat_melt, aes(x=tsne_1, y=tsne_2, color=value))+ facet_wrap(~channel, scales = "free", ncol = 8)+ geom_point(alpha=0.5, size=0.3)+ scale_color_gradientn(colours=rev(brewer.pal(11, 'Spectral')), name='Counts', limits=c(0, 1))+ ggtitle("Uncomepensated Samusik markers")+ theme(strip.background = element_blank(), strip.text.x = element_text(size = 11), axis.line=element_blank(), axis.text.x=element_blank(), axis.text.y=element_blank(), axis.ticks=element_blank(), axis.title.x=element_blank(), axis.title.y=element_blank(), panel.background=element_blank(), panel.border=element_blank(), panel.grid.major=element_blank(), panel.grid.minor=element_blank(), plot.background=element_blank()) p #ggsave(filename = "/Users/qmiao/CytoSpill copy/scripts/plot/Samusik_uncompensated_marker.png", plot = p,width=15, height=6, dpi = 300)
compensatd marker density plot
pdat <- transf(compensated_Samusik_exprs_downsample[,-40]) censor_pdat <- apply(pdat, 2, censor_dat) censor_pdat <- apply(censor_pdat, MARGIN = 2, FUN = function(X) (X - min(X))/diff(range(X))) dimnames(censor_pdat)[[2]] <- names(Samusik_marker[9:47]) censor_pdat <- as.data.frame(censor_pdat) censor_pdat$tsne_1 <- uncompensated_tsne$Y[,1] censor_pdat$tsne_2 <- uncompensated_tsne$Y[,2] pdat_melt <- reshape2::melt(censor_pdat, id.vars = c("tsne_1","tsne_2"), variable.name = "channel") p = ggplot(pdat_melt, aes(x=tsne_1, y=tsne_2, color=value))+ facet_wrap(~channel, scales = "free", ncol = 8)+ geom_point(alpha=0.5, size=0.3)+ scale_color_gradientn(colours=rev(brewer.pal(11, 'Spectral')), name='Counts', limits=c(0, 1))+ ggtitle("Compensated Samusik markers")+ theme(strip.background = element_blank(), strip.text.x = element_text(size = 11), axis.line=element_blank(), axis.text.x=element_blank(), axis.text.y=element_blank(), axis.ticks=element_blank(), axis.title.x=element_blank(), axis.title.y=element_blank(), panel.background=element_blank(), panel.border=element_blank(), panel.grid.major=element_blank(), panel.grid.minor=element_blank(), plot.background=element_blank()) p #ggsave(filename = "/Users/qmiao/CytoSpill copy/scripts/plot/Samusik_compensated_marker.png", plot = p,width=15, height=6, dpi = 300)
compensatd marker density plot on compensated tsne
pdat <- transf(compensated_Samusik_exprs_downsample[,-40]) censor_pdat <- apply(pdat, 2, censor_dat) censor_pdat <- apply(censor_pdat, MARGIN = 2, FUN = function(X) (X - min(X))/diff(range(X))) dimnames(censor_pdat)[[2]] <- names(Samusik_marker[9:47]) censor_pdat <- as.data.frame(censor_pdat) censor_pdat$tsne_1 <- compensated_tsne$Y[,1] censor_pdat$tsne_2 <- compensated_tsne$Y[,2] pdat_melt <- reshape2::melt(censor_pdat, id.vars = c("tsne_1","tsne_2"), variable.name = "channel") p = ggplot(pdat_melt, aes(x=tsne_1, y=tsne_2, color=value))+ facet_wrap(~channel, scales = "free", ncol = 8)+ geom_point(alpha=0.5, size=0.3)+ scale_color_gradientn(colours=rev(brewer.pal(11, 'Spectral')), name='Counts', limits=c(0, 1))+ ggtitle("Compensated Samusik markers on compensated tsne")+ theme(strip.background = element_blank(), strip.text.x = element_text(size = 11), axis.line=element_blank(), axis.text.x=element_blank(), axis.text.y=element_blank(), axis.ticks=element_blank(), axis.title.x=element_blank(), axis.title.y=element_blank(), panel.background=element_blank(), panel.border=element_blank(), panel.grid.major=element_blank(), panel.grid.minor=element_blank(), plot.background=element_blank()) p #ggsave(filename = "/Users/qmiao/CytoSpill copy/scripts/plot/Samusik_compensated_marker_on_compensated_tsne.png", plot = p,width=15, height=6, dpi = 300)
write.FCS(flowFrame(as.matrix(data_Samusik_temp[,-40])), filename = "~/CytoSpill copy/data/flowSOM/data_Samusik_temp.fcs") write.FCS(flowFrame(as.matrix(compensated_Samusik_exprs[,-40])), filename = "~/CytoSpill copy/data/flowSOM/compensated_Samusik_exprs.fcs")
# save.image("~/CytoSpill copy/data/Samusik_analysis.Rdata") sessionInfo()
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.