I haven't found any information in documentation of shinyBS and on the google/SO about how to use trigger = 'manual' on, for example, addPopover of shinyBS. I thought this would be the way to add a tooltip to a disabled button. (I dont want to do it with div'ving the button and giving title to div.
Also would be nice if someone has a way to add tooltips reactively to shiny apps
If you want to use trigger = manual on the popover, then you need to define a script to toggle the popover, e.g. with jQuery:
library(shiny)
library(shinyjs)
library(shinyBS)
ui <-shinyUI(fluidPage(useShinyjs(),
# press this button to trigger the popover
actionButton("addPopover", "Add Popover"),
# a disabled button
disabled(actionButton("disabledButton", "This button is disabled")),
# the popover to appear over the disabled button
bsPopover("disabledButton", "Popover", "Some text", trigger="manual"),
# the script to trigger the popover
uiOutput("trigger")))
server <- shinyServer(function(input,output, session){
# on checkbox selection, disable button and trigger the popover
output$trigger <- renderUI({
input$addPopover
tags$script("$('#disabledButton').popover('toggle');")
})
})
shinyApp(ui,server)
Since shosaco's solution didnt work for me, I got it to work this way:
if (input$disable) {
addCssClass("buttonId", "disabled")
bsTooltip("buttonId", "This button is currently disabled.")
} else {
bsTooltip("buttonId", "")
removeCssClass("buttonId", "disabled")
}
observeEvent(input$buttonId, {
if (!input$disable) {
output$text <- renderText("Bla")
} else {
output$text <- renderText(NULL)
}
Related
I'm looking to stop a dropdownbutton (shinywidgets) from opening when the button is clicked based on a condition. This to avoid renderUI errors on missing input for content on the dropdownButton modal panel.
When a user clicks on a dropdownButton, it normally opens a panel. In my case, this panel contains renderUIelements that depend on various variables.
If these variables do not exist yet, the renderUIswill cause errors to spit out.
What I would like to know is whether there is a way to look at the click
observeEvent(input$MydropdownButton, { ....})
and then completely stop it from opening the panel if a condition is not met, rather than toggle it to close immediately (not working version)
What I plan to do, is to give the user a sweetalert instead that informs the user of which options he has to create or load the needed data. And I know how to do the message, purely looking to stop the opening part in an 'if else' way
I know I can use shinyjs::disable('MydropdownButton') inside an observer with ifstatement to block the use of the button, but this would not allow me to trigger the sweetalerton a click anymore
I also know I can adjust all my renderUIs not to render if the needed input is missing, but by now there are a lot of renderUIs involved, and I'm:
A: afraid to make a mess of the code, and
B: eager to find out if there is a way in general to stop the opening of dropdownButtons
I've tried something like this:
observeEvent(input$MydropdownButton, {
if(!is.null(values$neededData)) { 'just open the dropdownbutton' }
else { toggleDropdownButton('TestDrop')
'run sweetalert code'}
})
But the toggleDropdownButtonwill only close the dropdownButtonpanel once it's already triggered to open, and thus shiny tried to renderthe uielement, with the resulting error, rather than block it from opening.
Here are a full serverand uicode files to demonstrate it calling for non-existing numbers.
SERVER file
shinyServer = function(input, output, session) {
values <- reactiveValues()
output$Reset_Threshold <- renderUI({
if(values$randomNr == 2) { actionButton(inputId = "Reset_Threshold", label = icon("undo")) }
else if(values$randomNr == 1) { actionButton(inputId = "Reset_Threshold", label = icon("table")) }
})
observeEvent(input$TestDrop, {
if(!is.null(values$randomNr )) { print('no problems')}
else { toggleDropdownButton('TestDrop')
# Run other code here to alert user.
}
})
}
UI file
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
dropdownButton(inputId= "TestDrop",
uiOutput('Reset_Threshold'),
icon = icon("table"), tooltip = tooltipOptions(title = "Click"))
)
```
The error is not caused by toggling the dropdown menu but referencing a variable randomNr that doesn't exist. I added the variable and also a sweet dialog when the data is not ready in the server logic now it works.
But do note that it's not possible to stop the dropdown menu from opening. We still need to close it. If you want to block it from opening completely, you can conditionally render a regular Shiny actionButton when your data is not ready and will still trigger an event. Just make sure only one button is rendered under different condition and they should use the same input ID.
function(input, output, session) {
values <- reactiveValues(Filter_df = NULL, randomNr = 0)
output$Reset_Threshold <- renderUI({
if (values$randomNr == 2) {
actionButton(inputId = "Reset_Threshold", label = icon("undo"))
}
else if (values$randomNr == 1) {
actionButton(inputId = "Reset_Threshold", label = icon("table"))
}
})
observeEvent(input$TestDrop, {
if (!is.null(values$Filter_df)) {
print("no problems")
} else {
toggleDropdownButton("TestDrop")
# Run other code here to alert user.
sendSweetAlert(session, "data not ready")
}
})
}
EDIT
Just render a different button now. I'm using a single file app.R
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
uiOutput("button")
)
server <- function(input, output, session) {
values <- reactiveValues(Filter_df = NULL, randomNr = 0)
output$button <- renderUI({
if (values$randomNr == 1) {
dropdownButton(
inputId = "dropdown",
actionButton(inputId = "Reset_Threshold", label = icon("table")),
icon = icon("table"), tooltip = tooltipOptions(title = "Click")
)
} else {
actionButton(
inputId = "alert",
NULL,
icon = icon("table")
)
}
})
observeEvent(input$alert, {
sendSweetAlert(session, "data not ready")
})
}
shiny::shinyApp(ui, server)
Consider the following app:
ui <- basicPage(
actionButton('button1', 'click one'),
actionButton('button2', 'click two')
)
server <- function(input, output){
popup <- function(){
modalDialog(easyClose = T,
'popup window triggered')
}
}
shinyApp(ui=ui, server=server)
My goal is that the modal window is triggered once either of the buttons is clicked. I realise that I can create an observeEvent for each button, but in the full application there will be many buttons on different navbar pages. So in order to avoid a whole bunch of code duplication, I would like to gather them in a single observeEvent. I tried some of the suggestions from here.
Adding
observeEvent({
input$button1
input$button2
}, {
showModal(popup())
})
to server() doesn't really work, because for some odd reason button2 needs to be clicked before button1 is responsive.
Instead, adding
observeEvent(c(input$button1, input$button2), {
showModal(popup())
})
causes the modal window to appear on startup already, which should not happen.
So is there a way to capture multiple action buttons into a single observe event without these undesirable behaviours?
You need to set ignoreInit = TRUE for observeEvent:
ui <- basicPage(
actionButton('button1', 'click one'),
actionButton('button2', 'click two')
)
server <- function(input, output){
popup <- function(){
modalDialog(easyClose = T,
'popup window triggered')
}
observeEvent(c(input$button1, input$button2), {
showModal(popup())
}, ignoreInit = TRUE)
}
shinyApp(ui=ui, server=server)
I am trying to understand how will the below code behave
library(shiny)
ui<-fluidPage(
sliderInput("inpslider","Slider",1,10,5),
uiOutput("radio"),
)
server <- function(input, output) {
output$radio<-renderUI({
x<-input$inpslider
radioGroupButtons(inputId = 'myRadioButton', choices = c("A","B"),status = 'warning',
direction = 'vertical', justified = T)
})
}
The first time the code runs it will add an input slider and grouped radio button.
Question:- Since output$radio block contains the reactive value input$slider it will be executed whenever the slider value is changed, So will shiny add a new set of radio button(on top of previous one) every time output$radio is executed? or will the old set of radio buttons will be flushed out every time and new one is added?
You're creating the element with renderUI each time the slider is invalidated it doesnt matter if you press it or reload it...
I'd like to have a variable number of identical actionButton()s on a page all handled by one observeEvent() function.
For example, in a variable-length table of tables, I'd like each interior table to have a button that links to more information on that table.
In standard HTML, you do this with a simple form, where you use a hidden input to designate the interior table number, like this:
<form ...>
<input id="table_number" type="hidden" value="1"/>
<input type="submit" value="Examine"/>
</form>
When a button is pressed, you can examine the hidden input to see which one it was.
Is there a way to do this in Shiny? The only solution I've come up with is to give each actionButton() it's own inputId. This requires a separate observeEvent() for each button. Those have to be created ahead of time, imposing a maximum number of buttons.
It only took me a couple of years, but I now have a much better answer to this question. You can use a JavaScript/jQuery function to put an on-click event handler on every button in a document, then use the Shiny.onInputChange() function to pass the ID of a button (<button id="xxx"...) that has been clicked to a single observer in your Shiny code.
There's a full description with code examples at One observer for all buttons in Shiny using JavaScript/jQuery
You could use shiny modules for this: you can have variable number of actionButton that are identical. These are defined in the ab_moduleUI part. They are handled by their own observeEvent but it has to be defined only once in the ab_module part.
With lapply any number of actionButton can be created.
Edit: You don't have to specify the number of buttons beforehand: use renderUI to generate UI elements at server side.
For demonstration purposes I added a numericInput to increase/decrease the number of modules to render.
# UI part of the module
ab_moduleUI <- function(id){
ns <- NS(id)
tagList(
fluidRow(
actionButton(ns("btn"), paste("ActionButton", id, sep="-")),
textOutput(ns("txt"))
)
)
}
# Server part of the module
ab_module <- function(input, output, session){
observeEvent(input$btn,{
output$txt <- renderText("More information shown")
})
}
# UI
ui <- fluidPage(
# lapply(paste0("mod", 1:no_btn), ab_moduleUI)
numericInput("num", "Number of buttons to show" ,value = 5, min = 3, max = 10),
uiOutput("ui")
)
# Server side
server <- function(input, output, session){
observeEvent(input$num, {
output$ui <- renderUI({
lapply(paste0("mod", 1:input$num), ab_moduleUI)
})
lapply(paste0("mod", 1:input$num), function(x) callModule(ab_module, x))
})
}
shinyApp(ui, server)
Read more about shiny modules here
Regarding the use of Shiny modules to answer my original question...
What I'd like to have is a way to have multiple buttons on a page that can be handled by a single observeEvent(), which is easy to do with traditional HTML forms, as shown in the original question.
GyD's demonstration code using Shiny modules almost solves the problem, but it doesn't actually return which button was pressed to the main server. It took me a long time, but I finally figured out how to write a module that does let the main server know which button was pressed:
actionInput <- function(id) {
ns <- NS(id)
tagList(
textInput(ns("text"), label=NULL, value=id),
actionButton(ns("button"), "OK")
)
}
action <- function(input, output, session) {
eventReactive(input$button, {
return(input$text)
})
}
ui <- fluidPage(fluidRow(column(4, actionInput("b1")),
column(4, actionInput("b2")),
column(4, uiOutput("result"))))
server <-function(input, output, session) {
b1 <- callModule(action, "b1")
observeEvent(b1(), {
output$result = renderText(b1())
})
b2 <- callModule(action, "b2")
observeEvent(b2(), {
output$result = renderText(b2())
})
}
shinyApp(ui = ui, server = server)
(In a real application, I would make the textInputs invisible, as they're only there to provide an id for which button was pressed.)
This solution still requires an observeEvent() in the main server for each button. It may be possible to use modules in some other way to solve the problem, but I haven't been able to figure it out.
My original alternative, using a separate observeEvent() in the main server for each button, is actually quite a bit simpler than an expansion of this demo code would be for a hundred or more buttons.
I was building an App with Rshiny.
I have a couple of infoBoxand I would like to use the href option to make a pop-up when clicking on the infoBox.
I use shinyBS for the popup options.
here is what i tried :
valueBox(value=entry_01, icon = icon("users","fa-lg",lib="font-awesome"),href=shinyInput(actionLink,id='button_01',len=1,class="btn btn-default action-button",label=""),
width=NULL,color = "light-blue",subtitle = ""
)
But I figured out that the href option work perfectly if we want to link on an external web site like href = "http://stackoverflow.com/"
but I didn't know how to link in an internal link of the app.
EDIT
I make this edit because i found a solution which make the box clickable and make shiny think it was an action button, by adding two variable inside the valueBox output list.
- the class action-button
- The id which allow us to use observe or observeEvent to detect when the valuebox is clicked.
Here is a reproductible example
require(shiny)
require(shinydashboard)
header <- dashboardHeader(title="ReproductibleExample")
sidebar <- dashboardSidebar(disable=T)
body <- dashboardBody(valueBoxOutput("box_01"),
textOutput("print"))
ui <- dashboardPage(header, sidebar, body)
server<-shinyServer(function(input, output,session) {
output$box_01 <- renderValueBox({
entry_01<-20
box1<-valueBox(value=entry_01
,icon = icon("users",lib="font-awesome")
,width=NULL
,color = "blue"
,href="#"
,subtitle=HTML("<b>Test click on valueBox</b>")
)
box1$children[[1]]$attribs$class<-"action-button"
box1$children[[1]]$attribs$id<-"button_box_01"
return(box1)
})
output$print<-renderText({
print(input$button_box_01)
})
})
shinyApp(ui,server)
I decided to change the method. I have now include an actionbutton (or actionLink) inside the substile element of the value box and create a bsModal element linked to this actionButton.
If you are not familiar with the ShinyBS package it allow to make popover, tooltip etc features without including HTML or java.
I follow the #Mikko Martila advice Shiny: adding addPopover to actionLink and here is a reproductile example to show you my issue :
library("shiny")
library("shinydashboard")
library("shinyBS")
header <- dashboardHeader(title = "reporductible example")
body <- dashboardBody(valueBoxOutput("box_01"),
bsModal("modal", "foo", trigger = "", "bar"))
sidebar <- dashboardSidebar()
ui <- dashboardPage(header,sidebar,body,skin="green")
server = function(input, output, session) {
# ----- First info box synthesis menu
output$box_01 <- renderValueBox({
entry_01 <- "BlaBla"
valueBox(value=entry_01, icon = icon("users",lib="font-awesome"),
width=NULL,color = "blue",subtitle = HTML("<b>my substitle</b> <button id=\"button\" type=\"button\" class=\"btn btn-default action-button\">Show modal</button>")
)
})
observeEvent(input$button, {
toggleModal(session, "modal", "open")
})
}
runApp(list(ui = ui, server = server))
I use the HTML() option to add my button inside the subtitle of value boxes.
It's not really what i wanted but it do the work.
You can do it with actionLink (it's look better) by using subtitle like this :
subtitle=HTML("<b>my subtitle</b><a id=\"button_box_05\" href=\"#\" class=\"action-button\">
<i class=\"fa fa-question-circle\"></i>
</a>")
I was stuck with the same problem and having gone through this link, just got it working, without adding a separate button, like this.
Hope this would help someone looking to solve a similar problem
require(shiny)
require(shinydashboard)
require(shinyBS)
header <- dashboardHeader(title="ReproductibleExample")
sidebar <- dashboardSidebar(disable=T)
body <- dashboardBody(valueBoxOutput("box_01"),
textOutput("print"),bsModal("mod","title","btn"))
ui <- dashboardPage(header, sidebar, body)
server<-shinyServer(function(input, output,session) {
output$box_01 <- renderValueBox({
entry_01<-20
box1<-valueBox(value=entry_01
,icon = icon("users",lib="font-awesome")
,width=NULL
,color = "blue"
,href="#"
,subtitle=HTML("<b>Test click on valueBox</b>")
)
box1$children[[1]]$attribs$class<-"action-button"
box1$children[[1]]$attribs$id<-"button_box_01"
return(box1)
})
observeEvent(input$button_box_01, {
toggleModal(session,"mod","open")
output$print<-renderText({
print(input$button_box_01)
})})
})
shinyApp(ui,server)
I know only bad variant
1) add function tags$script(HTML("function clickFunction(link){
Shiny.onInputChange('linkClicked',link);
}"))
2) edit href children of your valueBox
aa=valueBox(value="22", icon = icon("users","fa-lg",lib="font-awesome"),href="www",
width=NULL,color = "light-blue",subtitle = ""
)
aa$children[[1]]=a(href="#","onclick"=paste0("clickFunction('","click","'); return false;"),aa$children[[1]]$children)
3) observeEvent(input$linkClicked,{..})