Using the RStudio tutorial on dueling button, I've setup a data toggle. One of the buttons is default and so should look "active" when the page loads (with inward shadow). After clicking on the other button, the "active" state needs to switch between the two buttons.
Is it possible to implement this with Shiny?
Not sure if this is the cleanest way, but it definitely gets the job done. Got the bootstrap classes here:
library(shiny)
shinyApp(
ui = shinyUI(bootstrapPage(
uiOutput("camera_one"),
uiOutput("camera_two")
)),
server=shinyServer(function(input, output, session){
v <- reactiveValues(btn_class_c1 = NULL, btn_class_c2 = NULL)
observeEvent(input$btn1, {
v$btn_class_c1 <- "btn-primary"
v$btn_class_c2 <- "btn-default"
})
observeEvent(input$btn2, {
v$btn_class_c1 <- "btn-default"
v$btn_class_c2 <- "btn-primary"
})
output$camera_one <- renderUI({
actionButton("btn1", "Camera One", class=v$btn_class_c1)
})
output$camera_two <- renderUI({
actionButton("btn2", "Camera Two", class=v$btn_class_c2)
})
})
)
Related
I've reviewed similar posts and haven´t found any that address this specific need. Below is very simple MWE of what I'm trying to do: shown in 2 images, and in runnable code. My "Hide" button (or remove UI) doesn't work. Help!! I'm sure it's a simple solution but I'm new to this.
What I'm trying to do: Click on the "Add" button and a file input prompt appears below. Click "Hide" button and the file input prompt goes away. Click "Add" again (after "Hide") and the file input prompt appears again. If you click "Add" now (and repeatedly), that single file input prompt remains. (Most other posts have the object appearing repeatedly, again and again in a growing column, with every additional click of the button - this isn't what I need). Just one click to make it appear (and clicking "Add" over and over just keeps it there in its original single manifestation), and "Hide" makes it go away. Simple as that.
Images:
library(shiny)
ui <- fluidPage(
h2("Testing showing and hiding of a function in UI ..."),
br(),
h3(actionButton("addBtn", "Add")),
h3(actionButton("hideBtn","Hide")),
uiOutput("FileInput"),
) # close fluid page
server <- function(input, output, session) {
output$FileInput <- renderUI({
"txt"
req(input$addBtn)
tagList(fileInput("file1", "Choose file",multiple= FALSE,
accept=c("csv",
"comma-separated-values",
".csv"), # close c
width=250,
buttonLabel = "select one file",
placeholder = "Add file"
), # close file input
)} # close tag list
)} # close render UI
observeEvent(input$hideBtn, {
removeUI(
selector = "div:has(> #txt)")
}) # close observe event
shinyApp(ui, server)
Perhaps you can use shinyjs package to get the desired result. Try this
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
h2("Testing showing and hiding of a function in UI ..."),
br(),
h3(actionButton("addBtn", "Add")),
h3(actionButton("hideBtn","Hide")),
uiOutput("FileInput"),
) # close fluid page
server <- function(input, output, session) {
output$FileInput <- renderUI({
"txt"
req(input$addBtn)
tagList(fileInput("file1", "Choose file",multiple= FALSE,
accept=c("csv",
"comma-separated-values",
".csv"), # close c
width=250,
buttonLabel = "select one file",
placeholder = "Add file"
) # close file input
) # close tag list
}) # close render UI
observeEvent(input$addBtn, {
shinyjs::show("FileInput")
})
observeEvent(input$hideBtn, {
shinyjs::hide("FileInput")
#removeUI(selector = "div:has(> #txt)")
})
}
shinyApp(ui, server)
If you do not want to use shinyjs package, you can use insertUI and removeUI as shown below.
library(shiny)
ui <- fluidPage(
h2("Testing showing and hiding of a function in UI ..."),
br(),
h3(actionButton("addBtn", "Add")),
h3(actionButton("hideBtn","Hide")),
uiOutput("FileInput"),
) # close fluid page
server <- function(input, output, session) {
output$FileInput <- renderUI({
req(input$addBtn)
tagList(tags$div(id = 'placeholder1')
) # close tag list
}) # close render UI
observeEvent(input$addBtn, {
if (input$addBtn==0){return(NULL)
}else {
insertUI(
selector = '#placeholder1' ,
## wrap element in a div with id for ease of removal
ui = tags$div(id="fi",
div(style="display: inline-block; width: 185px ;" ,
fileInput("file1", "Choose file",multiple= FALSE,
accept=c("csv",
"comma-separated-values",
".csv"), # close c
width=250,
buttonLabel = "select one file",
placeholder = "Add file"
) # close file input
))
)
}
})
observeEvent(input$hideBtn, {
if (input$hideBtn==0){return(NULL)
}else {
removeUI(selector = "div:has(> #fi)")
}
})
}
shinyApp(ui, server)
I am trying to do something which I thought would be relatively simple, but I cannot seem to figure it out.
I am attempting to have an actionLink which, when pressed, provides additional information for the user. When pressed again it hides the information. I can do this fine, but what I am struggling with is updating the text of the actionLink.
I want it to read "Show additional" when the extra information is hidden, and then "Hide additional" when the information is exposed. I have read the following questions/answers, but cannot quite get it to work.
Modify shiny action button once it is clicked
Update label of actionButton in shiny
I have provided a simple code for this below, though the real example will be a lot more complex.
Thank you for your time and help.
shinyApp(
ui = shinyUI(fluidPage(useShinyjs(),
actionLink("button", "Show additional"),
hidden(
div(id='text_div',
verbatimTextOutput("text")
)
)
)
),
server = function(input, output, session){
observeEvent(input$button, {
toggle('text_div')
output$text <- renderText({"Additional"})
})
}
)
You can check for the value of input$button(which increments by 1 each time you click on it) and update the actionLink label parameter in function of its value with updateActionButton :
shinyApp(
ui = shinyUI(
fluidPage(useShinyjs(),
actionLink("button", "Show additional"),
hidden(div(id='text_div', verbatimTextOutput("text")))
)
),
server = function(input, output, session){
observeEvent(input$button, {
toggle('text_div')
output$text <- renderText({"Additional"})
if (input$button %% 2 == 1) {
txt <- "Hide Additional"
} else {
txt <- "Show Additional"
}
updateActionButton(session, "button", label = txt)
})
}
)
I'm using modules within my shiny app to display the content of different tabPanels. I would like to be able to travel to the second tab by clicking one button. I have the following code:
library(shiny)
library(shinydashboard)
moduleUI <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "Go to tab 2")
)
}
module <- function(input, output, session, openTab){
observeEvent(input$action1, {
openTab("two")
})
return(openTab)
}
ui <- fluidPage(
navlistPanel(id = "tabsPanel",
tabPanel("one", moduleUI("first")),
tabPanel("two", moduleUI("second"))
))
server <- function(input, output, session){
openTab <- reactiveVal()
openTab("one")
openTab <- callModule(module,"first", openTab)
openTab <- callModule(module,"second", openTab)
observeEvent(openTab(), {
updateTabItems(session, "tabsPanel", openTab())
})
}
shinyApp(ui = ui, server = server)
However this only works once. The problem I think, is that the module does not know when a tab is changed in the app. Therefore I'm looking for a way to make sure the module knows which tab is opened so that the actionButton works more that once.
I have considered using input$tabsPanel but I don't know how to implement it.
Help would be greatly appreciated.
The problem is that once the user manually switches back to tab 1, the openTab() does not get updated. So therefore, when you click the actionButton a second time, openTab changes from "two" to "two" (i.e. it stays the same), and therefore your observeEvent is not triggered.
You could add:
observeEvent(input$tabsPanel,{
openTab(input$tabsPanel)
})
So the openTab reactiveVal is updated also when a user manually changes back to tab1 (or any other tab).
You don't need modules to do what you want by the way, but I assume you have a specific reason to use them. For anyone else who wants to achieve the same but does not need modules:
library(shiny)
library(shinydashboard)
ui <- fluidPage(
sidebarPanel(
actionButton(ns("action1"), label = "Go to tab 2")),
navlistPanel(id = "tabsPanel",
tabPanel("one"),
tabPanel("two")
))
server <- function(input, output, session){
observeEvent(input$action1, {
updateTabItems(session, "tabsPanel", "two")
})
}
shinyApp(ui = ui, server = server)
I am writing some Shiny code where the user will enter some inputs to the app and then click a an action button. The action button triggers a bunch of simulations to run that take a long time so I want once the action button is clicked for it to be disabled so that the user can't keep clicking it until the simulations are run. I came across the shinyjs::enable and shinyjs::disable functions but have been having a hard time utilizing them. Here is my server code:
output$button1= renderUI({
if(input$Button1 > 0) {
shinyjs::disable("Button1")
tableOutput("table")
shinyjs::enable("Button1")}
})
However, when I use this code, and click the action button nothing happens. I.e., teh action button doesn't grey out nor does the table get generated. However, when I take away the shinyjs::enable() command, i.e.,
output$button1= renderUI({
if(input$Button1 > 0) {
shinyjs::disable("Button1")
tableOutput("table")
}
})
The table gets generated first, and then the button goes grey, however I would have expected the button to go grey and then the table to generate itself.
What am I doing wrong here?
Here is my updated code based on Geovany's suggestion yet it still doesn't work for me
Button1Ready <- reactiveValues(ok = FALSE)
observeEvent(input$Button1, {
shinyjs::disable("Button1")
RunButton1Ready$ok <- FALSE
RunButton1Ready$ok <- TRUE
})
output$SumUI1= renderUI({
if(Button1Ready$ok){
tableOutput("table")
shinyjs::enable("Button1")
}
})
where for clarification I have also:
output$table <- renderTable({
#My code....
)}
I think that you are using shinyjs::disable and shinyjs::enable in the same reactive function. You will only see the last effect. I will recommend you to split in different reactive functions the disable/enable and use an extra reactive variable to control the reactivation of the button.
I don't know how exactly your code is, but in the code below the main idea is illustrated.
library(shiny)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
actionButton("Button1", "Run"),
shinyjs::hidden(p(id = "text1", "Processing..."))
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output) {
plotReady <- reactiveValues(ok = FALSE)
observeEvent(input$Button1, {
shinyjs::disable("Button1")
shinyjs::show("text1")
plotReady$ok <- FALSE
# do some cool and complex stuff
Sys.sleep(2)
plotReady$ok <- TRUE
})
output$plot <-renderPlot({
if (plotReady$ok) {
shinyjs::enable("Button1")
shinyjs::hide("text1")
hist(rnorm(100, 4, 1),breaks = 50)
}
})
}
shinyApp(ui, server)
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,{..})