I have a web app that does some transformation and allows the user to control it, and then download the results. I want to update the label on the button so that the user knows the content that he will download.
Basically,
ui <- fluidPage(
checkboxInput("use_avg", "Use averages"),
actionButton("b1", "Download"),
)
server <- function(input, output, session) {
observeEvent(input$use_avg, {
if (input$use_avg == TRUE) {
updateActionButton(inputId = "b1", label = "Download averages")
} else {
updateActionButton(inputId = "b1", label = "Download")
}
})
}
Is there a way to do this with a downloadButton, or a way to use
actionButton with downloadHandler?
This option would work with either the downloadButton() or the actionButton(). In the ui side, I made a uiOutput(), which changes the button depending on the checkboxInput(). It isn't exactly changing the label, but rather creating a different button depending on the checkbox.
**Edited to show the use of toggleState() with this solution, disabling or enabling based on a checkbox as asked for in the comment.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
checkboxInput("use_avg", "Use averages"),
uiOutput("D1"),
checkboxInput("Disable", 'toggleState checkbox?', value = T)
)
server <- function(input, output, session) {
output$D1<-renderUI({
if (input$use_avg == TRUE) {
downloadButton(outputId = "b1", label = "Download averages")
} else {
downloadButton(outputId = "b1", label = "Download")
}
})
observeEvent(input$Disable, {
toggleState("b1")
})
}
shinyApp(ui, server)
There is no official way to do so, but here is a workaround:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
checkboxInput("use_avg", "Use averages"),
downloadButton("download", "Download")
)
server <- function(input, output, session) {
observeEvent(input$use_avg, {
if (input$use_avg == TRUE) return(runjs('$("#download")[0].childNodes[2].nodeValue = " Download averages"'))
runjs('$("#download")[0].childNodes[2].nodeValue = " Download"')
})
}
shinyApp(ui, server)
Related
Good days, I am programming in Rstudio, using shiny, and I wanted to generate an alert that is activated only when I want to leave a tabPanel without completing a condition, but not if I do not enter the tabPanel before, this is the way I found. The problem is that every time that I leave the Panel 1 without fulfilling the condition of completing text, alerts are generated that are accumulating (1 alert the first time, two the second, three the third, etc.) I wanted to consult if somebody knows why it is this and how to avoid it.
thank you very much
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(
tabsetPanel(
id = "tabselected",
tabPanel("Tab2",""),
tabPanel("Tab1", textInput("requiredText", "Required Text"))
))
server <- function(input, output, session) {
observe({
req(input$tabselected == "Tab1")
observeEvent(
input$tabselected,
if (input$tabselected != "Tab1" & !isTruthy(input$requiredText)) {
shinyalert(title = "Save your work before changing tab",
type = "warning",
showConfirmButton = TRUE
)
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
}
)
}
)
}
shinyApp(ui = ui, server = server)
Is this the behavior you desire? Your example was recursive so you had reoccurring popup event. We can create a reactiveValues variable to keep track of the events, like so:
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(
tabsetPanel(
id = "tabselected",
tabPanel("Tab2",""),
tabPanel("Tab1", textInput("requiredText", "Required Text"))
))
server <- function(input, output, session) {
v <- reactiveValues(to_alert = FALSE)
observeEvent(input$tabselected,{
if (input$tabselected != "Tab1" & !isTruthy(input$requiredText)) {
v$to_alert <- TRUE
}else{
v$to_alert <- FALSE
}
},ignoreInit = TRUE)
observeEvent(v$to_alert,{
if (v$to_alert){
shinyalert(title = "Save your work before changing tab", type = "warning",showConfirmButton = TRUE)
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
}
})
}
shinyApp(ui = ui, server = server)
I'm currently rewriting a big shinyapp and I try to shift as much as possible into modules.
At some point, the user can choose weather to use stuff that is inside box a) or inside box b).
I know how to toggle or remove / restore a box in shiny, but I ran across a problem when using shinymodules: Inside the ui-function, I have a radiobutton, and the server-function should just observe its's value and hide or show a box according to the input. Well, the actual box to hide or show ist not inside the module because it is filled with another module.
Please see the code below for an example, you'll see that the box won't be removed or restored or whatever.
Maybe someone has an idea how to fix this or sees where I make a mistake?
Thank you!
# ui ----
testUI <- function(id){
tagList(
radioGroupButtons(NS(id, "switch"), label = NULL, individual = T,
choices = c("show", "dont show"), selected = "dont show"),
)
}
# server ----
testServer <- function(id, boxid){
moduleServer(id, function(input, output, session){
observeEvent(input$switch, {
if(input$switch == "show"){
updateBox(id = boxid, action = "restore", session = session)
} else {
updateBox(id = boxid, action = "remove", session = session)
}
})
})
}
# testing ----
testApp <- function(){
# create ui
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
testUI("zg"),
box(id = "mybox", title = "I am a box",
strong("some content")
) # end box
) # end dashboardBody
) # end dahsboardPage
# create server
server <- function(input, output, session){
testServer("zg", boxid = "mybox")
}
# start server
shinyApp(ui, server)
}
# start small app for testing (comment if not in use)
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
testApp()
Normally, in order to use a updateXXX function in a module, the widget to be updated must be in the UI part of the module.
But that does not work with updateBox, I don't know why (I think the package author should add something in the implementation). See the example below. The updateRadioButtons works, but not the updateBox.
testUI <- function(id){
ns <- NS(id)
tagList(
radioButtons( # this widget will be updated
ns("switch"), label = NULL,
choices = c("show", "dont show"), selected = "show"
),
box( # this widget will *not* be updated
id = ns("mybox"), title = "I am a box", strong("some content")
)
)
}
# server ----
testServer <- function(id, boxid){
moduleServer(id, function(input, output, session){
observeEvent(input$switch, {
if(input$switch == "show"){
updateBox(id = boxid, action = "restore", session = session)
updateRadioButtons(session, "switch", label = "HELLO")
} else {
updateBox(id = boxid, action = "remove", session = session)
updateRadioButtons(session, "switch", label = "GOODBYE")
}
})
})
}
I am trying to implement something similar to this within the app and not at the browser level as described here.
After capturing the value of the new tab (tabPanel value) selected, could not display the confirmation message before switching to the newly selected tab to display its content.
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(useShinyalert(),
tabsetPanel(id = "tabselected",
tabPanel("Tab1"),
tabPanel("Tab2",plotOutput("plot"))
)
)
server <- function(input, output) {
observeEvent(input$tabselected, {
if(input$tabselected == "Tab2")
{
shinyalert(title = "Save your work before changing tab", type = "warning", showConfirmButton = TRUE)
output$plot <- renderPlot({ ggplot(mtcars)+geom_abline() })
}
})
}
shinyApp(ui = ui, server = server)
You can simply redirect to Tab1 via updateTabsetPanel as long as your desired condition is met.
Here is an example requiring the user to type something in the textInput before it's allowed to switch the tab.
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(useShinyalert(),
tabsetPanel(
id = "tabselected",
tabPanel("Tab1", p(), textInput("requiredText", "Required Text")),
tabPanel("Tab2", p(), plotOutput("plot"))
))
server <- function(input, output, session) {
observeEvent(input$tabselected, {
if (input$tabselected == "Tab2" && !isTruthy(input$requiredText)) {
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
shinyalert(title = "Save your work before changing tab",
type = "warning",
showConfirmButton = TRUE)
output$plot <- renderPlot({
ggplot(mtcars) + geom_abline() + ggtitle(req(input$requiredText))
})
}
})
}
shinyApp(ui = ui, server = server)
By the way an alternative approach wpuld be using showTab and hideTab to display the tabs only if all conditions are fulfilled.
I'm looking for a way to fire this line of code:
onevent('click', '???' ,{ print( 'hey1!!') })
or
onclick('DateRange' ,{ print( 'hey1!!') })
but ONLY when the user clicks on the calendar icon of an airDatepickerInput
but I don't know how to target the icon since it has no ID of its own.
Targeting 'DateRange' will not work as it will also trigger when clicking in the date range field, and that's unwanted.
The reason I want this is because I want the option to open a modal dialog that shows a plot with the date distribution of my data files the user is filtering for in my app.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
airDatepickerInput(
inputId = "DateRange",
label = "Select multiple dates:",
placeholder = "You can pick 5 dates",
multiple = 5, clearButton = TRUE
),
verbatimTextOutput("res")
)
server <- function(input, output, session) {
output$res <- renderPrint(input$DateRange)
}
shinyApp(ui, server)
The author of the shinywidget package has updated the airDatepickerInput so that the button on the side can now be observed.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
airDatepickerInput(
inputId = "DateRange",
label = "Select multiple dates:",
placeholder = "You can pick 5 dates",
multiple = 5, clearButton = TRUE
),
verbatimTextOutput("res_date"),
verbatimTextOutput("res_button")
)
server <- function(input, output, session) {
output$res_date <- renderPrint(input$DateRange)
output$res_button <- renderPrint(input$DateRange_button)
observeEvent(input$DateRange_button, {
print(input$DateRange_button)
})
}
shinyApp(ui, server)
I would like to have one of the tabPanels in my Shiny app launch a shinyFiles style input. In this case I would like to launch a shinySaveButton, without the shinySaveButton being in my dataset (By clicking the save icon [which is actually a tabPanel])
Reproducible example below
library(shiny)
library(shinyFiles)
ui <- navbarPage('Test App',id = "inTabset", selected="panel1",
tabPanel(title = "", value = "Save", icon = icon("save")),
tabPanel(title = "Panel 1", value = "panel1",
h1("Panel1")),
tabPanel(title = "Panel 2",value = "panel2",
h1("Panel2"))
)
server <- function(input, output, session) {
values = reactiveValues(tabSelected="panel1")
observe({
if (input$inTabset=="Save") {
updateNavbarPage(session,"inTabset",selected=values$tabSelected)
#CODE FOR LOADING SHINYFILES DIALOG IN HERE
} else {
values$tabSelected<-input$inTabset
}
})
}
shinyApp(ui, server)
Any help would be greatly appreciated.
Work around using hidden element trick
library(shiny)
library(shinyFiles)
library(shinyjs)
jsCode<-"shinyjs.saveButton=function(){ $('#buttonFileSaveHidden').click(); }"
ui <- fluidPage(
useShinyjs(),
extendShinyjs(text = jsCode),
navbarPage('Test App',id = "inTabset", selected="panel1",
tabPanel(title = "", value = "Save", icon = icon("save")),
tabPanel(title = "Panel 1", value = "panel1",
h1("Panel1")
),
tabPanel(title = "Panel 2",value = "panel2",
h1("Panel2"))
),
# HIDDEN BUTTON TO INITIATE THE SAVE
hidden(shinySaveButton( "buttonFileSaveHidden",
label="",
title="Save as ...",
list('hidden_mime_type'=c("R")),
class='hiddenButton')),
wellPanel( #ONLY INCLUDED TO DISPLAY OF PATH INFO OF THE CHOICE
h3('Current save path info'),
tableOutput('table')
)
)
server <- function(input, output, session) {
values = reactiveValues(tabSelected="panel1")
observe({
if (input$inTabset=="Save") {
updateNavbarPage(session,"inTabset",selected=values$tabSelected)
#CODE FOR LOADING SHINYFILES DIALOG IN HERE
js$saveButton()
} else {
values$tabSelected<-input$inTabset
}
})
shinyFileSave(input, "buttonFileSaveHidden", session=session, roots=c(wd="~"), filetypes=c('R') ) #hidden
# GET THE SAVE PATH CHOICE AND RECORD IT IN fp.dt.rv
fp.dt.rv<-reactiveVal("")
observeEvent(input$buttonFileSaveHidden,{
fp.dt<-parseSavePath(c(wd='~'), input$buttonFileSaveHidden)
fp.dt.rv(fp.dt) #or just use to immediately write.
})
# ONLY TO DISPLAY THE SAVE CHOICE
output$table <- renderTable(fp.dt.rv())
}
shinyApp(ui, server)