{{ 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
# 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 }}')
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) } } })
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 }}")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.