In loosolab/wilson: Web-Based Interactive Omics Visualization

{{ env_id }} <- readRDS("envs/{{ env_id }}.rds")

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

######
library(magrittr)
library(shinyWidgets)
#####
#
# Method for creating a data.table required by create_heatmap() method from wilson.
#
create_data.table <- function(matrix, group_by){
  # validate input
  if(ncol(matrix) != length(group_by)) stop("The length of the vector 'group_by' should be of the same length as the column number of 'matrix'.")
  # create data.table
  dt <- data.table::data.table(t(matrix))
  dt[, cell    := dimnames(matrix)[2]]
  dt[, grouping := group_by]
  # Melt
  dt <- data.table::melt(dt, id.vars = c('cell', 'grouping'), variable.name='gene')
  # Aggregate
  dt2 <- dt[, .(meanvalue = mean(value)), by = c('grouping', 'gene')]
  # Cast
  dt3 <- dt2 %>% data.table::dcast(gene ~ grouping, value.var = 'meanvalue')
  # change categorical 'gene' column to character
  dt3[[1]] <- as.character(dt3[[1]])
  return(dt3)
}

# Parameters for wilson::create_scatterplot
"%ni%" <- Negate("%in%")
additional_arguments <- {{ env_id }}$additional_arguments

if("clustering" %ni% names({{ env_id }}$additional_arguments)){
  additional_arguments$clustering <- "none"
}
if("clustdist" %ni% names({{ env_id }}$additional_arguments)){
  additional_arguments$clustdist <- "euclidean"
}
if("clustmethod" %ni% names({{ env_id }}$additional_arguments)){
  additional_arguments$clustmethod <- "average"
}
additional_arguments$plot.method <- "interactive"

if("color" %ni% names({{ env_id }}$additional_arguments)){
    color <- RColorBrewer::brewer.pal(9, "YlOrRd")
    additional_arguments$color <- color
}
# set variables
countTable <- {{ env_id }}$countTable
group_by <- {{ env_id }}$group_by[1]

 # create data.table
dt <- create_data.table('matrix' = countTable, 'group_by' = group_by[[1]])
additional_arguments$data <- dt

# Provide data for download
i2dash::embed_var(dt)

# Render plot
output_list <- do.call(wilson::create_heatmap, additional_arguments)
heatmap <- output_list$plot
# reset the width and hight of the plotly object for automatic scaling
heatmap$x$layout$height <- 0
heatmap$x$layout$width <- 0
heatmap

ui_list <- list()

# selection field for group_by
if ({{ env_id }}$group_by_selection){
  ui_list <- rlist::list.append(ui_list,
                                selectInput("select_group_by_{{ env_id }}", label = "Select grouping:",
                                            choices = names({{ env_id }}$group_by)))
}
# subset the genes
# ui_list <- rlist::list.append(ui_list,
#                                 pickerInput(
#                                   inputId = "select_subset_{{ env_id }}",
#                                   label = "Select features:",
#                                   choices = rownames({{ env_id }}$countTable),
#                                   options = list(`actions-box` = TRUE), 
#                                   multiple = TRUE)
#                               )
# subset the genes
ui_list <- rlist::list.append(ui_list,
                                selectInput("select_subset_{{ env_id }}",
                                  label = "Select features:",
                                  choices = rownames({{ env_id }}$countTable),
                                  multiple = TRUE)
                              )
# select columns
ui_list <- rlist::list.append(ui_list,
                                uiOutput("select_columns_{{ env_id }}")
                              )


# select clustering
ui_list <- rlist::list.append(ui_list,
                                selectInput("select_clustering_{{ env_id }}",
                                  label = "Select clustering:",
                                  choices = c("no clustering" = "none", "columns and rows" = "both", "only columns" = "column", "only rows" = "row"),
                         multiple = FALSE)
                              )
# select clustering distance
ui_list <- rlist::list.append(ui_list,
                                selectInput("select_clustdist_{{ env_id }}",
                                  label = "Cluster distance:",
                                  choices = c("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski", "pearson", "spearman", "kendall"),
                         multiple = FALSE)
                              )
# select clustering method
ui_list <- rlist::list.append(ui_list,
                                selectInput("select_clustmethod_{{ env_id }}",
                                  label = "Cluster method:",
                                  choices = c("average", "ward.D", "ward.D2", "single", "complete", "mcquitty"),
                         multiple = FALSE)
                              )



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

# create dynamic uiElement
output$select_columns_{{ env_id }} <- renderUI({
  # if (is.null(input$select_group_by_{{ env_id }}))
  #   return()
  # ui_list <- rlist::list.append(ui_list, selectInput("select_col_dyn_{{ env_id }}",
  #                                 label = "Select columns:",
  #                                 choices = unique({{ env_id }}$group_by[[input$select_group_by_{{ env_id }}]]),
  #                                 multiple = TRUE)
  # )
  selectInput("select_col_dyn_{{ env_id }}",
                                  label = "Select columns:",
                                  choices = unique({{ env_id }}$group_by[[input$select_group_by_{{ env_id }}]]),
                                  multiple = TRUE)

})



#
# Create reactive data table
#
df_{{ env_id }} <- shiny::reactive({
  #print(unique({{ env_id }}$group_by[[input$select_group_by_{{ env_id }}]]))
  # Parameters for wilson::create_scatterplot
  # params <- list()
  "%ni%" <- Negate("%in%")
  additional_arguments <- {{ env_id }}$additional_arguments

  # "static" not possible yet
  additional_arguments$plot.method <- "interactive"

  # Set values for 'countTable'
  countTable <- {{ env_id }}$countTable

  # Set values for 'group_by'
  if( !{{ env_id }}$group_by_selection ) {
    group_by <- {{ env_id }}$group_by[1]
  } else {
    group_by <- {{ env_id }}$group_by[input$select_group_by_{{ env_id }}]
  }

  # subset countTable by chosen features
  if(!is.null(input$select_subset_{{ env_id }})){
    subset_features <- input$select_subset_{{ env_id }}
    if(length(subset_features) > 1){
      countTable <- countTable[subset_features,]
    } else if(length(subset_features) == 1){
      countTable <- countTable[subset_features,,drop = FALSE]
    }
  }
  # subset group_by by chosen grouping
  if(!is.null(input$select_subset_{{ env_id }})){
    subset_features <- input$select_subset_{{ env_id }}
    if(length(subset_features) > 1){
      countTable <- countTable[subset_features,]
    } else if(length(subset_features) == 1){
      countTable <- countTable[subset_features,,drop = FALSE]
    }
  }

  # create data.table
  dt <- create_data.table('matrix' = countTable, 'group_by' = group_by[[1]])
  #print(dt)

  # subset group_by by chosen grouping
  if(!is.null(input$select_col_dyn_{{ env_id }})){
    column_vector <- c(c("gene"), input$select_col_dyn_{{ env_id }})
    dt <- dt[,..column_vector,]
  }


  # sequential (one-sided) color palette
  if("color" %ni% names({{ env_id }}$additional_arguments)){
    color <- RColorBrewer::brewer.pal(9, "YlOrRd")
    additional_arguments$color <- color
  }
  additional_arguments$plot.method <- "interactive"
  additional_arguments$data <- dt

  # add clustering parameters
  additional_arguments$clustering <- input$select_clustering_{{ env_id }}
  additional_arguments$clustdist <- input$select_clustdist_{{ env_id }}
  additional_arguments$clustmethod <- input$select_clustmethod_{{ env_id }}

  return(list("params" = additional_arguments, "data" = dt))
})

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

#
# Output
#
output$plot_{{ env_id }} <- plotly::renderPlotly({
  output_list <- do.call(wilson::create_heatmap, df_{{ env_id }}()$params)
  heatmap <- output_list$plot
  # reset the width and hight of the plotly object for automatic scaling
  heatmap$x$layout$height <- 0
  heatmap$x$layout$width <- 0
  heatmap
})

#
# Layout of component
#
shiny::fillRow(flex = c(NA, 1),
        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 = tooltipOptions(title = "Click, to change plot settings:")),
        plotly::plotlyOutput("plot_{{ env_id }}", width = "100%", height = "400px")
)