Skip to content

Commit

Permalink
disable download #35
Browse files Browse the repository at this point in the history
  • Loading branch information
@Cristianetaniguti
Cristianetaniguti committed Jun 2, 2022
1 parent 6c00969 commit e057090
Show file tree
Hide file tree
Showing 5 changed files with 128 additions and 17 deletions.
5 changes: 3 additions & 2 deletions R/app_ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;
}
Expand Down
30 changes: 27 additions & 3 deletions R/mod_genes_view.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @importFrom shinyjs inlineCSS
#' @importFrom shinyjs inlineCSS useShinyjs
#'
#' @noRd
#'
Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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,
Expand Down
40 changes: 36 additions & 4 deletions R/mod_map_view.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
#'
Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand Down Expand Up @@ -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(),
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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,
Expand Down
52 changes: 47 additions & 5 deletions R/mod_qtl_view.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@
#'
#' @import shinydashboard
#' @import shinyWidgets
#' @importFrom shinyjs inlineCSS useShinyjs
#'
#' @noRd
#'
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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..."))
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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,
Expand All @@ -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({

Expand All @@ -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,
Expand Down
18 changes: 15 additions & 3 deletions R/mod_upload.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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")
)
)
),
Expand Down Expand Up @@ -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")
Expand Down

0 comments on commit e057090

Please sign in to comment.