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

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

library(magrittr)

reduced_dim_{{ env_id }} <- {{ env_id }}$reduced_dim
expression_{{ env_id }} <- {{ env_id }}$expression
metadata_{{ env_id }} <- {{ env_id }}$metadata
featurenames <- rownames(expression_{{ env_id }})
expr_str_{{ env_id }} <- apply(expression_{{ env_id }}, 1, paste0, collapse = ";")
names(expr_str_{{ env_id }}) <- rownames(expression_{{ env_id }})
#
# Store expression data in div containers
#
data_divs <- lapply(featurenames, function(feature) {
  e <- expr_str_{{ env_id }}[[feature]]
  htmltools::div(id = paste0("expression-", feature), `data-feature` = feature, `data-expression` = e)
})
htmltools::div(data_divs)

```{js, eval=!is_shiny} /* * Function to link a div-container with a plotly scatterplot (needs to have only two traces), change the color values and the title of the plot. * @param {string} plot_id The id of the scatterplot that should be changed. * @param {string} div_id The id of the div container. * @param {string} color_by_tag The tag of the div container containing the values for the colorchange (currently as a semicolon separated string). * @param {string} title The new title of the scatterplot. / function linking_plotly_scatter(plot_id, div_id, color_by_tag, title = "") {

color_by = document.getElementById(div_id).getAttribute(color_by_tag);

// (decode the data) or split the datastring var color_by = color_by.split(';').map(function(item){return parseFloat(item);});

// get min and max values from expression var min = Math.min(...color_by); var max = Math.max(...color_by);

// update scatterplot data var scatter_update_0 = { 'marker.color': [color_by], 'marker.cmax': max, 'marker.cmin': min, 'marker.line.cmax': max, 'marker.line.cmin': min, 'marker.line.color': [color_by]};

var scatter_update_1 = { 'marker.color': [min, max], 'marker.cmax': max, 'marker.cmin': min}; // update scatterplot layout var scatter_layout_update = {title: title};

// restyle and relayout of the scatterplot Plotly.restyle(plot_id, scatter_update_0, [0]); Plotly.restyle(plot_id, scatter_update_1, [1]); Plotly.relayout(plot_id, scatter_layout_update); }

```r
default_expression <- expression_{{ env_id }}[1, ]
i2dash.scrnaseq::plotly_scatterplot(x = reduced_dim_{{ env_id }}$x, y = reduced_dim_{{ env_id }}$y, color = default_expression, colors = "YlOrRd", text = row.names(reduced_dim_{{ env_id }}), hoverinfo = "x+y+text", y_title = "Dimension 2", x_title = "Dimension 1") %>%
  plotly::layout(
    title = featurenames[1],
    autosize = F, 
    xaxis = list(title = "Dimension 1", automargin = T),
    yaxis = list(title = "Dimension 2", automargin = T)
  ) %>% 
  htmlwidgets::onRender("
                        function(el, x) {
                        // workaround for plotly.js (https://github.com/ropensci/plotly/issues/1546)
                          // get size of parents div container
                          document.getElementById('plot_{{ env_id }}').parentElement.id = 'parent_scatter_{{ env_id }}'
                          var clientHeight = document.getElementById('parent_scatter_{{ env_id }}').clientHeight;
                          var clientWidth = document.getElementById('parent_scatter_{{ env_id }}').clientWidth;

                          // avoid errors at 0 width and height
                          if (clientHeight === 0){
                            clientHeight = 450 // plotly's default value 
                          }
                          if (clientWidth === 0){
                            clientWidth = 700 // plotly's default value 
                          }

                          // get current layout and relayout plotly chart
                          var layout = el.layout;
                          layout.height = clientHeight;
                          layout.width = clientWidth;

                          Plotly.relayout(el, layout)
                        }
                        ") %>%
  plotly::toWebGL() -> plot_{{ env_id }}
plot_{{ env_id }}$elementId <- "plot_{{ env_id }}"

htmltools::div(style="display:block;float:left;width:100%;height:90%;padding-left:15px", htmltools::HTML("<p>Please select a feature in the left table to show its expression values.</p>"), plot_{{ env_id }})
ui_list <- list()

#
# Create reactive data table
#
df_{{ env_id }} <- shiny::reactive({
  selected_gene <- input$tbl_{{ env_id }}_row_last_clicked
  if(is.null(selected_gene)){
    expression <- expression_{{ env_id }}[1,] 
    featurename <- featurenames[1]
  } else {
    expression <- expression_{{ env_id }}[selected_gene,]
    featurename <- featurenames[selected_gene]
  }

  df <- data.frame("x" = reduced_dim_{{ env_id }}[,1], "y" = reduced_dim_{{ env_id }}[,2], "label" = row.names(reduced_dim_{{ env_id }}), "expression" = expression)

  return(list("df" = df, "feature" = featurename))
})

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

#
# Download
#
output$downloadData_{{ env_id }}<- shiny::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({
  i2dash.scrnaseq::plotly_scatterplot(x = df_{{ env_id }}()$df$x, y = df_{{ env_id }}()$df$y, color = df_{{ env_id }}()$df$expression, colors = "YlOrRd", text = df_{{ env_id }}()$df$label, hoverinfo = "x+y+text", y_title = "Dimension 2", x_title = "Dimension 1") %>%
  plotly::layout(
    title = df_{{ env_id }}()$feature
  ) %>% plotly::toWebGL() -> scatter
  scatter
})

#
# 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:")),
      htmltools::div(style="display:block;float:left;width:100%;height:85%;padding-left:15px", htmltools::HTML("<p>Please select a feature in the left table to show its expression values.</p>"), 
                     renderUI({plotly::plotlyOutput("plot_scatter_{{ env_id }}", height = "100%")}))
)

Column

cbind(metadata_{{ env_id }}) %>%
  DT::datatable(filter = 'top',
                selection = list(mode = 'single', target = 'row'),
                options = list(pageLength = 100),
    callback = DT::JS("table.on('click.dt', 'tr', function() {

    var id_scatter = 'plot_{{ env_id }}',
    feature_name = table.row(this).data()[0],
    feature_div_id = 'expression-'.concat(feature_name);

    linking_plotly_scatter(plot_id = id_scatter, div_id = feature_div_id, color_by_tag = 'data-expression', title = feature_name);

    // highlight selected row of the table
    if ( $(this).hasClass('selected') ) {
        $(this).removeClass('selected');
    }
    else {
        table.$('tr.selected').removeClass('selected');
        $(this).addClass('selected');
    }
    })"))
output$tbl_{{ env_id }} <- DT::renderDataTable({
  options(DT.options = list(scrollY="400px",scrollX="300px", pageLength = 100, autoWidth = TRUE))
  DT::datatable(metadata_{{ env_id }}, filter = 'top', selection = list(mode = 'single', selected = 1, target = 'row'))
})

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


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