Shiny Slider Styling Ignored after refresh - r

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

Related

Stop dropdownButton (shinywidgets) from opening dialog in R shiny

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)

shiny: apply shinycustomerloader after pressing actionButton

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})

Cursor change while hovering over shiny widget

I am using a simple slider bar in a shiny app to define a value range. I have noticed that you can quite usefully slide the range without changing the start and end value individually (by holding the blue region of the slider bar). However, when I have implemented this feature, users have complained that this functionality is not obvious.
To make this functionality more obvious, I would like the cursor to change to a 'move' symbol e.g. when the the cursor hovers over the blue region.
Here is some simple code to modify.
library(shiny)
ui <- fluidPage(
sliderInput(inputId = 'slider1',
label = 'slider input',
min = 0, max =100,
value = c(10,90)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
I don't think you will be able to do this.
library(shiny)
ui <- fluidPage(
tags$style(
'#test {
cursor: crosshair;
color: red;
}'
),
div(id="test",sliderInput(inputId = 'slider1',
label = 'slider input',
min = 0, max =100,
value = c(10,90))
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
This code changes the cursor inside a div with the slider, and the cursor still reverts to the special shiny slider cursor when you hover over the blue bar. In the shiny source code there is already a unique cursor programmed for the slider, so I don't think you will be able to override that, at least not easily.

Disabling buttons in Shiny

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)

Unfocus an action button after a click (Shiny)

This is a bit minor, but after clicking an action button (normally light gray) in a Shiny app, it turns a darker gray and the focus remains on it. The user has to click somewhere else for the action button to return to its normal lighter color.
Try it out here: http://shiny.rstudio.com/gallery/actionbutton-demo.html
The lack of automatically reverting to a lighter color means the user doesn't get a visual feedback that the button was successfully pressed.
Is there a way to fix this?
Another way of doing it is by disabling the button while the process is running, it will also prevent people from re-clicking it while you are waiting on the result. Have a look at shinyjs package which has a lot of nice features. Note that I added 2 second delay to mimic long operation.
rm(list=ls())
library(shinyBS)
library(shiny)
library(shinyjs)
ui <- pageWithSidebar(
headerPanel("actionButton test"),
sidebarPanel(numericInput("n", "N:", min = 0, max = 100, value = 50),
tags$div(style="display:inline-block",title="Push Me",bsButton("goButton", label = "Button", block = TRUE,style="primary"))
),
mainPanel(useShinyjs(),verbatimTextOutput("nText")
)
)
server <- shinyServer(function(input, output,session) {
ntext <- eventReactive(input$goButton, {
shinyjs::disable("goButton")
Sys.sleep(2)
shinyjs::enable("goButton")
input$n
})
output$nText <- renderText({ntext()})
})
shinyApp(ui = ui, server = server)
Disabled Button
Enabled Button
You can tell the webbrowser to unfocus the actionbutton, when it is clicked. This way, you don't get the effects you describe. Below is a (more or less) two line JavaScript call to achieve this. The script reads very straightforward. When the document is ready, we add a functionality, that if a button is clicked, then it is blurred immediately (looses focus).
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("actionButton test"),
sidebarPanel(
tags$script(HTML("
$(document).ready(function() {
$('.btn').on('click', function(){$(this).blur()});
})
")),
numericInput("n", "N:", min = 0, max = 100, value = 50),
br(),
actionButton("goButton", "Go!"),
p("Click the button to update the value displayed in the main panel.")
),
mainPanel(
verbatimTextOutput("nText")
)
))
server <- function(input, output) {
# builds a reactive expression that only invalidates
# when the value of input$goButton becomes out of date
# (i.e., when the button is pressed)
ntext <- eventReactive(input$goButton, {
input$n
})
output$nText <- renderText({
ntext()
})
}
shinyApp(ui, server)

Resources