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

{{ title }}

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

library(magrittr)
library(data.table)

# Function to aggregate a data matrix/df according to a grouping
aggregate_data <- function(data, group) {
  vapply(split(1:ncol(data), group),
         function(x) { rowMeans(data[, x, drop = FALSE]) },
         numeric(nrow(data)))
}

# Create defaults for heatmap
exprs_values_{{ env_id }} <- {{ env_id }}$exprs_values
split_by_{{ env_id }} <- NULL
cell_fun_{{ env_id }} <- NULL
column_names_rot_{{ env_id }} <- 45
ha_{{ env_id }} <- NULL

# Handle column split
if (!is.null({{ env_id }}$split_by)) {
  split_by_{{ env_id }} <- {{ env_id }}$split_by[,1]

  # Handle annotation
  # Use colors defined by colormap else use random colors
  if (colnames({{ env_id }}$split_by)[1] %in% names(colormaps)){
    ha_{{ env_id }} = ComplexHeatmap::HeatmapAnnotation(
      group_by = split_by_{{ env_id }},
      col = list(group_by = colormaps[[colnames({{ env_id }}$split_by)[1]]])
    )
  } else {
    ha_{{ env_id }} = ComplexHeatmap::HeatmapAnnotation(
      group_by = split_by_{{ env_id }}
    )
  }
}

# Remove column names
if (!{{ env_id }}$show_column_labels) colnames(exprs_values_{{ env_id }}) <- c()

# Handle data aggregation
if (!is.null({{ env_id }}$aggregate_by)) {
  exprs_values_{{ env_id }} <- aggregate_data({{ env_id }}$exprs_values, {{ env_id }}$aggregate_by[,1])
  cell_fun_{{ env_id }} <- function(j, i, x, y, width, height, fill) {
      grid::grid.text(sprintf("%.1f", exprs_values_{{ env_id }}[i, j]), x, y, gp = grid::gpar(fontsize = 10))
  }
  split_by_{{ env_id }} <- NULL
  ha_{{ env_id }} <- NULL
}

# Todo?
row_split_{{ env_id }} <- NULL
heatmap_{{ env_id }} <- ComplexHeatmap::draw(i2dash.scrnaseq::ComplexHeatmap_heatmap(
    matrix = exprs_values_{{ env_id }},
    legend_title = {{ env_id }}$legend_title,
    cluster_rows = {{ env_id }}$cluster_rows,
    cluster_columns = {{ env_id }}$cluster_columns,
    clustering_distance_rows = {{ env_id }}$clustering_distance,
    clustering_distance_columns = {{ env_id }}$clustering_distance,
    clustering_method_rows = {{ env_id }}$clustering_method,
    clustering_method_columns = {{ env_id }}$clustering_method,
    column_split = split_by_{{ env_id }},
    row_split = row_split_{{ env_id }},
    column_names_rot = column_names_rot_{{ env_id }},
    cell_fun = cell_fun_{{ env_id }},
    top_annotation = ha_{{ env_id }},
    column_title = {{ env_id }}$column_title,
    row_title = {{ env_id }}$row_title,
    row_names_gp = grid::gpar(fontsize = 7),
    column_names_gp = grid::gpar(fontsize = 7),
    column_title_gp = grid::gpar(fontsize = 10),
    row_title_gp = grid::gpar(fontsize = 10)
  ))

# get image size
width_{{ env_id }} <- grid::convertUnit(ComplexHeatmap:::width(heatmap_{{ env_id }}), "mm", valueOnly = T)
height_{{ env_id }} <- grid::convertUnit(ComplexHeatmap:::height(heatmap_{{ env_id }}), "mm", valueOnly = T)

# safe image as png
png(file.path(datadir, "{{ env_id }}_heatmap.png"), width = width_{{ env_id }}, height = height_{{ env_id }}, units = "mm", res = 300)
heatmap_{{ env_id }}
dev.off()

# Provide data for download
htmltools::div(htmltools::tags$button(i2dash::embed_var(exprs_values_{{ env_id }})), id = "{{ env_id }}_heatmap")

# convert image in base64, create appropriate HTML tags, and remove png file
file_{{ env_id }} <- file.path(datadir, "{{ env_id }}_heatmap.png")
printImageURI<-function(file){
  uri=knitr::image_uri(file)
  file.remove(file)
  return(sprintf("<p class='image-container' style='height:auto; margin-top: 40px; background: url(\"%s\") center center / contain no-repeat;'>\n <img src=\"%s\">\n", uri, uri))
}
HTMLheatmap_{{ env_id }} <- printImageURI(file_{{ env_id }})
htmltools::HTML(HTMLheatmap_{{ env_id }})

ui_list <- list(
  # Split_by
  shiny::selectInput("select_split_by_{{ env_id }}", label = "Split columns by:", choices = c("None", colnames({{ env_id }}$split_by))),
  # Aggregate_by
  shiny::selectInput("select_aggregate_by_{{ env_id }}", label = "Aggregate columns by:", choices = c("None", colnames({{ env_id }}$aggregate_by))),
  # Subset_rows
  shiny::selectInput("select_subset_{{ env_id }}", label = "Select features:", choices = rownames({{ env_id }}$exprs_values), multiple = TRUE),
  # Clustering
  shiny::radioButtons("select_clustering_{{ env_id }}", label = "Clustering", choices = c("None" = "none", "Columns and rows" = "both", "Columns" = "column", "Rows" = "row")),
  shiny::selectInput("select_clustdist_{{ env_id }}", label = "Cluster distance:", choices = c("euclidean", "maximum", "manhattan", "binary", "minkowski")),
  shiny::selectInput("select_clustmethod_{{ env_id }}", label = "Cluster method:", choices = c("average", "ward.D", "ward.D2", "single", "complete", "mcquitty")),
  shiny::tags$div(shiny::tags$br(), shiny::downloadButton("downloadData_{{ env_id }}", "Download data"))
)

# Function for subsetting a matrix accoriding to a vector of features
subset_features <- function(matrix, features){
  if(length(features) > 1){
    matrix <- matrix[features,]
  } else if(length(features) == 1){
    matrix <- matrix[features, , drop = FALSE]
  }
  return(matrix)
}

# Function for subsetting a matrix accoriding to a vector of samples
subset_samples <- function(matrix, samples){
  if(length(samples) > 1){
    matrix <- matrix[,samples]
  } else if(length(samples) == 1){
    matrix <- matrix[,samples, drop = FALSE]
  }
  return(matrix)
}

#
# Handle inputs
#
exprs_values_{{ env_id }} <- shiny::reactive({
  exprs_values <- {{ env_id }}$exprs_values

  # Handle eventdata
  eventdata <- plotly::event_data("plotly_selected", source = {{ env_id }}$transmitter)
  samples_used <- F
  indexes <- NULL
  if (!is.null(eventdata)){
    # check if rows or columns should be subsetted
    keys_samples <- colnames(exprs_values)
    keys_features <- rownames(exprs_values)
    if (all(eventdata$key %in% keys_samples)){
      exprs_values <- subset_samples(exprs_values, eventdata$key)
      samples_used <- T
      indexes <- which(keys_samples %in% eventdata$key)
    } else if (all(eventdata$key %in% keys_features)){ # problematic if the eventdata is not part of subset_row
      exprs_values <- subset_features(exprs_values, eventdata$key)
    }
  }

  # Subset features
  if(length(input$select_subset_{{ env_id }}) > 0) exprs_values <- subset_features({{ env_id }}$exprs_values, input$select_subset_{{ env_id }})
  if (!{{ env_id }}$show_column_labels) colnames(exprs_values) <- c()

  # Handle aggregation
  if (input$select_aggregate_by_{{ env_id }} != "None") {
    # if eventdata is used and aggregate_by should be subsetted
    if (!is.null(eventdata) & samples_used){
      aggregate_by <- {{ env_id }}$aggregate_by[, input$select_aggregate_by_{{ env_id }}]
      aggregate_by <- aggregate_by[indexes]
      exprs_values <- aggregate_data(exprs_values, aggregate_by)
    } else {
      exprs_values <- aggregate_data(exprs_values, {{ env_id }}$aggregate_by[, input$select_aggregate_by_{{ env_id }}])
    }
  }

  return(list("data" = exprs_values, "index" = indexes, "if_samples" = samples_used))
})

clust_{{ env_id }} <- shiny::reactive({
  clustering <- input$select_clustering_{{ env_id }}
  if (clustering == "none") {
    cluster_rows <- FALSE
    cluster_columns <- FALSE
  } else if (clustering == "row") {
    cluster_rows <- TRUE
    cluster_columns <- FALSE
  } else if (clustering == "column") {
    cluster_rows <- FALSE
    cluster_columns <- TRUE
  } else if (clustering == "both") {
    cluster_rows <- TRUE
    cluster_columns <- TRUE
  }
  return(list(rows = cluster_rows, columns = cluster_columns))
})

split_by_{{ env_id }} <- shiny::reactive({
  if(input$select_split_by_{{ env_id }} == "None" | input$select_aggregate_by_{{ env_id }} != "None") {
    return(NULL)
  }
  # subset according eventdata
  eventdata <- plotly::event_data("plotly_selected", source = {{ env_id }}$transmitter)
  if (!is.null(eventdata) & exprs_values_{{ env_id }}()$if_samples){
    split_by <- {{ env_id }}$split_by[[input$select_split_by_{{ env_id }}]]
    split_by <- split_by[exprs_values_{{ env_id }}()$index]
  } else {
    split_by <- {{ env_id }}$split_by[[input$select_split_by_{{ env_id }}]]
  }
  return(split_by)
})

#
# Generate plot
#
output$plot_{{ env_id }} <- shiny::renderPlot({
  clustdist <- input$select_clustdist_{{ env_id }}
  clustmethod <- input$select_clustmethod_{{ env_id }}
  cell_fun <- NULL
  column_names_rot <- 45
  ha <- NULL

  if (input$select_aggregate_by_{{ env_id }} != "None") {
    cell_fun <- function(j, i, x, y, width, height, fill) {grid::grid.text(sprintf("%.1f", exprs_values_{{ env_id }}()$data[i, j]), x, y, gp = grid::gpar(fontsize = 10))}
  }

  # Handle annotation
  if (input$select_split_by_{{ env_id }} != "None" & input$select_aggregate_by_{{ env_id }} == "None") {
    # Use colors defined by colormap else use random colors
    if (input$select_split_by_{{ env_id }} %in% names(colormaps)){
      ha = ComplexHeatmap::HeatmapAnnotation(
        group_by = split_by_{{ env_id }}(),
        col = list(group_by = colormaps[[input$select_split_by_{{ env_id }}]])
      )
    } else {
      ha = ComplexHeatmap::HeatmapAnnotation(
        group_by = split_by_{{ env_id }}()
      )
    }
  }

  i2dash.scrnaseq::ComplexHeatmap_heatmap(
    matrix = exprs_values_{{ env_id }}()$data,
    legend_title = {{ env_id }}$legend_title,
    cluster_rows = clust_{{ env_id }}()$rows,
    cluster_columns = clust_{{ env_id }}()$columns,
    clustering_distance_rows = clustdist,
    clustering_distance_columns = clustdist,
    clustering_method_rows = clustmethod,
    clustering_method_columns = clustmethod,
    column_split = split_by_{{ env_id }}(),
    column_names_rot = column_names_rot,
    cell_fun = cell_fun,
    top_annotation = ha,
    column_title = {{ env_id }}$column_title,
    row_title = {{ env_id }}$row_title
  )
})

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

#
# 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 = "Change plot settings:")),
      shiny::plotOutput("plot_{{ env_id }}", width = "100%", height = "400px")
)

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