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")
)
)
Related
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)
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)
sliderInput("myslider", "Slider:", min=1, max=100, value=6)
returns a slider with tickmark labels at 1, 11, 21, 31,...,91 and 100.
I would love the heuristic that is determining these tickmark labels to return more reasonable values of 1, 10, 20, 30,, ...90, 100.
I imagine this comes up a lot, as a slider from 1 to 100 is a very common one. (If you set min=0, it does show the desired tickmark labels, but in many apps, you don't want the input to be 0.
Currently, there is no way to supply user-defined tickmark labels to sliderInput. Is there a workaround just for the labels?
A similar question is posted here, but it talks about creating user-defined tick marks, not the labeling.
In https://groups.google.com/forum/#!topic/shiny-discuss/AeAzR4p2h1g is a solution of this problem:
ui <- pageWithSidebar(
headerPanel("Slider labels"),
sidebarPanel(
uiOutput("slider")
),
mainPanel()
)
server <- function(input, output) {
output$slider <- renderUI({
args <- list(inputId="foo", label="slider :", ticks=c(90,95,99,99.9), value=c(2,3))
args$min <- 1
args$max <- length(args$ticks)
if (sessionInfo()$otherPkgs$shiny$Version>="0.11") {
# this part works with shiny 1.5.0
ticks <- paste0(args$ticks, collapse=',')
args$ticks <- T
html <- do.call('sliderInput', args)
html$children[[2]]$attribs[['data-values']] <- ticks;
} else {
html <- do.call('sliderInput', args)
}
html
})
}
runApp(list(ui = ui, server = server))
By now this can be done using htmltools::tagQuery:
library(shiny)
library(htmltools)
ui <- basicPage(h1("Custom sliderInput ticks"),
{
customTicks <- seq_len(15)
customSlider <- sliderInput(
inputId = "sliderinput",
label = "sliderInput",
min = 1,
max = max(customTicks),
value = 7,
step = 1,
ticks = TRUE
)
tagQuery(customSlider)$find("input")$addAttrs("data-values" = paste0(customTicks, collapse = ", "))$allTags()
})
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)
I have a randomly generated data.frame. The user can modify a slider to choose the number of points. Then I plot this data.frame.
I want to add a button than when clicked, it performs a modification in the previous randomly generated data.frame (but without regenerating the data.frame). The modification is a voronoid relaxation, and it should be performed once per each time the button is clicked and the graph generated.
Until now, I have not achieved anything similar...
ui.R
library(shiny)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
# Application title
titlePanel("Map Generator:"),
# Sidebar with a slider input for the number of bins
sidebarLayout(
sidebarPanel(
p("Select the power p to generate 2^p points."),
sliderInput("NumPoints",
"Number of points:",
min = 1,
max = 10,
value = 9),
actionButton("GenPoints", "Generate"),
actionButton("LloydAlg", "Relaxe")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot",height = 700, width = "auto")
)
)
))
server.R
library(shiny)
library(deldir)
shinyServer(function(input, output) {
observeEvent(input$NumPoints,{
x = data.frame(X = runif(2^input$NumPoints,1,1E6),
Y = runif(2^input$NumPoints,1,1E6))
observeEvent(input$LloydAlg, {
x = tile.centroids(tile.list(deldir(x)))
})
output$distPlot <- renderPlot({
plot(x,pch = 20,asp=1,xlim=c(0,1E6),ylim = c(0,1E6))
})
})
})
Of course there is something that I must be doing wrong, but I am quite new into shiny I can't figure it out what I am doing wrong...
This should work (even though I am pretty sure this could be improved):
shinyServer(function(input, output) {
library(deldir)
data = data.frame(
X = runif(2^9, 1, 1E6),
Y = runif(2^9, 1, 1E6)
)
rv <- reactiveValues(x = data)
observeEvent(input$GenPoints, {
rv$x <- data.frame(
X = runif(2^input$NumPoints,1,1E6),
Y = runif(2^input$NumPoints,1,1E6)
)
})
observeEvent(input$LloydAlg, {
rv$x = tile.centroids(tile.list(deldir(rv$x)))
})
output$distPlot <- renderPlot({
plot(rv$x,pch = 20,asp=1,xlim=c(0,1E6),ylim = c(0,1E6))
})
})
So first I initialize the points to plot. I use runif(2^9, 1, 1E6) because the starting value of the sliderInput is 9 all the time.
I also removed the observeEvent from the sliderInput and moved it to the GenPoints actionButton.
Is there a way to make the sliderInput wait for a couple seconds before it changes its corresponding input$ variable? I have a bar that is controlling a graph that needs to re-render upon the value change. I'm aware of the workaround with a submit button, I'm looking to avoid needing that.
debounce is made for this, and is simpler. Modifying previous answerer's code:
library(shiny)
library(magrittr)
shinyApp(
server = function(input, output, session) {
d_mean <- reactive({
input$mean
}) %>% debounce(1000)
output$plot <- renderPlot({
x <- rnorm(n=1000, mean=d_mean(), sd=1)
plot(density(x))
})
},
ui = fluidPage(
sliderInput("mean", "Mean:", min = -5, max = 5, value = 0, step= 0.1),
plotOutput("plot")
)
)
You can use invalidateLater. It can be done in a naive but concise way:
library(shiny)
shinyApp(
server = function(input, output, session) {
values <- reactiveValues(mean=0)
observe({
invalidateLater(3000, session)
isolate(values$mean <- input$mean)
})
output$plot <- renderPlot({
x <- rnorm(n=1000, mean=values$mean, sd=1)
plot(density(x))
})
},
ui = fluidPage(
sliderInput("mean", "Mean:", min = -5, max = 5, value = 0, step= 0.1),
plotOutput("plot")
)
)
Problem with this approach is that you can still trigger execution when changing slider input and invalidate event is fired. If thats the problem you try a little bit more complex approach where you check if values changed and how many time value has been seen.
library(shiny)
library(logging)
basicConfig()
shinyApp(
server = function(input, output, session) {
n <- 2 # How many times you have to see the value to change
interval <- 3000 # Set interval, make it large so we can see what is going on
# We need reactive only for current but it is easier to keep
# all values in one place
values <- reactiveValues(current=0, pending=0, times=0)
observe({
# Invalidate
invalidateLater(interval, session)
# Isolate so we don't trigger execution
# by changing reactive values
isolate({
m <- input$mean
# Slider value is pending and not current
if(m == values$pending && values$current != values$pending) {
# Increment counter
values$times <- values$times + 1
loginfo(paste(values$pending, "has been seen", values$times, "times"))
# We've seen value enough number of times to plot
if(values$times == n) {
loginfo(paste(values$pending, "has been seen", n, "times. Replacing current"))
values$current <- values$pending
}
} else if(m != values$pending) { # We got new pending
values$pending <- m
values$times <- 0
loginfo(paste("New pending", values$pending))
}
})
})
output$plot <- renderPlot({
x <- rnorm(n=1000, mean=values$current, sd=1)
plot(density(x))
})
},
ui = fluidPage(
sliderInput("mean", "Mean:", min = -5, max = 5, value = 0, step= 0.1),
plotOutput("plot")
)
)