{{ title }}

{{ env_id }} = readRDS("envs/{{ env_id }}.rds")

is_shiny <- identical(knitr::opts_knit$get("rmarkdown.runtime"), "shiny")
# Parameters for wilson::create_geneview()
# params <- list()
"%ni%" <- Negate("%in%")
additional_arguments <- {{ env_id }}$additional_arguments

if("plot.type" %ni% names({{ env_id }}$additional_arguments)){
  additional_arguments$plot.type <- "line"
}
if("facet.target" %ni% names({{ env_id }}$additional_arguments)){
  additional_arguments$facet.target <- "gene"
}
if("facet.cols" %ni% names({{ env_id }}$additional_arguments)){
  additional_arguments$facet.cols <- 3
}
if("color" %ni% names({{ env_id }}$additional_arguments)){
  color <- RColorBrewer::brewer.pal(8, "Accent")
  additional_arguments$color <- color
}

# force static
additional_arguments$plot.method <- "static"

# set variables
countTable <- {{ env_id }}$countTable
group_by <- {{ env_id }}$group_by[1]

# create data.tables "data" and "grouping" from provided data
data <- data.table::data.table("features" = rownames(countTable), countTable)
grouping <- data.table::data.table("keys" = colnames(countTable), "factor" = group_by[[1]])

additional_arguments$data <- data
additional_arguments$grouping <- grouping

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

# Render plot
output_list <- do.call(wilson::create_geneview, additional_arguments)
plot <- output_list$plot
plot
#########
library(shinyWidgets)
#############

ui_list <- list()

# select type of plot
ui_list <- rlist::list.append(ui_list,
                                selectInput("select_type_{{ env_id }}", label = "Type of Plot:",
                                            choices = c("line", "box", "violin", "bar"), selected = "line"))

# subset features
ui_list <- rlist::list.append(ui_list,
                                selectInput("select_subset_{{ env_id }}",
                                  label = "Select features:",
                                  choices = rownames({{ env_id }}$countTable),
                                  multiple = TRUE)
                              )

# 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)))
}
# selection grouping by
ui_list <- rlist::list.append(ui_list,
                                selectInput("select_by_{{ env_id }}",
                                  label = "Grouping by:",
                                  choices = c("gene", "condition"),
                                  selected = "gene",
                                  multiple = FALSE)
                              )
# selection column number of plot
ui_list <- rlist::list.append(ui_list,
                                sliderInput("colnumber_{{ env_id }}", label = h3("Plot columns:"), min = 1, max = 7, value = 3)
                              )

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

#
# Create reactive data table
#
df_{{ env_id }} <- shiny::reactive({

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

    # type of plot
  additional_arguments$plot.type <- input$select_type_{{ env_id }}

  # type of grouping by
  additional_arguments$facet.target <- input$select_by_{{ env_id }}

  # number of columns in plot
  additional_arguments$facet.cols <- input$colnumber_{{ env_id }}

  if("color" %ni% names({{ env_id }}$additional_arguments)){
    color <- RColorBrewer::brewer.pal(8, "Accent")
    additional_arguments$color <- color
  }

  # force static
  additional_arguments$plot.method <- "static"

  # 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
  countTable <- {{ env_id }}$countTable

  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.tables "data" and "grouping" from provided data
  data <- data.table::data.table("features" = rownames(countTable), countTable)
  grouping <- data.table::data.table("keys" = colnames(countTable), "factor" = group_by[[1]])

  additional_arguments$data <- data
  additional_arguments$grouping <- grouping
  return(list("params" = additional_arguments, "data" = data, "grouping" = grouping))
})

#
# Download
#
############
# To do: provide both data.frames for 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 }} <- shiny::renderPlot({
    if(!is.null(input$select_subset_{{ env_id }})){
      output_list <- do.call(wilson::create_geneview, df_{{ env_id }}()$params)
      plot <- output_list$plot
      plot
    }
    # convert to plotly object for automatic resizing

})

#
# Layout of component
#
shiny::fillRow(flex = c(NA, 1),
        dropdownButton(do.call(shiny::inputPanel, ui_list),
                       circle = TRUE, status = "danger", icon = icon("gear"), width = "300px",
                       tooltip = tooltipOptions(title = "Click, to change plot settings:")),
        plotOutput("plot_{{ env_id }}")
)


Try the wilson package in your browser

Any scripts or data that you put into this service are public.

wilson documentation built on April 19, 2021, 5:07 p.m.