langevitour-plotly crosstalk example (ABACBS 2022)

← Return to main page

The selection is shared between all of the widgets below using crosstalk. You can use any widget to select cells, which will then be highlighted in all widgets.

## scRNA-Seq crosstalk with plotly

## 2022-11-19 This code requires the development versions of langevitour and plotly.R
# remotes::install_github("pfh/langevitour")
# remotes::install_github("plotly/plotly.R")

library(tidyverse)
library(htmltools)
library(crosstalk)
library(DT)
library(langevitour)
library(plotly)
library(ggbeeswarm)

# plotly's crosstalk implementation requires a little tweaking to work right.
plotlify <- function(plot) {
    ggplotly(plot, tooltip="text", height=500) |> 
        style(unselected=list(marker=list(opacity=1))) |> # Don't double-fade unselected points
        highlight(on="plotly_selected", off="plotly_deselect")
}


out <- readRDS("out.rds")

cells <- out$cells
shared <- SharedData$new(cells)

stimLabel <- factor(ifelse(cells$stim=="stim","S","U"), c("U","S")) 
crossLabel <- fct_cross(stimLabel, cells$type, sep=" ")

h <- c(0,2,1,3,4,5,0)/6*360
c <- c(1,1,1,1,1,1,0)*100
colsCrossLabel <- hcl(h=rep(h,each=2), c=rep(c,each=2), l=rep(c(40,70),7), fixup=TRUE)
colsTypeLabel <- hcl(h=h, c=c, l=50, fixup=TRUE)

wLangevitour <- langevitour(
    out$vmScores, 
    crossLabel, 
    levelColors=colsCrossLabel, 
    link=shared,
    state=list(guideType="local"),
    width=600, height=500)


pUmap <- ggplot(shared) + 
    aes(x=umapX,y=umapY,color=crossLabel) + 
    geom_point(size=0.75, stroke=0) + 
    scale_color_discrete(type=colsCrossLabel) +
    scale_x_continuous(breaks=c()) +
    scale_y_continuous(breaks=c()) +
    guides(color = guide_legend(override.aes = list(size=4))) +
    coord_fixed() +
    labs(x="",y="",color="",title="UMAP") +
    theme_bw()

pCount <- ggplot(shared) + 
    aes(x="", y=nCount) + 
    geom_beeswarm(size=0.1, cex=0.5, priority="random") + 
    theme_bw() +
    labs(x="", y="", title="Total UMIs")

pRibo <- ggplot(shared) + 
    aes(x="", y=percentRibo) + 
    geom_beeswarm(size=0.1, cex=0.5, priority="random") + 
    theme_bw() +
    labs(x="", y="", title="Ribo %")

# A table widget, using the SharedData object
wTable <- datatable(
        shared,
        rownames=FALSE, width="100%", 
        class='compact cell-border hover', extensions='Buttons',
        options=list(dom='Bfrtip',buttons=c('copy','csv','excel'))) |>
    formatRound("percentRibo", 0) |>
    formatRound(c("umapX","umapY"), 2)

browsable(div(
    div(
        style="display: grid; grid-template-columns: 600px 400px 150px 150px;",
        wLangevitour,
        plotlify(pUmap),
        plotlify(pCount),
        plotlify(pRibo)),
    wTable))