In loosolab/i2dash.scrnaseq: Iterative and Interactive Dashboards for single-cell RNA-sequencing data

Dimension reduction:

{{ env_id }} <- readRDS(file.path(datadir, "{{ env_id }}.rds"))
is_shiny <- identical(knitr::opts_knit$get("rmarkdown.runtime"), "shiny")

library(dplyr)

labels_{{ env_id }} <- {{ env_id }}$labels
metadata_{{ env_id }} <- {{ env_id }}$metadata
grouping_{{ env_id }} <- {{ env_id }}$grouping

# function to create a data.frame
create_df <- function(reduced_dim, metadata, grouping){

  # Create data.frame for linked plots
  # 1 Create df1 
  df1 <- data.frame("x" = reduced_dim[,1], "y" = reduced_dim[,2], metadata)

  # 2 create silhouette object
  sil <- cluster::silhouette(as.integer(metadata[[grouping]]), dist(reduced_dim))

  # 3 create df2 for silhoutte
  df2 <- data.frame(cell = factor(rownames(reduced_dim), levels = rownames(reduced_dim)), silhouette = sil[,"sil_width"], cluster = factor(sil[,"cluster"], levels = unique(as.numeric(metadata[[grouping]])[order(as.numeric(metadata[[grouping]]))]), ordered = T))
  df2$cell <- factor(df2$cell, levels = df2$cell[order(df2$cluster, df2$silhouette)])

  # 4 sort df1 according to the cell column of df2
  # combine both data.frames in df3
  df3 <- df1[order(match(rownames(df1), df2["cell"])),]
  df3$cell <- df2$cell
  df3$silhouette <- df2$silhouette

  row.names(df3) <- c()

  return(df3)
}

df_{{ env_id }} <- create_df(reduced_dim = {{ env_id }}$reduced_dim, metadata = metadata_{{ env_id }}, grouping = grouping_{{ env_id }})

sd_{{ env_id }} <- plotly::highlight_key(df_{{ env_id }})

# compare with colormaps
if(grouping_{{ env_id }} %in% names(colormaps)) colors_{{ env_id }} <- colormaps[[grouping_{{ env_id }}]] else colors_{{ env_id }} <- "Set1"

dots <- plotly::plot_ly(sd_{{ env_id }}, colors = colors_{{ env_id }}, color = df_{{ env_id }}[[grouping_{{ env_id }}]], x = ~x, y = ~y, mode = "markers", textposition = "top", hoverinfo = "x+y+text", text = paste("grouping: ", df_{{ env_id }}[[grouping_{{ env_id }}]], "</br> label: ", labels_{{ env_id }}), type = "scattergl") %>%
  plotly::layout(
    xaxis = list(title = "Dimension 1"),
    yaxis = list(title = "Dimension 2"),
    showlegend = FALSE
  ) %>%
  plotly::highlight("plotly_selected") %>%
  plotly::toWebGL()

htmltools::div(style="display:block;float:left;width:100%;height:90%;",
  htmltools::tags$button(i2dash::embed_var(df_{{ env_id }})), dots
)

# filter all factorial metadata columns
factors_{{ env_id }} <- c()
for (name in colnames(metadata_{{ env_id }})){
  if(is.factor(metadata_{{ env_id }}[[name]])){
    factors_{{ env_id }} <- c(factors_{{ env_id }}, name)
  }
}
ui_list <- list()

# selection field for x
if ({{ env_id }}$multiple_meta){
  ui_list <- rlist::list.append(ui_list,
                                selectInput("select_grouping_{{ env_id }}", label = "Select column for grouping:",
                                            choices = factors_{{ env_id }}, selected = grouping_{{ env_id }}))
}

# Download link
ui_list <- rlist::list.append(ui_list, tags$div(tags$br(), downloadButton('downloadData_{{ env_id }}', 'Download data')))

#
# Create reactive data table
#
df_{{ env_id }} <- shiny::reactive({
  if (!{{ env_id }}$multiple_meta){
    grouping <- grouping_{{ env_id }}
  } else {
    grouping <- input$select_grouping_{{ env_id }}
  }
  df_{{ env_id }} <- create_df(reduced_dim = {{ env_id }}$reduced_dim, metadata = metadata_{{ env_id }}, grouping = grouping)

  sd_{{ env_id }} <- plotly::highlight_key(df_{{ env_id }})
  return(list("sd" = sd_{{ env_id }}, "df" = df_{{ env_id }}, "grouping" = grouping))
})

#
# Download
#
output$downloadData_{{ env_id }}<- downloadHandler(
  filename =  paste('data-', Sys.Date(), '.csv', sep=''),
  content = function(file) {
    write.csv(df_{{ env_id }}()$df, file)
  }
)

#
# Output
#
output$plot_scatter_{{ env_id }} <- plotly::renderPlotly({
  # compare with colormaps
  if(df_{{ env_id }}()$grouping %in% names(colormaps)) colors <- colormaps[[df_{{ env_id }}()$grouping]] else colors <- "Set1"

  dots <- plotly::plot_ly(df_{{ env_id }}()$sd, color = df_{{ env_id }}()$df[[df_{{ env_id }}()$grouping]], x = ~x, y = ~y, mode = "markers", textposition = "top", hoverinfo = "x+y+text", text = paste("grouping: ", df_{{ env_id }}()$df[[df_{{ env_id }}()$grouping]], "</br> label: ", labels_{{ env_id }}),  type = "scattergl", colors = colors) %>%
  plotly::layout(
    xaxis = list(title = "Dimension 1"),
    yaxis = list(title = "Dimension 2"),
    showlegend = FALSE
  ) %>%
    plotly::highlight("plotly_selected") %>% 
    plotly::toWebGL()
  dots
})

#
# Layout of component
#
shiny::fillRow(flex = c(NA, 1),
      shinyWidgets::dropdownButton(div(style='max-height: 350px; overflow-x: auto;',do.call(shiny::inputPanel, ui_list)),
                       circle = TRUE, status = "danger", icon = icon("gear"), width = "300px",
                       tooltip = shinyWidgets::tooltipOptions(title = "Click, to change plot settings:")),
      renderUI({plotly::plotlyOutput("plot_scatter_{{ env_id }}", height = "100%")})
)

loosolab/i2dash.scrnaseq documentation built on Jan. 1, 2021, 8:23 a.m.