From e0570907980ddec7711c929cf4431347a20eb3e7 Mon Sep 17 00:00:00 2001 From: cristianetaniguti Date: Thu, 2 Jun 2022 12:53:27 -0500 Subject: [PATCH] disable download #35 --- R/app_ui.R | 5 +++-- R/mod_genes_view.R | 30 +++++++++++++++++++++++--- R/mod_map_view.R | 40 +++++++++++++++++++++++++++++++---- R/mod_qtl_view.R | 52 +++++++++++++++++++++++++++++++++++++++++----- R/mod_upload.R | 18 +++++++++++++--- 5 files changed, 128 insertions(+), 17 deletions(-) diff --git a/R/app_ui.R b/R/app_ui.R index a48e97f..7ebe20e 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -19,8 +19,9 @@ app_ui <- function(request) { dashboardSidebar(disable = TRUE), dashboardBody( # Lab colors - tags$head(tags$style(HTML(' - + tags$head( + tags$style( + HTML(' a.action-button { color: #6c81c0; } diff --git a/R/mod_genes_view.R b/R/mod_genes_view.R index cb42e7e..e5f9267 100644 --- a/R/mod_genes_view.R +++ b/R/mod_genes_view.R @@ -4,7 +4,7 @@ #' #' @param id,input,output,session Internal parameters for {shiny}. #' -#' @importFrom shinyjs inlineCSS +#' @importFrom shinyjs inlineCSS useShinyjs #' #' @noRd #' @@ -71,7 +71,9 @@ mod_genes_view_ui <- function(id){ ) ), column(3, - downloadBttn(ns('bn_download'), style = "gradient", color = "royal") + useShinyjs(), + tags$head(tags$style(".butt{background-color:#add8e6; border-color: #add8e6; color: #337ab7;}")), + downloadButton(ns('bn_download'), "Download", class = "butt") ), column(3, radioButtons(ns("fformat"), "File type", choices=c("png","tiff","jpeg","pdf"), selected = "png", inline = T) @@ -98,7 +100,7 @@ mod_genes_view_ui <- function(id){ ) ), column(3, - downloadBttn(ns('bn_download_phi'), style = "gradient", color = "royal") + downloadButton(ns('bn_download_phi'), "Download", class = "butt") ), column(3, radioButtons(ns("fformat_phi"), "File type", choices=c("png","tiff","jpeg","pdf"), selected = "png", inline = T) @@ -624,6 +626,16 @@ mod_genes_view_server <- function(input, output, session, units = "mm", dpi = input$dpi_profile) } + observe({ + if (!is.null(loadQTL()) & input$width_profile > 1 & input$height_profile > 1 & input$dpi_profile > 1) { + Sys.sleep(1) + # enable the download button + shinyjs::enable("bn_download") + } else { + shinyjs::disable("bn_download") + } + }) + # download handler output$bn_download <- downloadHandler( filename = fn_downloadname, @@ -667,6 +679,18 @@ mod_genes_view_server <- function(input, output, session, units = "mm", dpi = input$dpi_phi) } + observe({ + if (!is.null(loadMap()) & input$width_phi > 1 & input$height_phi > 1 & input$dpi_phi > 1) { + if (loadMap()$software != "polymapR" ) { + Sys.sleep(1) + # enable the download button + shinyjs::enable("bn_download_phi") + } else { + shinyjs::disable("bn_download_phi") + } + } else shinyjs::disable("bn_download_phi") + }) + # download handler output$bn_download_phi <- downloadHandler( filename = fn_downloadname_phi, diff --git a/R/mod_map_view.R b/R/mod_map_view.R index 8025078..7c03b02 100644 --- a/R/mod_map_view.R +++ b/R/mod_map_view.R @@ -4,7 +4,7 @@ #' #' @param id,input,output,session Internal parameters for {shiny}. #' -#' @importFrom shinyjs inlineCSS +#' @importFrom shinyjs inlineCSS useShinyjs #' @importFrom plotly plotlyOutput #' @importFrom shiny NS tagList #' @@ -72,7 +72,9 @@ mod_map_view_ui <- function(id){ ) ), column(3, - downloadBttn(ns('bn_download'), style = "gradient", color = "royal") + tags$head(tags$style(".butt{background-color:#add8e6; border-color: #add8e6; color: #337ab7;}")), + useShinyjs(), + downloadButton(ns('bn_download'), "Download", class = "butt") ), column(3, radioButtons(ns("fformat"), "File type", choices=c("png","tiff","jpeg","pdf"), selected = "png", inline = T) @@ -99,7 +101,7 @@ mod_map_view_ui <- function(id){ ) ), column(3, - downloadBttn(ns('bn_download_map'), style = "gradient", color = "royal") + downloadButton(ns('bn_download_map'), "Download", class = "butt") ), column(3, radioButtons(ns("fformat_map"), "File type", choices=c("png","tiff","jpeg","pdf"), selected = "png", inline = T) @@ -133,7 +135,7 @@ mod_map_view_ui <- function(id){ DT::dataTableOutput(ns("summary")), br(), hr() ), column(3, - downloadBttn(ns('bn_download_summary'), style = "gradient", color = "royal") + downloadButton(ns('bn_download_summary'), "Download", class = "butt") ), column(3, radioButtons(ns("fformat_summary"), "File type", choices=c("png","tiff","jpeg","pdf"), selected = "png", inline = T), br(), @@ -429,6 +431,16 @@ mod_map_view_server <- function(input, output, session, units = "mm", dpi = input$dpi_profile) } + observe({ + if (!is.null(loadQTL()) & input$width_profile > 1 & input$height_profile > 1 & input$dpi_profile > 1) { + Sys.sleep(1) + # enable the download button + shinyjs::enable("bn_download") + } else { + shinyjs::disable("bn_download") + } + }) + # download handler output$bn_download <- downloadHandler( filename = fn_downloadname, @@ -482,6 +494,16 @@ mod_map_view_server <- function(input, output, session, dev.off() } + observe({ + if (!is.null(loadMap()) & input$width_map > 1 & input$height_map > 1 & input$dpi_map > 1) { + Sys.sleep(1) + # enable the download button + shinyjs::enable("bn_download_map") + } else { + shinyjs::disable("bn_download_map") + } + }) + # download handler output$bn_download_map <- downloadHandler( filename = fn_downloadname_map, @@ -529,6 +551,16 @@ mod_map_view_server <- function(input, output, session, dev.off() } + observe({ + if (!is.null(loadMap()) & input$width_summary > 1 & input$height_summary > 1 & input$dpi_summary > 1) { + Sys.sleep(1) + # enable the download button + shinyjs::enable("bn_download_summary") + } else { + shinyjs::disable("bn_download_summary") + } + }) + # download handler output$bn_download_summary <- downloadHandler( filename = fn_downloadname_summary, diff --git a/R/mod_qtl_view.R b/R/mod_qtl_view.R index a51dffa..bd4ad2a 100644 --- a/R/mod_qtl_view.R +++ b/R/mod_qtl_view.R @@ -6,6 +6,7 @@ #' #' @import shinydashboard #' @import shinyWidgets +#' @importFrom shinyjs inlineCSS useShinyjs #' #' @noRd #' @@ -72,7 +73,9 @@ mod_qtl_view_ui <- function(id){ ), column(12, column(3, - downloadBttn(ns('bn_download'), style = "gradient", color = "royal") + useShinyjs(), + tags$head(tags$style(".butt{background-color:#add8e6; border-color: #add8e6; color: #337ab7;}")), + downloadButton(ns('bn_download'), "Download", class = "butt") ), column(3, radioButtons(ns("fformat"), "File type", choices=c("png","tiff","jpeg","pdf"), selected = "png", inline = T) @@ -105,7 +108,7 @@ mod_qtl_view_ui <- function(id){ selected = "bar") ), br(), br(), column(3, - downloadBttn(ns('bn_download_effects'), style = "gradient", color = "royal") + downloadButton(ns('bn_download_effects'), "Download", class = "butt") ), column(3, radioButtons(ns("fformat_effects"), "File type", choices=c("png","tiff","jpeg","pdf"), selected = "png", inline = T) @@ -151,7 +154,7 @@ mod_qtl_view_ui <- function(id){ actionBttn(ns("haplo_submit"), style = "jelly", color = "royal", size = "sm", label = "submit selected haplotypes*", icon = icon("share-square", verify_fa = FALSE)), br(), hr()), column(3, - downloadBttn(ns('bn_download_haplo'), style = "gradient", color = "royal") + downloadButton(ns('bn_download_haplo'), "Download", class = "butt") ), column(3, radioButtons(ns("fformat_haplo"), "File type", choices=c("png","tiff","jpeg","pdf"), selected = "png", inline = T) @@ -315,9 +318,8 @@ mod_qtl_view_server <- function(input, output, session, need(!is.null(input$plot_brush), "Select at least one triangle on the bottom of the QTL profile graphic. The triangles refer to QTL peaks detected. You can click and brush your cursor to select more than one.") ) df <- try(brushedPoints(qtl.data()[[2]], input$plot_brush, xvar = "x", yvar = "y.dat")) - validate( - need(!inherits(df, "try-error"), "Select at least one triangle on the bottom of the QTL profile graphic. The triangles refer to QTL peaks detected. You can click and brush your cursor to select more than one.") + need(dim(df)[1] > 0, "Select at least one triangle on the bottom of the QTL profile graphic. The triangles refer to QTL peaks detected. You can click and brush your cursor to select more than one.") ) withProgress(message = 'Working:', value = 0, { incProgress(0.5, detail = paste("Getting data...")) @@ -517,6 +519,16 @@ mod_qtl_view_server <- function(input, output, session, width = input$width_profile, height = input$height_profile, units = "mm", dpi = input$dpi_profile) } + observe({ + if (!is.null(loadQTL()) & input$width_profile > 1 & input$height_profile > 1 & input$dpi_profile > 1) { + Sys.sleep(1) + # enable the download button + shinyjs::enable("bn_download") + } else { + shinyjs::disable("bn_download") + } + }) + # download handler output$bn_download <- downloadHandler( filename = fn_downloadname, @@ -563,6 +575,25 @@ mod_qtl_view_server <- function(input, output, session, width = input$width_effects, units = "mm", bg = "white", dpi = input$dpi_effects) } + shinyjs::disable("bn_download_effects") + + # To make observeEvent watch more than one input + toListen <- reactive({ + list(input$plot_brush, input$plot_brush, input$width_effects, input$height_effects, input$dpi_effects) + }) + + observeEvent(toListen(),{ + df <- brushedPoints(qtl.data()[[2]], input$plot_brush, xvar = "x", yvar = "y.dat") + + if (dim(df)[1] > 0 & !is.null(loadQTL()) & !is.null(input$plot_brush) & input$width_effects > 1 & input$height_effects > 1 & input$dpi_effects > 1) { + Sys.sleep(1) + # enable the download button + shinyjs::enable("bn_download_effects") + } else { + shinyjs::disable("bn_download_effects") + } + }) + # download handler output$bn_download_effects <- downloadHandler( filename = fn_downloadname_effects, @@ -574,6 +605,7 @@ mod_qtl_view_server <- function(input, output, session, ) # Download haplotypes + shinyjs::disable("bn_download_haplo") # create filename fn_downloadname_haplo <- reactive({ @@ -595,6 +627,16 @@ mod_qtl_view_server <- function(input, output, session, width = input$width_haplo, units = "mm", bg = "white", dpi = input$dpi_haplo) } + observe({ + if (input$haplo_submit & length(grep("Trait",input$haplo)) > 0 & !is.null(input$plot_brush) & input$height_haplo > 1 & input$width_haplo > 1 & input$dpi_haplo > 1) { + Sys.sleep(1) + # enable the download button + shinyjs::enable("bn_download_haplo") + } else { + shinyjs::disable("bn_download_haplo") + } + }) + # download handler output$bn_download_haplo <- downloadHandler( filename = fn_downloadname_haplo, diff --git a/R/mod_upload.R b/R/mod_upload.R index 0f264dc..2da8a61 100644 --- a/R/mod_upload.R +++ b/R/mod_upload.R @@ -5,7 +5,8 @@ #' @param id,input,output,session Internal parameters for {shiny}. #' #' @noRd -#' +#' +#' @importFrom shinyjs inlineCSS useShinyjs #' @importFrom shiny NS tagList mod_upload_ui <- function(id){ ns <- NS(id) @@ -236,8 +237,9 @@ mod_upload_ui <- function(id){ box(id = ns("box_viewpoly"),width = 12, solidHeader = TRUE, collapsible = TRUE, collapsed = TRUE, status="info", title = actionLink(inputId = ns("viewpolyID"), label = tags$b("Download VIEWpoly dataset")), p("The uploaded data are converted to the viewpoly format. It keeps the map and the QTL information. Genome information is not stored."), br(), textInput(ns("data.name"), label = p("Define the dataset name. Do not use spaces between words."), value = "dataset_name"), br(), - - downloadBttn(ns('export_viewpoly'), style = "gradient", color = "royal") + tags$head(tags$style(".butt{background-color:#add8e6; border-color: #add8e6; color: #337ab7;}")), + useShinyjs(), + downloadButton(ns('export_viewpoly'), "Download", class = "butt") ) ) ), @@ -927,6 +929,16 @@ loadQTL = reactive({ } }) +observe({ + if (!is.null(loadMap()) | !is.null(loadQTL())) { + Sys.sleep(1) + # enable the download button + shinyjs::enable("export_viewpoly") + } else { + shinyjs::disable("export_viewpoly") + } +}) + output$export_viewpoly <- downloadHandler( filename = function() { paste0("viewpoly.RData")