{{ env_id }} = readRDS(file.path(datadir, "{{ env_id }}.rds"))

is_shiny <- identical(knitr::opts_knit$get("rmarkdown.runtime"), "shiny")

library(magrittr)
library(scater)

calculateUMAP_{{ env_id }} <- {{ env_id }}$calculateUMAP
calculateTSNE_{{ env_id }} <- {{ env_id }}$calculateTSNE
exprs_values_{{ env_id }} <- {{ env_id }}$exprs_values
seed_{{ env_id }} <- {{ env_id }}$seed

Inputs {.sidebar}

# linking the "delete" buttons to shiny with js
tags$script("$(document).on('click', '#tbl_{{ env_id }} button', function () {
    Shiny.onInputChange('lastClickId',this.id);
    Shiny.onInputChange('lastClick', Math.random())
    });")

selectInput("select_dimred_{{ env_id }}", label = "Select dimensionality reduction method:", choices = list("UMAP", "t-SNE"))

output$set_param1_{{ env_id }} <- renderUI({
  if(input$select_dimred_{{ env_id }} == "UMAP"){
    sliderInput("select_n_neighbors_{{ env_id }}", label = "Set n_neighbors:", min = 2, max = 100, step = 1, value = 15)
  } else {
    sliderInput("select_theta_{{ env_id }}", label = "Set theta:", min = 0, max = 1, step = 0.1, value = 0.5)
  }
})
uiOutput("set_param1_{{ env_id }}")

output$set_param2_{{ env_id }} <- renderUI({
  if(input$select_dimred_{{ env_id }} == "t-SNE"){
    sliderInput("select_perplexity_{{ env_id }}", label = "Set perplexity:", min = 5, max = 50, step = 5, value = 25)
  }
})
uiOutput("set_param2_{{ env_id }}")


# action button
actionButton("generate_{{ env_id }}", label = "Generate plot")

# action button
actionButton("add_{{ env_id }}", label = "Add plot for comparison")

DT::dataTableOutput('tbl_{{ env_id }}')

Column {.tabset}

Dimension reduction

htmltools::HTML("<div class='alert alert-warning' role='alert'>
  <h4>This page can only be used with the shiny-based interactive mode.</h4>
</div>")
reactive_{{ env_id }} <- eventReactive(input$generate_{{ env_id }}, {
  set.seed(seed_{{ env_id }})

  if(input$select_dimred_{{ env_id }} == "UMAP"){
    calculateUMAP_{{ env_id }}$x <- exprs_values_{{ env_id }}
    calculateUMAP_{{ env_id }}$n_neighbors <- input$select_n_neighbors_{{ env_id }}
    dimred <- do.call(scater::calculateUMAP, calculateUMAP_{{ env_id }})
    name <- paste0("<b>UMAP:</b> n-neighbors: ", input$select_n_neighbors_{{ env_id }})
  } else {
    calculateTSNE_{{ env_id }}$x <- exprs_values_{{ env_id }}
    calculateTSNE_{{ env_id }}$perplexity <- input$select_perplexity_{{ env_id }}
    calculateTSNE_{{ env_id }}$theta <- input$select_theta_{{ env_id }}
    dimred <- do.call(scater::calculateTSNE, calculateTSNE_{{ env_id }})
    name <- paste0("<b>t-SNE:</b> theta: ", input$select_theta_{{ env_id }}, "; perplexity: ", input$select_perplexity_{{ env_id }})
  }

  x <- dimred[,1]
  y <- dimred[,2]
  labels <- rownames(dimred)

  # generate scatterplot
  p <- i2dash.scrnaseq::plotly_scatterplot(x = x, y = y, color = NULL, text = labels, y_title = "Dimension 2", x_title = "Dimension 1", name = name, type = "scatter")

  return(list(plot = p, name = name))
})

# render the plot of the main tab
output$plot_{{ env_id }} <- plotly::renderPlotly({
  reactive_{{ env_id }}()$plot %>%
    plotly::layout(
      title = reactive_{{ env_id }}()$name
    )
})
plotly::plotlyOutput("plot_{{ env_id }}")

# a list with selected plots
plot_list_{{ env_id }} <- reactiveValues(
  plot_list = NULL
)

# add current plot to the list of plots
observeEvent(input$add_{{ env_id }},{
  reactive_{{ env_id }}()$name %>%
    gsub(pattern = "</?b>", replacement = "") %>%
    gsub(pattern = ":", replacement = "=") %>%
    gsub(pattern = "\\s", replacement = "") %>%
    gsub(pattern = ";", replacement = "_") -> name
  plot_list_{{ env_id }}$plot_list[[name]] <- reactive_{{ env_id }}()$plot
})

# remove plot from list if button is clicked
observeEvent(input$lastClick, {
  row_to_del=as.numeric(gsub("delete_","",input$lastClickId))
  plot_list_{{ env_id }}$plot_list=plot_list_{{ env_id }}$plot_list[-row_to_del]

})

# render table with saved plots
output$tbl_{{ env_id }} <- DT::renderDataTable({
  if(!is.null(plot_list_{{ env_id }}$plot_list)){
    if(length(plot_list_{{ env_id }}$plot_list) > 0){
      df <- data.frame("plots" = names(plot_list_{{ env_id }}$plot_list))
      df$plots %<>%
        gsub(pattern = "t-SNE=", replacement = "<b>t-SNE</b></br>") %>%
        gsub(pattern = "UMAP=", replacement = "<b>UMAP</b></br>") %>%
        gsub(pattern = "_", replacement = "</br>")
      df[["Actions"]]<-
  paste0('
  <button type="button" class="btn btn-secondary delete" id=delete_',1:nrow(df),'>Delete</button>')
      DT::datatable(df, options = list(searching = FALSE), escape=F)
    }
  }
})

Compare selected plots

htmltools::HTML("<div class='alert alert-warning' role='alert'>
  <h4>This page can only be used with the shiny-based interactive mode.</h4>
</div>")
# render the subplot
output$subplot_{{ env_id }} <- plotly::renderPlotly({
  plot_list <- NULL
  if(!is.null(plot_list_{{ env_id }}$plot_list)){
    plot_list <- plot_list_{{ env_id }}$plot_list
    if(length(plot_list_{{ env_id }}$plot_list) ==  1 & names(plot_list[1]) != "nrows"){
      return(do.call(plotly::subplot, plot_list))
    } else if(length(plot_list_{{ env_id }}$plot_list) > 1) {
      nrows <- ceiling(sqrt(length(plot_list_{{ env_id }}$plot_list)))
      plot_list$nrows <- nrows
      return(do.call(plotly::subplot, plot_list))
    } else if(length(plot_list) ==  1 & names(plot_list[1]) == "nrows"){
      plot_list <- list()
      return(NULL)
    }
  }
})
plotly::plotlyOutput("subplot_{{ env_id }}")


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