I'm looking for a way to stop update*Input functions from invalidating reactive values in my Shiny app. I want the update function to change only the visual UI component, not the underlying reactive value.
Here's a reprex:
library(shiny)
ui <- fluidPage(
sliderInput("slide1", "Slider", min = 0, max = 10, value = 5),
sliderInput("slide2", "Slider2", min = 0, max = 10, value = 0),
textOutput("slide2_val")
)
server <- function(input, output, session) {
observe({
updateSliderInput(session, "slide2", value = input$slide1)
}) |>
bindEvent(input$slide1)
output$slide2_val <- renderText({
paste("Value of `slide2`:", input$slide2)
})
}
shinyApp(ui, server)
The desired behaviour is for the value of input$slide2 to only change when the user interacts with slide2, but for the slider UI element to change when either slide1 or slide2 are interacted with.
Importantly, this needs to work for a variety of input* functions. Listening for click events won't work for inputs like selectInput (see my related issue).
In my recent answer to another question
I made a suspendForNextFlush() function to temporarily stop changes to an
input from being sent to Shiny. That function could be used to solve your
problem, too.
I’ve gone ahead and put the function in an experimental
shinysuspend package. You can
install it from GitHub with:
remotes::install_github("mikmart/shinysuspend")
Then include useShinysuspend() in the UI, and call suspendForNextFlush()
when updating slide2 from the server:
library(shiny)
library(shinysuspend)
ui <- fluidPage(
useShinysuspend(),
sliderInput("slide1", "Slider 1", min = 0, max = 10, value = 5),
sliderInput("slide2", "Slider 2", min = 0, max = 10, value = 0),
textOutput("slide2_val")
)
server <- function(input, output, session) {
observe({
suspendForNextFlush("slide2")
updateSliderInput(session, "slide2", value = input$slide1)
})
output$slide2_val <- renderText({
paste("Value of `slide2`:", input$slide2)
})
}
shinyApp(ui, server)
Related
I have a shiny app with a bunch of numeric inputs. Some of them are dependent on the value of others. As an example, let's say that I need input_1 to be changed if the entered input_2 is greater, such that input_1 = input_2 + 1. The problem is that if the user inputs their value too slowly, it takes the first digit of the entered input_2, for instance 5, and makes the input_1 equal to 6, even if you finish typing 540.
Here's an example:
library(shiny)
ui <- fluidPage(
numericInput("input1", "Input 1:", 0),
numericInput("input2", "Input 2:", 0)
)
server <- function(input, output, session) {
observeEvent(input$input2, {
if (input$input2 > input$input1) {
updateNumericInput(session, "input1", value = input$input2 + 1)
}
})
}
shinyApp(ui, server)
I have tried using invalidateLater, or debounce, but I believe I haven't done it correctly since the output still changes almost immediately. Ideally it would only update once focus is lost, but I don't want to add js to my code. So having a fixed timer to update seems like a good middle ground. Any ideas?
As you have already mentioned debounce is the right way to go:
library(shiny)
ui <- fluidPage(
numericInput("input1", "Input 1:", 0),
numericInput("input2", "Input 2:", 0)
)
server <- function(input, output, session) {
input2_d <- debounce(reactive({input$input2}), 1000L)
observeEvent(input2_d(), {
if (input2_d() > input$input1) {
updateNumericInput(session, "input1", value = input2_d() + 1)
}
})
}
shinyApp(ui, server)
Here's an example using the delay function from the shinyjs package:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(), # call for shinyjs to be used in the ui part of the dashboard
numericInput("value1",
"Value 1:",
value = 40),
numericInput("value2",
"Value 2:",
value = 50)
)
server <- function(input, output, session) {
observeEvent(input$value1, {
if (input$value1 > input$value2) {
delay(2000, # the delay in milliseconds that is imposed
updateNumericInput(session = session, "value2", value = input$value1 + 1))
}
})
}
shinyApp(ui, server)
In the event that value1 should be greater than value2, after 2 sec., value2 will be updated to be equal to 1 + value1.
I am trying to set a default (or fallback) value for numericInput() in my shiny app to prevent NAs.
I am aware that the NA can be dealt with later in the server.r, but was wondering if there is a more elegant way of replacing the value within the input whenever a user deletes it in the ui.
The best way is to use the validate package with need() (see this SO thread), but here is something simpler and closer to what you are asking for:
library(shiny)
ui <- fluidPage(
numericInput("obs", "Observations:", 10, min = 1, max = 100),
verbatimTextOutput("value")
)
server <- function(input, session, output) {
dafault_val <- 0
observe({
if (!is.numeric(input$obs)) {
updateNumericInput(session, "obs", value = dafault_val)
}
})
output$value <- renderText({ input$obs })
}
shinyApp(ui, server)
I'd recommend using library(shinyvalidate), which is RStudios "official" way to solve this:
library(shiny)
library(shinyvalidate)
ui <- fluidPage(
numericInput(
inputId = "myNumber",
label = "My number",
value = 0,
min = 0,
max = 10
),
textOutput("myText")
)
server <- function(input, output, session) {
iv <- InputValidator$new()
iv$add_rule("myNumber", sv_required(message = "Number must be provided"))
iv$add_rule("myNumber", sv_gte(0))
iv$add_rule("myNumber", sv_lte(10))
iv$enable()
output$myText <- renderText({
req(iv$is_valid())
input$myNumber
})
}
shinyApp(ui, server)
I apologize if this question has a trivial answer and my limited knowledge of Shiny has led me down the wrong path during my extensive search for an answer.
I am trying to solve the following issue. I have an output that depends on two sliderInputs to create a plot. The sliders in turn are dependent on each other in the sense that the state of second slider should be reset each time the value for the first slider changes. My current attempt on implementing this looks as follows:
library(shiny)
library(plotly)
library(ggplot2)
ui <- fluidPage(
titlePanel("Test"),
sidebarLayout(
sidebarPanel(
sliderInput("slider1", "Slider1:", min = 0, max = 100, value = 0, step= 0.1),
sliderInput("slider2", "Slider2:", min = 0, max = 100, value = 0, step= 0.1)
),
mainPanel(
plotlyOutput('plot', height = 600)
)
)
)
server <- function(input, output, session) {
#temporary state storage.
slider1.state <- reactiveVal(-1)
counter <- reactiveVal(0)
output$plot <- renderPlotly({
print(paste("Function Call Number ", isolate(counter()) ))
counter(isolate(counter())+1)
#Only reset Slider2 if Slider1 has been changed
if (isolate(slider1.state()) != input$slider1) {
#this triggers a redraw
updateSliderInput(session, "slider2", value=0 )
}
ylim_max = input$slider2
#set the new values of the sliders
slider1.state(input$slider1)
ggplot(data.frame()) + geom_point() + xlim(0, input$slider1) + ylim(0, ylim_max)
})
}
shinyApp(ui, server)
I am using reactive values to store the state of slider1, and resetting slider2 using updateSliderInput only when slider1 has changed. The problem that I am facing however this that the call to updateSliderInput triggers the renderPlotly function a second time, hence unnecessarily computing and redrawing the plot of a second time.
I have tried to find a solution that would allow me to somehow update the sliderInput without triggering an event, but to no avail. Is there an elegant way of obtaining this behavior? Ideally, I am looking for a solution that could be applied to arbitrary inputs.
Any help in this matter would be greatly appreciated. Thank you!
You could use debounce() to avoid unnecessary updates:
library(shiny)
library(plotly)
library(ggplot2)
ui <- fluidPage(
titlePanel("Test"),
sidebarLayout(
sidebarPanel(
sliderInput("slider1", "Slider1:", min = 0, max = 100, value = 0, step= 0.1),
sliderInput("slider2", "Slider2:", min = 0, max = 100, value = 0, step= 0.1)
),
mainPanel(
plotlyOutput('plot', height = 600)
)
)
)
server <- function(input, output, session) {
observeEvent(input$slider1, {
updateSliderInput(session, "slider2", value=0 )
})
plot_limits <- reactive({
list(xlim_max = input$slider1, ylim_max = input$slider2)
})
plot_limits_d <- plot_limits %>% debounce(500)
counter <- reactiveVal(0)
output$plot <- renderPlotly({
print(paste("Function Call Number ", isolate(counter()) ))
counter(isolate(counter())+1)
ggplot(data.frame()) + geom_point() + xlim(0, plot_limits_d()$xlim_max) + ylim(0, plot_limits_d()$ylim_max)
})
}
shinyApp(ui, server)
I have a fairly involved app. When I call a particular eventReactive function, let's call it function A, within a reactive expression, I get an error that function A cannot be found.
I'm unable to reproduce the exact app because it is proprietary, but I did create a dummy app that simulates the setup I have. I realize that there must be some difference between the dummy app and what I actually have, but I can't figure it out. The function in question is there, so I fundamentally don't understand why it's not being found.
library(shiny)
ui <- fluidPage(
sliderInput(inputId = "num",
label = "Choose a number",
value = 25, min = 1, max = 100),
actionButton(inputId = "action",
label = "Update"),
plotOutput("hist"),
verbatimTextOutput("stats")
)
server <- function(input, output) {
data <- eventReactive(input$action, {
input$num*2
})
data2 <- reactive({
data()*2
})
output$stats <- renderPrint({
data2()
})
}
shinyApp(ui = ui, server = server)
I have an app currently where the input$sliderInputID only changes when the mouse is released. Is it possible to have these values change as the slider is being dragged?
a demo app:
library(shiny)
shinyApp(
server = function(input, output, session) {
d_mean <- reactive({
input$sliderInputID
})
output$plot <- renderPlot({
x <- rnorm(n=1000, mean=d_mean(), sd=1)
plot(density(x))
})
},
ui = fluidPage(
sliderInput("sliderInputID", "Mean:", min = -5, max = 5, value = 0, step= 0.1),
plotOutput("plot")
)
)
In this case, the plot should update as the slider is being dragged, not only when the mouse is released.
Edit:
There is a similar question here: R reactive histogram
However, I'm still interested whether another solution is available using only the shiny library, since that answer was posted in 2016.
The link you provide is the quickest and cleanest way to what you want. That package is definitely still viable -- if you're worried about it disappearing then fork it on GitHub and install from your repo:
# devtools::install_github("homerhanumat/shinyCustom")
library("shiny")
library("shinyCustom")
shinyApp(
server = function(input, output, session) {
output$plot <- renderPlot({
x <- rnorm(n = 1000, mean = input$sliderInputID, sd = 1)
plot(density(x))
})
},
ui = fluidPage(
useShinyCustom(slider_delay = "0"),
customSliderInput("sliderInputID", "Mean:", min = -5, max = 5, value = 0, step = 0.1),
plotOutput("plot")
)
)