Skip to content
This repository has been archived by the owner. It is now read-only.
Permalink
Browse files
update templates (apparently I forgot earlier)
  • Loading branch information
@HendrikSchultheis
HendrikSchultheis committed Jul 26, 2019
1 parent 5ac1047 commit 6e3761b80b52295e404623c10a6aaebd184ddb19
Show file tree
Hide file tree
Showing 3 changed files with 267 additions and 562 deletions.
230 inst/templates/geneView_wilson.Rmd
View file
@@ -4,7 +4,7 @@
<!-- Component created on {{ date }} -->

```{r}
{{ env_id }} <- readRDS("envs/{{ env_id }}.rds")
{{ env_id }} = readRDS("envs/{{ env_id }}.rds")
is_shiny <- identical(knitr::opts_knit$get("rmarkdown.runtime"), "shiny")
```
@@ -53,7 +53,10 @@ plot
```

```{r, eval=is_shiny}
################ UI ####################
#########
library(shinyWidgets)
#############
ui_list <- list()
# select type of plot
@@ -85,188 +88,99 @@ ui_list <- rlist::list.append(ui_list,
)
# selection column number of plot
ui_list <- rlist::list.append(ui_list,
sliderInput("colnumber_{{ env_id }}", label = "Number of plot columns:", min = 1, max = 7, value = 3)
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')))
################# Server ####################
# if component is a reciever
if({{ env_id }}$compId %in% edgeTable$reciever){
#
# Create reactive data table
#
df_{{ env_id }} <- shiny::reactive({
# set variables
reciever_{{ env_id }} <- {{ env_id }}$compId
transmitter_to_{{ env_id }} <- edgeTable[reciever=={{ env_id }}$compId]$transmitter
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
}
additional_arguments$plot.method <- "static"
# Set values for 'group_by' and 'countTable'
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 }}]
}
countTable <- {{ env_id }}$countTable
# subset countTable according to transmitted sample keys
plot_transmitter_string <- paste0("plot_env_", transmitter_to_{{ env_id }})
keys_transmitter_string <- paste0("df_env_", transmitter_to_{{ env_id }}, "()$key")
selection_transmitter <- plotly::event_data("plotly_selected", source = plot_transmitter_string)$key
if(!is.null(selection_transmitter)){
if(all(selection_transmitter %in% colnames(countTable))){
countTable <- subset(countTable, select = selection_transmitter)
# subset group_by according to countTable
group_by <- group_by[[1]][which(colnames(countTable) == selection_transmitter)]
group_by <- list("group_by" = group_by)
} else {
false_keys <- which(!(selection_transmitter %in% colnames(countTable)))
print("The following keys are not in the countTable:")
print(selection_transmitter[false_keys])
if(!is.null(ncol(selection_transmitter[-false_keys]))){
selection_transmitter <- selection_transmitter[-false_keys]
countTable <- subset(countTable, select = selection_transmitter)
# subset group_by according to countTable
group_by <- group_by[[1]][which(colnames(countTable) == selection_transmitter)]
group_by <- list("group_by" = group_by)
}
}
}
# 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]
}
}
# 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]])
download_dt <- data.table::data.table("features" = rownames(countTable), "factor" = group_by[[1]], countTable)
additional_arguments$data <- data
additional_arguments$grouping <- grouping
#additional_arguments$width <- 20
#additional_arguments$height <- 15
return(list("params" = additional_arguments, "data" = download_dt))
})
} else {
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
}
additional_arguments$plot.method <- "static"
# Set values for 'group_by' and 'countTable'
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 }}]
}
countTable <- {{ env_id }}$countTable
# 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]
}
# 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]])
download_dt <- data.table::data.table("features" = rownames(countTable), "factor" = group_by[[1]], countTable)
additional_arguments$data <- data
additional_arguments$grouping <- grouping
#additional_arguments$width <- 20
#additional_arguments$height <- 15
return(list("params" = additional_arguments, "data" = download_dt))
})
}
}
# 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)
}
)
# works as transmitter with brushopt
plot_{{ env_id }} <- shiny::reactive({
if(!is.null(input$select_subset_{{ env_id }})){
output_list <- do.call(wilson::create_geneview, df_{{ env_id }}()$params)
dt <- output_list$plot$data
return(dt)
}
})
#
# Output
output$plot_{{ env_id }} <- renderPlot({
#
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)
gg <- output_list$plot
gg
#p <- plotly::ggplotly(gg)
#p
plot <- output_list$plot
plot
}
# convert to plotly object for automatic resizing
})
#
# 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)),
dropdownButton(do.call(shiny::inputPanel, ui_list),
circle = TRUE, status = "danger", icon = icon("gear"), width = "300px",
tooltip = shinyWidgets::tooltipOptions(title = "Click, to change plot settings:")),
plotOutput("plot_{{ env_id }}", width = "100%",click = "plot1_click",
brush = brushOpts(
id = "plot1_brush"
))
tooltip = tooltipOptions(title = "Click, to change plot settings:")),
plotOutput("plot_{{ env_id }}")
)
```

0 comments on commit 6e3761b

Please sign in to comment.