#' FeaturePlotly3D
#'
#' Create a scatterplot of a given dimensional reduction set for a Seurat object,
#' coloring and sizing points by the expression level of the chosen feature.
#' Requrires a Seurat object with the reduction to be used in the corresponding
#' object@@dr slot
#'
#' @param object Seurat object
#' @param feature Feature values to display. Works with anything \code{Seurat::\link[Seurat]{FetchData}} can retrieve.
#' @param reduction Dimensional reduction to display. Default: umap
#' @param assay Assay to pull values from for feature. Default: NULL
#' @param slot Slot to pull values from for feature. Default: NULL
#' @param opacity Transparency level to use for the points, on a 0-1 scale. Default: 1
#' @param filter_zeros Remove points with no expression data. Default: TRUE
#' @param dim_1 Dimension to display on the x-axis. Default: 1
#' @param dim_2 Dimension to display on the y-axis. Default: 2
#' @param dim_3 Dimension to display on the z-axis. Default: 3
#' @param pt_scale Factor by which to multiply the size of the points. Default: 5
#' @param pt_shape Shape to use for the points. Default = circle
#' @param colors_use Color palette to use. Accepts palettes available in the paletteer package.. Default: Reds
#' @param bins Number of bins to use in dividing expression levels.. Default: 10
#' @param plot_height Plot height in pixels. Default: 900
#' @param plot_width Plot width in pixels. Default: 900
#' @param plot_title Display title with the name of the feature?. Default TRUE
#' @param plot_axes Display the major x, y, and z axes?. Default: FALSE
#' @param plot_grid Display the major unit tick marks?. Default: FALSE
#' @param pt_info Meta.data columns to add to the hoverinfo popup. Default: ident
#' @param legend Display legend?. Default: TRUE
#' @param legend_font_size Legend font size. Default: 12
#' @param return Return the plot object instead of displaying it. Default: FALSE
#'
#' @importFrom plotly plot_ly layout add_markers colorbar
#' @importFrom stringr str_glue
#' @importFrom dplyr mutate_at
#' @importFrom tidyr unite
#'
#' @return
#' @export
#'
FeaturePlotly3D <- FeaturePlotly3d <- function(object,
feature = NULL,
reduction = "umap",
assay = NULL,
slot = NULL,
opacity = 1,
filter_zeros = TRUE,
dim_1 = 1,
dim_2 = 2,
dim_3 = 3,
pt_scale = 0.5,
pt_shape = "circle",
colors_use = "Red",
bins = 10,
plot_height = 750,
plot_width = 750,
plot_title = FALSE,
pt_info = NULL,
legend = TRUE,
legend_font_size = 12,
plot_grid = FALSE,
plot_axes = TRUE,
return = FALSE){
# global variable binding hack
cell <- NULL
info <- NULL
df <- PrepDr(object,
reduction,
dim_1 = dim_1,
dim_2 = dim_2,
dim_3 = dim_3)
df <- PrepInfo(object = object,
pt_info = pt_info,
df = df)
if (is.null(feature)){
stop("No gene or feature given")
}
if (is.null(feature)){ stop("No gene or feature given") }
df <- GetFeatureValues(object = object,
df = df,
feature = feature,
bins = bins,
use.scaled = TRUE,
assay = assay,
suffix = "expr")
df <- GetFeatureValues(object = object,
df = df,
feature = feature,
use.scaled = TRUE,
assay = assay,
suffix = "size")
df[[str_glue("{feature}_size")]] <- df[[str_glue("{feature}_size")]] * pt_scale
md <- GetFeatureValues(object = object,
features = c(pt_info, "ident")) %>%
mutate_at(vars(-cell),
list(~paste0('</br> ', substitute(.), ": ", .))) %>%
unite(info, -cell)
df %<>% inner_join(md)
if (isTRUE(plot_title)){
plot_title = feature
} else {
plot_title = NULL
}
pal <- PrepQuantitativePalette(bins = bins,
palette = colors_use)
if (isTRUE(plot_title)){
plot_title = feature
} else {
plot_title = NULL
}
if (filter_zeros){
df %<>% filter(get(str_glue("{feature}_size")) > 0)
}
p <- plot_ly(df,
x = ~x,
y = ~y,
z = ~z,
#color = ~feature,
mode = 'markers',
type = "scatter3d",
#colors = pal,
#size = ~size,
#sizes = c(0,max(df$size)),
marker = list(symbol = pt_shape,
opacity = opacity,
size = ~get(str_glue("{feature}_size")),
sizes = c(0,max(df[[str_glue("{feature}_size")]])),
color = ~get(str_glue("{feature}_expr")),
colors=pal,
line = list(width = 0)),
width = plot_width,
height = plot_height,
showlegend = legend) %>%
layout(title = plot_title,
scene = list(
xaxis = list(title = str_glue("{reduction}_{dim_1}"), showgrid = plot_grid, visible = plot_axes),
yaxis = list(title = str_glue("{reduction}_{dim_2}"), showgrid = plot_grid, visible = plot_axes),
zaxis = list(title = str_glue("{reduction}_{dim_3}"), showgrid = plot_grid, visible = plot_axes)),
margin = c(100,NA,NA,NA))
if(!is.null(pt_info)){
p %<>% add_markers(hoverinfo = "text",
hovertext = paste(~meta_info, ~feature),
showlegend = FALSE)
}
p <- p %>% layout(legend = list(
font = list(
size = legend_font_size)))
if (isTRUE(return)){
return(df)
} else {
return(p)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.