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...
Related
I got an app that opens up a modalDialog with an image inside a spsComps::gallery. However, the enlargement works only the first time the modal has been opened. How can this be fixed? Here is a minimal reprex:
library(shiny)
library(spsComps)
ui <- fluidPage(
actionButton("modal", "Open modal")
)
server <- function(input, output, session) {
observeEvent(input$modal,
{
showModal(modalDialog(
title = "test",
fluidRow(gallery(
texts = "Click to enlarge", hrefs = "", image_frame_size = 6,
images = "https://cdn.pixabay.com/photo/2018/07/31/22/08/lion-3576045__340.jpg",
enlarge = TRUE, title = "When you close this modal, the enlargement does not work again",
enlarge_method = "modal"
)),
footer = modalButton("Cerrar"),
easyClose = TRUE,
size = "xl"))
})
}
shinyApp(ui, server)
The first time the modal is opened, you can enlarge the image by clicking it. It looks like this:
However, when you close and then reopen the modal, that enlargement feature is missing.
A temporary fix would be this:
library(shiny)
library(spsComps)
ui <- fluidPage(
actionButton("modal", "Open modal"),
singleton(
div(id = "sps-gallery-modal", class = "gallery-modal",
style="display: none;",
onclick = "galModalClose()", tags$span(class = "gallery-modal-close", "X"),
tags$img(id = "sps-gallery-modal-content",
class = "gallery-modal-content"),
div(class = "gallery-caption")
))
)
server <- function(input, output, session) {
observeEvent(input$modal,
{
showModal(modalDialog(
title = "test",
fluidRow(gallery(
texts = "", hrefs = "", image_frame_size = 6,
images = "https://cdn.pixabay.com/photo/2018/07/31/22/08/lion-3576045__340.jpg",
enlarge = TRUE, title = "When you close this modal, the enlargement does not work again",
enlarge_method = "modal"
)),
footer = modalButton("Cerrar"),
easyClose = TRUE,
size = "xl"))
})
}
shinyApp(ui, server)
The reason is I have this singleton(... in the gallery creation function. There is only one enlarge img container needed to be created no matter how many galleries you have (It's not practical to enlarge two pictures at the same time). So enlarged images from different galleries are displayed inside the same enlarge container. This saves computer resources, and singleton in Shiny is the function to prevent duplication. Even if you may call gallery many times, if the content inside singleton is sent to the DOM tree only once, it will not append it again.
The problem is when showModal is closed, Shiny deletes everything inside the modal, including the gallery singleton content. Meanwhile, I think the singleton content validation stays at R level. It does not actually go search the DOM tree if this content exists or not. So Shiny thinks singleton content is there, and therefore refused to send it to DOM when the second time you call showModal.
The fix above append singleton content to fluidPage container instead of Shiny modal container, so when modal is closed, it cannot delete the content.
This is a universal problem in Shiny when you have singleton and modalDialog. There is nothing I can do to fix Shiny, but I may think of a more user-friendly way in the next spsComps version to address it.
BACKGROUND
I have an app where a user chooses a file name from a drop-down menu (selectizeInput) and confirms the choice with an actionButton. The app will display the results in the DT::dataTableOutput format.
OBJECTIVE
I'd like to be able to show a loading screen (using shinydashboardloader package) but only AFTER a user presses the actionButton. Prior that I'd like to show an empty screen. Additionally, if a user wants to try several files in one session, the loading screen should appear every time the actionButton has been pressed and disappear when the dataset has been loaded.
CURRENT STATE
Currently, if I run this app the loading button appears all the time, also before a user makes a file choice
### ui.R
library(shiny)
library(shinydashboard)
library(DT)
library(shinycustomloader)
dashboardPage(
dashboardHeader(),
dashboardSidebar(
selectizeInput("file", "Select File",
c("fileA", "fileB")),
actionButton("submit", "Submit")
),
dashboardBody(
fluidRow(
box(h2("My Data"),
div(style = 'overflow-x: scroll',
withLoader(DT::dataTableOutput('mytable'),
type = "html",
loader = "loader1")),
width = 12)
)
)
)
#### server.R
library(shiny)
library(shinydashboard)
library(DT)
shinyServer(function(input, output, session) {
file_name <- reactive({
req(input$file)
})
# When the Submit button is clicked, start the cleaning and matching
observeEvent(input$submit, {
## open chosen file
# open_file <- read_excel(paste0("input_files/", file_name()))
### + some processing that gives me matched_df
matched_df <- data.frame(A = c(1, 2, 3, 4),
B = c("A", "B", "C", "D"))
selected <- reactive({
matched_df # + apply some filter
})
output$mytable = DT::renderDataTable({
selected()
})
})
})
I'm guessing that the way forward would be to use conditionalPanel but I'm not sure how to make a click on the actionButton a condition.
UPDATE
I applied conditionalPanel to the datatable, but it works only the first time I press "Submit" button. If in the same session I change the file name and press the button again, the loader won't appear. Any ideas how I can make it work multiple times in one session?
dashboardBody(
fluidRow(
box(h2("My Data"),
conditionalPanel("input.submit==1",
div(style = 'overflow-x: scroll',
withLoader(DT::dataTableOutput('mytable'),
type = "html",
loader = "loader1"))
),
width = 12)
Any help will be great, thanks!
1: I'm not familiar with shinydashboardloader but I was able add a loading indicator to my app by using the shinyjs package to hide and show elements using CSS. I would add your loading page elements to your main page and wrap them in a shinyjs::hidden function so they're hidden by default. Then when the user clicks the action button, call shinyjs::showElement to show them and shinyjs::hideElement to hide them once loading is complete.
UI:
shinyjs::hidden(div(id = 'loading',
# PUT LOADING ELEMENTS HERE))
SERVER:
observeEvent(input$submit, {
# Show element once submit button is pressed
shinyjs::showElement(id = 'loading')
# CODE TO MAKE DATA FRAME
# Hide loading element when done
shinyjs::hideElement(id = 'loading')
)
2: As for your problem with your edit, the reason that your conditional panel only shows the first time is that the value of an actionButton increases by one each time it is clicked. So the first time it is clicked it goes from 0 to 1; if you click it again it goes from 1 to 2 and so on. Since you set the condition to input$select == 1, it will only appear if the button has been clicked exactly 1 time.
To get it to do what you want, you either need to change the condition to input$select > 1 so that it appears as long as the button has been clicked once, or add a reactiveValue that gets set to 1 when the button is clicked and then resets to 0 when another condition is met (like when loading finishes).
rv <- reactiveValues(loading = 0)
# When you click submit, show the loading screen
observeEvent(input$submit, {rv$loading <- 1})
# When you click LOAD, start loading, then hide the loading screen when finished
observeEvent(input$LOAD, {
# CODE TO LOAD AND GENERATE DATA HERE
rv$loading <- 0})
I am working on a shiny app, that reads data from a file, and display the data on the app, and also allows user to refresh the data. The app works fine, except that when I 'refresh' the data with the action button, some styling are gone.
Below is a simplified version of my app.R
library(shiny)
file_name <- "sample.csv"
bkg_color <- "red"
# Define UI for application
ui <- fluidPage(
actionButton("refresh", "", icon("refresh") ),
tableOutput("table"),
uiOutput("slider")
)
# Define server logic required
server <- function(input, output, session) {
observeEvent(input$refresh,{
source("updatedata.R")
showModal(modalDialog(
title = "",
"Data refreshed",
easyClose = TRUE,
footer = NULL
))
})
# observe the raw file, and refresh if there is change every 5 seconds
raw <- reactivePoll(5000, session,
checkFunc = function(){
if (file.exists(file_name))
file.info(file_name)$mtime[1]
else
""
},
valueFunc = function(){
read.csv(file_name)
})
output$table <- renderTable(raw())
output$slider <- renderUI({
req(raw())
tagList(
# styling slider bar
tags$style(HTML(paste0(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: ",
bkg_color,";border-top: ",bkg_color,";border-bottom: ",bkg_color,"; border: ",bkg_color,"}"))),
sliderInput("date","",
min = min(raw()$v1),
max = max(raw()$v1),
value = max(raw()$v1))
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
In the above, I used renderUI for my slider, as the values depends on the raw values I read from the local file. And I specify the color for the slider explicitly (currently set to red).
And in the same directory, I have updatedata.R that does something similar to the below:
file_name <- "sample.csv"
temp <- data.frame(v1 =runif(10, min = 0, max = 100), v2 = Sys.time() )
write.csv(x =temp, file = file_name,row.names = FALSE )
To run the sample app without error, please run the above code first to initialize the csv files.
When the app first launches, the slider bar is red color. However, after I refresh the underlying data by clicking on the refresh button at the top of the app [NOT the browser refresh], the slider bar changed back to the default shiny app color.
I've searched for an answer for this for quite some time, but cannot even figure out what is the root cause for this. Does anyone has experienced similar issue before, or have an idea how I can fix it, so that the color of the slider bar is unchanged after the refresh?
Thank you!
Shiny increments the slider class each time a new slider is rendered.
therefore the initial class becomes .js-irs-1 on refresh, then .js-irs-2 etc.
change your css selector to .irs child as follows:
tags$style(HTML(paste0(".irs .irs-single, .irs .irs-bar-edge, .irs .irs-bar {background: ",
bkg_color,";border-top: ",bkg_color,";border-bottom: ",bkg_color,"; border: ",bkg_color,"}")))
however i would recommend using server side logic to update the input. It's usually better practice since the html element is rendered on website and only certain values are updated not the whole element.
check updateSliderInput() function to update your slider
I have a button in my ui.R that I want to be shown only when "Summary" tab is selected, so I thought of this code
fluidRow(
column(4,
column(12,id="sub",
actionButton("submit", "SUBMIT", width = "100%"))),
column(8,
bsCollapse(id = "collapse7", open = "Results",
bsCollapsePanel("Results",
tabsetPanel(
tabPanel("Summary",
tags$script(HTML("document.getElementById('sub').style.visibility = 'visible';")))
tabPanel("Plot",
tags$script(HTML("document.getElementById('sub').style.visibility = 'hidden';"))))
))))
The problem is, the button is hidden even though in my first tab it should be visible and also when i go to Plots and back to Summary, the button stays hidden.
After looking at: How to use tabPanel as input in R Shiny?
I decided to play with observeEvent and the input$tabset option. The result is 100% working and it's really simple. Here's the code:
observeEvent(input$choices, {
choice = input$choices
if(choice == "Summary")
{
runjs(
"document.getElementById('submit').style.visibility = 'visible';"
)
}
else
{
runjs(
"document.getElementById('submit').style.visibility = 'hidden';"
)
}
})
Also, I found out why my previous code wasn't working, it was due to the fact that when the UI was initialized, the button element kept the last style modification (the hidden one) and it didn't change depending on the tab I have selected, since its not reactive.
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.