johrpan/geposanui
1
0
Fork 0
mirror of https://github.com/johrpan/geposanui.git synced 2025-10-26 19:27:24 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

details: Adapt to methods dynamically

Browse source
This commit is contained in:
Elias Projahn 2022-08-17 17:44:33 +02:00
parent 1938b7e0d1
commit bb15771f22
2 changed files with 51 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

55
R/details.R
View file

@ -19,11 +19,12 @@ details_ui <- function(id) {
#' Server for the detailed results panel. #' Server for the detailed results panel.
#' #'
#' @param preset A reactive containing the preset that has been used.
#' @param filtered_results A reactive containing the prefiltered results to be #' @param filtered_results A reactive containing the prefiltered results to be
#' displayed. #' displayed.
#' #'
#' @noRd #' @noRd
details_server <- function(id, filtered_results) { details_server <- function(id, preset, filtered_results) {
moduleServer(id, function(input, output, session) { moduleServer(id, function(input, output, session) {
output$copy <- renderUI({ output$copy <- renderUI({
results <- filtered_results() results <- filtered_results()
@ -51,11 +52,12 @@ details_server <- function(id, filtered_results) {
) )
}) })
methods <- geposan::all_methods() columns <- reactive({
methods <- preset()$methods
method_ids <- sapply(methods, function(method) method$id) method_ids <- sapply(methods, function(method) method$id)
method_names <- sapply(methods, function(method) method$name) method_names <- sapply(methods, function(method) method$name)
columns <- c( column_ids <- c(
"rank", "rank",
"gene", "gene",
"name", "name",
@ -77,44 +79,45 @@ details_server <- function(id, filtered_results) {
"Percentile" "Percentile"
) )
output_data <- reactive({ list(
filtered_results()[, ..columns][ method_ids = method_ids,
, column_ids = column_ids,
distance := paste0( column_names = column_names
format(
round(distance / 1000000, digits = 2),
nsmall = 2,
),
" Mbp"
) )
] })
output_data <- reactive({
column_ids <- columns()$column_ids
filtered_results()[, ..column_ids]
}) })
output$download <- downloadHandler( output$download <- downloadHandler(
filename = "geposan_filtered_results.csv", filename = "geposan_filtered_results.csv",
content = function(file) { content = \(file) fwrite(output_data(), file = file),
fwrite(output_data(), file = file)
},
contentType = "text/csv" contentType = "text/csv"
) )
output$genes <- DT::renderDT({ output$genes <- DT::renderDT({
dt <- DT::datatable( columns <- columns()
output_data(),
data <- copy(output_data())
data[, distance := glue::glue(
"{format(round(distance / 1000000, digits = 2), nsmall = 2)} Mbp"
)]
DT::datatable(
data,
rownames = FALSE, rownames = FALSE,
colnames = column_names, colnames = columns$column_names,
selection = "none",
options = list( options = list(
rowCallback = js_link(), rowCallback = js_link(),
columnDefs = list(list(visible = FALSE, targets = 2)), columnDefs = list(list(visible = FALSE, targets = 2)),
pageLength = 25 pageLength = 25
) )
) ) |>
DT::formatRound(c(columns$method_ids, "score"), digits = 4) |>
DT::formatPercentage( DT::formatPercentage("percentile", digits = 2)
dt,
c(method_ids, "score", "percentile"),
digits = 2
)
}) })
}) })
} }

2
R/results.R
View file

@ -206,7 +206,7 @@ results_server <- function(id, options, analysis) {
results_filtered <- filters_server("filters", results) results_filtered <- filters_server("filters", results)
# Server for the detailed results panel. # Server for the detailed results panel.
details_server("results", results_filtered) details_server("results", preset, results_filtered)
output$rank_plot <- plotly::renderPlotly({ output$rank_plot <- plotly::renderPlotly({
preset <- preset() preset <- preset()