单细胞转录组数据分析||Seurat绘制3D-tsne与3D-u

有时候在二维空间中有的亚群是有部分重叠的，就是降维投影结果不是很精确，这时候可以用3D的图来展示。

要绘制3D图就要有3D的坐标：

library(plotly)
library(Seurat)
# Re-run UMAPs that you have accurate calculations for all UMAP(s)
pbmc_small <- RunUMAP(pbmc_small,
                            dims = 1:10,
                            n.components = 3L)

tsne与umap类似，这里不再展示。

3D分群图

整理数据。

# Visualize what headings are called so that you can extract them to form a dataframe
#Embeddings(object = pbmc_small, reduction = "umap")
 head(pbmc_small[["umap"]]@cell.embeddings)
                   UMAP_1     UMAP_2     UMAP_3
ATGCCAGAACGACT -0.1729153 0.23306953 -2.2075205
CATGGCCTGTGCAT -0.3471594 0.71512310 -1.9961561
GAACCTGATGAACC  2.0742189 0.02595013  0.8318514
TGACTGGATTCTCA  0.9271557 1.61257947 -1.2555345
AGTCAGACTGCACA  0.1225159 0.55255975 -2.7875166
TCTGATACACGTGT -0.1071453 0.39451006 -2.3486316

umap_1 <- pbmc_small[["umap"]]@cell.embeddings[,1]
umap_2 <- pbmc_small[["umap"]]@cell.embeddings[,2]
umap_3 <- pbmc_small[["umap"]]@cell.embeddings[,3]
# Prepare a dataframe for cell plotting
plot.data <- FetchData(object = pbmc_small, vars = c("UMAP_1", "UMAP_2", "UMAP_3", "groups"))

# Make a column of row name identities (these will be your cell/barcode names)
plot.data$label <- paste(rownames(plot.data))

用plotly绘制3D图

# Plot your data, in this example my Seurat object had 21 clusters (0-20)
plot_ly(data = plot.data, 
        x = ~UMAP_1, y = ~UMAP_2, z = ~UMAP_3, 
        color = ~groups, 
        colors = c("lightseagreen",
                   "gray50",
                   "darkgreen",
                   "red4",
                   "red",
                   "turquoise4",
                   "black",
                   "yellow4",
                   "royalblue1",
                   "lightcyan3",
                   "peachpuff3",
                   "khaki3",
                   "gray20",
                   "orange2",
                   "royalblue4",
                   "yellow3",
                   "gray80",
                   "darkorchid1",
                   "lawngreen",
                   "plum2",
                   "darkmagenta"),
        type = "scatter3d", 
        mode = "markers", 
        marker = list(size = 5, width=2), # controls size of points
        text=~label, #This is that extra column we made earlier for which we will use for cell ID
        hoverinfo="text") #When you visualize your plotly object, hovering your mouse pointer over a point shows cell names

3D基因表达量图

plot.data <- FetchData(object = pbmc_small, vars = c("UMAP_1", "UMAP_2", "UMAP_3", "BID"), slot = 'data')

# Say you want change the scale, so that every cell having an expression >1 will be one color
# Basically, you are re-adjusting the scale here, so that any cell having a certain expression will light up on your 3D plot

# First make another column in your dataframe, where all values above 1 are re-assigned a value of 1
# This information is stored in the 'changed' column of your dataframe
plot.data$changed <- ifelse(test = plot.data$BID <1, yes = plot.data$BID, no = 1)

# Add the label column, so that now the column has 'cellname-its expression value'
plot.data$label <- paste(rownames(plot.data)," - ", plot.data$ACTB, sep="")

# Plot your data, in this example my Seurat object had 21 clusters (0-20), and cells express a gene called ACTB
plot_ly(data = plot.data, 
        x = ~UMAP_1, y = ~UMAP_2, z = ~UMAP_3, 
        color = ~changed, # you can just run this against the column for the gene as well using ~ACTB, the algorith will automatically scale in that case based on maximal and minimal values
        opacity = .5,
        colors = c('darkgreen', 'red'), 
        type = "scatter3d", 
        mode = "markers",
        marker = list(size = 5, width=2), 
        text=~label,
        hoverinfo="text"
)

# create a dataframe
goi <- "BID"
plotting.data <- FetchData(object = pbmc_small, vars = c("UMAP_1", "UMAP_2", "UMAP_3", "Expression"=goi), slot = 'data')

# Say you want change the scale, so that every cell having an expression >1 will be one color
# Basically, you are re-adjusting the scale here, so that any cell having a certain expression will light up on your 3D plot

# First make another column in your dataframe, where all values above 1 are re-assigned a value of 1
# This information is stored in the 'Expression' column of your dataframe
# Cutoff <- 2
Cutoff <- quantile(plotting.data[,goi], probs = .95)
plotting.data$"ExprCutoff" <- ifelse(test = plotting.data[,goi] <Cutoff, yes = plotting.data[,goi], no = Cutoff)

# Add the label column, so that now the column has 'cellname-its expression value'
plotting.data$label <- paste(rownames(plotting.data)," - ", plotting.data[,goi], sep="")

# Plot your data, in this example my Seurat object had 21 clusters (0-20), and cells express a gene called ACTB
plot_ly(data = plotting.data,
        # name = goi,
        x = ~UMAP_1, y = ~UMAP_2, z = ~UMAP_3, 
        color = ~ExprCutoff, # you can just run this against the column for the gene as well using ~ACTB, the algorith will automatically scale in that case based on maximal and minimal values
        opacity = .5,
        colors = c('darkgrey', 'red'), 
        type = "scatter3d", 
        mode = "markers",
        marker = list(size = 10), 
        text=~label,
        hoverinfo="text"
) %>%layout(title=goi)

---

---

Seurat3D