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)

# selecting the first numeric and factor column for object wrapper 
{{ env_id }}$y %>%
  as.data.frame() %>%
  dplyr::select_if(function(col) is.integer(col) | is.numeric(col)) %>%
  dplyr::select(1) -> y_{{ env_id }}

if(!is.null({{ env_id }}$group_by)){
  {{ env_id }}$group_by %>%
    as.data.frame() %>%
    dplyr::select_if(is.factor) %>%
    dplyr::select(1) -> group_by_{{ env_id }}
  group_by_title_{{ env_id }} <- colnames(group_by_{{ env_id }})
} else {
  group_by_title_{{ env_id }} <- NULL
  group_by_{{ env_id }} <- NULL
}

# compare with colormaps
if(!is.null(group_by_title_{{ env_id }})){
  if(group_by_title_{{ env_id }} %in% names(colormaps)) colors_{{ env_id }} <- colormaps[[group_by_title_{{ env_id }}]] else colors_{{ env_id }} <- "Set1"
} else {
  colors_{{ env_id }} <- "Set1"
}

# set title variables
if(!is.null({{ env_id }}$y_title)) y_title_{{ env_id }} <- {{ env_id }}$y_title else y_title_{{ env_id }} <- colnames(y_{{ env_id }})
if(!is.null({{ env_id }}$group_by_title)) group_by_title_{{ env_id }} <- {{ env_id }}$group_by_title

# creating the plot object
plot_{{ env_id }} <- i2dash.scrnaseq::plotly_violinplot(y = y_{{ env_id }}[,1], group_by = group_by_{{ env_id }}[,1], y_title = y_title_{{ env_id }}, group_by_title = group_by_title_{{ env_id }}, colors = colors_{{ env_id }})

# Provide data for download
if(!is.null({{ env_id }}$group_by)) download_df_{{ env_id }} <- data.frame(y_{{ env_id }}, group_by_{{ env_id }}) else download_df_{{ env_id }} <- data.frame(y_{{ env_id }})
rownames(download_df_{{ env_id }}) <- rownames({{ env_id }}$y)
htmltools::div(style="display:block;float:left;width:100%;height:90%;",
  htmltools::tags$button(i2dash::embed_var(download_df_{{ env_id }})), plot_{{ env_id }}
)

ui_list <- list()

#
# shiny input widget for y
#
if ({{ env_id }}$y_selection){
  ui_list <- rlist::list.append(ui_list,
                                selectInput("select_y_{{ env_id }}", label = "Select observations:",
                                            choices = colnames({{ env_id }}$y[lapply({{ env_id }}$y,class) =="numeric" | lapply({{ env_id }}$y,class) =="integer"])))
}

#
# shiny input widget for group_by
#
if ({{ env_id }}$group_by_selection){
  ui_list <- rlist::list.append(ui_list,
                                selectInput("select_group_by_{{ env_id }}", label = "Group observations by:",
                                            choices = colnames({{ env_id }}$group_by[lapply({{ env_id }}$group_by,class) =="factor"])))
}
#
# shiny download button
#
ui_list <- rlist::list.append(ui_list, tags$div(tags$br(), downloadButton('downloadData_{{ env_id }}', 'Download data')))

#
# Handle inputs
#
if( !{{ env_id }}$y_selection){
  y_{{ env_id }} <- shiny::reactive({
    data <- {{ env_id }}$y[[1]]
    title <- colnames({{ env_id }}$y)[1]
    return(list(data = data, title = title))
  })
} else {
  y_{{ env_id }} <- shiny::reactive({
    data <- {{ env_id }}$y[[input$select_y_{{ env_id }}]]
    title <- input$select_y_{{ env_id }}
    return(list(data = data, title = title))
  })
}

if( !{{ env_id }}$group_by_selection ) {
  group_by_{{ env_id }} <- shiny::reactive({
    data <- {{ env_id }}$group_by[[1]]
    title <- colnames({{ env_id }}$group_by)[1]
    return(list(data = data, title = title))
  })
} else {
  group_by_{{ env_id }} <- shiny::reactive({
    data <- {{ env_id }}$group_by[[input$select_group_by_{{ env_id }}]]
    title <- input$select_group_by_{{ env_id }}
    return(list(data = data, title = title))
  })
}

#
# Download data.frame
#
output$downloadData_{{ env_id }} <- downloadHandler(
  filename =  paste('data-', Sys.Date(), '.csv', sep=''),
  content = function(file) {
    if(is.null({{ env_id }}$group_by)){
      df <- y_{{ env_id }}()$data
    } else {
      df <- data.frame(y_{{ env_id }}()$data, group_by_{{ env_id }}()$data)
    }
    rownames(df) <- rownames({{ env_id }}$y)
    write.csv(df, file)

  }
)

#
# reactive for plot creation
#
output$plot_{{ env_id }} <- plotly::renderPlotly({
  # compare with colormaps
  if(!is.null(group_by_{{ env_id }}()$title)){
    if(group_by_{{ env_id }}()$title %in% names(colormaps)) colors <- colormaps[[group_by_{{ env_id }}()$title]] else colors <- "Set1"
  } else {
    colors <- "Set1"
  }

  # set custom axis titles if provided
  if(!is.null({{ env_id }}$y_title)) y_title <- {{ env_id }}$y_title else y_title <- y_{{ env_id }}()$title
  if(!is.null({{ env_id }}$group_by_title)) group_by_title <- {{ env_id }}$group_by_title else group_by_title <- group_by_{{ env_id }}()$title

  #
  # Handle eventdata
  #
  eventdata <- plotly::event_data("plotly_selected", source = {{ env_id }}$transmitter)
  if(!is.null(eventdata)){
    keys <- rownames({{ env_id }}$y)
    indexes <- which(keys %in% eventdata$key)
    y <- y_{{ env_id }}()$data[indexes]
    if(!is.null(group_by_{{ env_id }}())) group_by <- group_by_{{ env_id }}()$data[indexes]
  } else {
    y <- y_{{ env_id }}()$data
    group_by <- group_by_{{ env_id }}()$data
  }

  i2dash.scrnaseq::plotly_violinplot(y = y, group_by = group_by, y_title = y_title, group_by_title = group_by_title, colors = colors)

})

#
# 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:")),
      plotly::plotlyOutput("plot_{{ env_id }}", height = "100%")
)

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