Reactive sliderInput ends in same slider - r

I'd like to create a range slider where when selecting one end of the slider updates the other end of the same slider. I know the trick is in observing a change at one end and using it to update the other end. However, I am getting a behaviour where the sliders are flipping back and forth, and I can't figure out why it's not settling.
For the sake of this example, I'd like the sliders to be centred within a 0-100 scale, so that when input$slider[1] is set to 10 then input$slider[2] moves to 90, and when input$slider[2] is moved to 80, input$slider[1] is moved to 20. Example (buggy) code below:
library(shiny)
ui <- fluidPage(
uiOutput("slidertest"),
verbatimTextOutput("values")
)
server <- function(input, output, session) {
sliderends <- reactiveValues(end=c(NULL,NULL))
observe({
sliderends$end[1] <- 100-input$slider[2]
})
observe({
sliderends$end[2] <- 100-input$slider[1]
})
output$slidertest <- renderUI({
sliderInput("slider","Update Ends?", min = 0, max=100, value=c(sliderends$end[1],sliderends$end[2]))
})
output$values <- renderText({paste(input$slider[1], input$slider[2], sliderends$end[1], sliderends$end[2], sep=";")})
}
shinyApp(ui, server)
An explanation of what I'm doing wrong and working suggestions would be greatly appreciated.
Thanks!

It seems your slider input get into an infinite loop.
input$slider[1] change → input$slider[2] change → input$slider[1] change ......
You can use reactiveValues to check whether the start value of sliderinput changed or the end value of sliderinput changed, then use updateSliderInput to update the value of your sliderinput.
See the following code :
library(shiny)
ui <- fluidPage(
# uiOutput("slidertest"),
sliderInput("slider","Update Ends?", min = 0, max=100,value=c(0,100) ),
verbatimTextOutput("values")
)
server <- function(input, output, session) {
sliderends <- reactiveValues(start=0,end=100)
observeEvent(input$slider,{
if(input$slider[1]!=sliderends$start){
#start value change
sliderends$start<-input$slider[1]
updateSliderInput( session,"slider","Update Ends?", min = 0, max=100,value=c( input$slider[1] , 100-input$slider[1] ) )
}else if(input$slider[2]!=sliderends$end){
#end value chagne
sliderends$end<-input$slider[2]
updateSliderInput( session,"slider","Update Ends?", min = 0, max=100,value=c( 100-input$slider[2] , input$slider[2] ) )
}
})
output$values <- renderText({paste(input$slider[1], input$slider[2], sliderends$start, sliderends$end, sep=";")})
}
shinyApp(ui, server)

Related

Shiny sliderInput keeps displaying decimals

I'm trying to create a slider. None of the base values I'm working with have decimals in them, so I have no idea why this continues to happen. I also have set the round parameter within the function as round = TRUE.
library(shiny)
test_df <- 19:45
ui <- fluidPage(
sliderInput("range1", label = h3("Select Range"), min(test_df),
max(test_df), value = c(min(test_df), max(test_df)), round = TRUE)
)
server <- function(input, output, session){
}
shinyApp(ui, server)
But as you can see, when you run it, it keeps showing numbers with decimals in the slider range.
I'm clearly missing something but have no idea as to what it is.
It looks like inputSlider made 10 ticks on your slider, regardless of whether or not that makes sense. 45-19=26, 26/10=2.6, and we are seeing steps of 2.6 on the slider. We can add a step argument to fix the slider so it moves in increments of 1 or whatever you choose.
library(shiny)
test_df <- 19:45
ui <- fluidPage(
sliderInput("range1", label = h3("Select Range"), min(test_df),
max(test_df), value = c(min(test_df), max(test_df)), round = TRUE,
step = 1)
)
server <- function(input, output, session){
}
shinyApp(ui, server)

shiny: Update input without reactives getting triggered?

Is there any possibility to update an input without reactives getting triggered?
Below I put a minimal example. The aim is to update the slider without the value in the main panel changing. When the slider is changed again, then it should be forwarded to dependent reactives again.
The question and the underlying use case is similiar to the following questions: R shiny - possible issue with update***Input and reactivity and Update SelectInput without trigger reactive?. Similiar to these questions, there is a reactive that depends on two Inputs in my use case. I want to update one of these input depending on the other, which results in the reactive getting calculated twice. However, both of these questions got around the problem by updating the input only selectively. This is not possible in my use case, since I want to have some information shown to the user by updating the input.
If there is no possibility to update an input without reactives getting triggered, I will ask a follow-up-question focusing on my use case.
Example
library(shiny)
ui <- fluidPage(
titlePanel("Update Slider - Isolate reaction?"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton("set1", "set slider 'bins'$value=20"),
actionButton("set2", "'ISOLATED' set slider 'bins'$value=20 ")
),
mainPanel(
textOutput("sliderValue")
)
)
)
# Define server logic
server <- function(input, output, session) {
output$sliderValue <- renderText(input$bins)
observeEvent(input$set1,{
updateSliderInput(session,"bins",value=20)
})
observeEvent(input$set2,{
## Is there any possibility to update the slider without 'sliderValue' changing?
#isolate does not work
isolate(
updateSliderInput(session,"bins",value=20 )
)
})
}
shinyApp(ui = ui, server = server)
Here's a stab, though it feels like there might be side-effects from using stale data. Using the following diff:
# Define server logic
server <- function(input, output, session) {
- output$sliderValue <- renderText(input$bins)
+ output$sliderValue <- renderText({ saved_bins(); })
+ update <- reactiveVal(TRUE)
+ saved_bins <- reactiveVal(30)
+
+ observeEvent(input$bins, {
+ if (update()) saved_bins(input$bins) else update(TRUE)
+ })
observeEvent(input$set1,{
updateSliderInput(session,"bins",value=20)
})
observeEvent(input$set2,{
## Is there any possibility to update the slider without 'sliderValue' changing?
#isolate does not work
+ update(FALSE)
- isolate(
updateSliderInput(session,"bins",value=20 )
- )
})
}
The method: using two new reactive values, one to store the data that (saved_bins) is used in the rendering, and one (update) to store whether that data should be updated. Everything that depends on input$bins should instead depend on saved_bins(). By using an additional observeEvent, the reactivity will always cascade as originally desired except when you explicitly set a one-time "do not cascade" with the prepended update(FALSE).
Full code below:
library(shiny)
ui <- fluidPage(
titlePanel("Update Slider - Isolate reaction?"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton("set1", "set slider 'bins'$value=20"),
actionButton("set2", "'ISOLATED' set slider 'bins'$value=20 ")
),
mainPanel(
textOutput("sliderValue")
)
)
)
# Define server logic
server <- function(input, output, session) {
output$sliderValue <- renderText({ saved_bins(); })
update <- reactiveVal(TRUE)
saved_bins <- reactiveVal(30)
observeEvent(input$bins, {
if (update()) saved_bins(input$bins) else update(TRUE)
})
observeEvent(input$set1,{
updateSliderInput(session,"bins",value=20)
})
observeEvent(input$set2,{
## Is there any possibility to update the slider without 'sliderValue' changing?
#isolate does not work
update(FALSE)
updateSliderInput(session,"bins",value=20)
})
}
shinyApp(ui = ui, server = server)
Firstly credit to #r2evans's solution.
At the risk of a verbal thrashing from the many headteacheRs that prohibit it, to avoid double observer you can use global assignment. Sensible to use a less generic name than 'update' though.
library(shiny)
ui <- fluidPage(
titlePanel("Update Slider - Isolate reaction?"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton("set1", "set slider 'bins'$value=20"),
actionButton("set2", "'ISOLATED' set slider 'bins'$value=20 ")
),
mainPanel(
textOutput("sliderValue")
)
)
)
# Define server logic
server <- function(input, output, session) {
output$sliderValue <- renderText({ saved_bins(); })
saved_bins <- reactiveVal(30)
observeEvent(input$bins, {
if (update) saved_bins(input$bins) else update <<- TRUE
})
observeEvent(input$set1,{
updateSliderInput(session,"bins",value=20)
})
observeEvent(input$set2,{
## Is there any possibility to update the slider without 'sliderValue' changing?
#isolate does not work
update <<- FALSE
updateSliderInput(session,"bins",value=20)
})
}
shinyApp(ui = ui, server = server)

implement a simple counter to count reactive firing in Shiny

I would like to keep track of how many times the user has refreshed my Shiny vis.
I figured I would just set a counter up outside of the reactive area
number <- 0
and have it update by adding one every time the code in reactive block fires.
But it doesn't work.
Ideas:
make the counter a global var?
silly idea, doesn't work
put the number <- 0 inside the reactive area?
of
course that's not the solution
I'm not sure which direction to go here. Anyone have any ideas?
require(shiny)
number <- 0
runApp(list(ui = pageWithSidebar(
headerPanel("This is a test"),
sidebarPanel(
helpText("This is a test"),
sliderInput("range",
label = "Pick a number:",
min = 0, max = 100, value = 0)
),
mainPanel(textOutput("text1"),
htmlOutput("text")
)
),
server = function(input, output) {
number <- number + 1
output$text <- renderUI({
str <- paste("You have chosen:",
input$range)
HTML(paste(str, sep = '<br/>'))
View(number)
})
}
)
)
Shiny has reactiveValues that are like an environment - they get passed by reference so you can assign to them with the regular assignment operator from within reactive expressions. For example,
library(shiny)
ui <- pageWithSidebar(
headerPanel("This is a test"),
sidebarPanel(sliderInput("range", "Pick", 0, 100, 10)),
mainPanel(htmlOutput("text"))
)
server <- function(session, input, output) {
vals <- reactiveValues(count = -1)
observeEvent(input$range, vals$count <- vals$count + 1)
output$text <- renderUI({
HTML(paste(sprintf("You have chosen: %s</br>", vals$count)))
})
}
shinyApp(ui, server)
Sidenote: you could also do it as a global variable like mentioned using <<-, but I would say it is a bad idea because of how <<- searches backwards through environments, and I think that it could have surprising results.

conditionalPanel in R/shiny

Quick question on conditionalPanel for shiny/R.
Using a slightly modified code example from RStudio, consider the following simple shiny app:
n <- 200
# Define the UI
ui <- bootstrapPage(
numericInput('n', 'Number of obs', n),
conditionalPanel(condition = "input.n > 20",
plotOutput('plot') ),
HTML("Bottom")
)
# Define the server code
server <- function(input, output) {
output$plot <- renderPlot({
if (input$n > 50) hist(runif(input$n)) else return(NULL)
})
}
# Return a Shiny app object
shinyApp(ui = ui, server = server)
My objective is to hide the graph and move up the HTML text to avoid a gap. Now, you can see that if the entered value is below 20, the graph is hidden and the text "Bottom" is moved up accordingly. However, if the entered value is larger than 20, but smaller than 50, the chart function returns NULL, and while no chart is shown, the text "Bottom" is not moving up.
Question is: is there a way I can set a conditionalPanel such that it appears/is hidden based on whether or not a plot function returns NULL? The reason I'm asking is because the trigger a bit complex (among other things it depends on the selection of input files, and thus needs to change if a different file is loaded), and I'd like to avoid having to code it on the ui.R file.
Any suggestions welcome,
Philipp
Hi you can create a condition for conditionalPanel in the server like this :
n <- 200
library("shiny")
# Define the UI
ui <- bootstrapPage(
numericInput('n', 'Number of obs', n),
conditionalPanel(condition = "output.cond == true", # here use the condition defined in the server
plotOutput('plot') ),
HTML("Bottom")
)
# Define the server code
server <- function(input, output, session) {
output$plot <- renderPlot({
if (input$n > 50) hist(runif(input$n)) else return(NULL)
})
# create a condition you use in the ui
output$cond <- reactive({
input$n > 50
})
outputOptions(output, "cond", suspendWhenHidden = FALSE)
}
# Return a Shiny app object
shinyApp(ui = ui, server = server)
Don't forget to add the session in your server function and the outputOptions call somewhere in that function.

Trigger an event in shiny when a variable exceeds a threshold

I have a continuous variable (the zoom on a leaflet map) and I want to activate some action (polygon drawing) only when this variable exceeds a given threshold (only at after a given zoom level).
Here is a similar - but simpler and easier to reproduce - toy problem:
ui <- bootstrapPage(
sliderInput("slider", label='a number', min=100, max=400, value = 150),
plotOutput("plot")
)
server <- function(input, output, session) {
observeEvent(input$slider > 200, {
output$plot <- renderPlot(plot(rnorm(10000), rnorm(10000)))
})
}
shinyApp(ui, server)
The problem is that, because of Shiny's reactivity system, the plot (in the toy problem) or the map (in the real problem) keep being updated, even though I would like them to be updated only when the threshold is passed, in either direction.
I tried constructions with observeEvent, eventReactive, reactiveValues, etc. mixed with if ... else declarations. But is seems like whenever an input is updated, it triggers the whole chain of events, regardless of whether the dependent variables have changed or not. In the toy problem, it does not matter that input$slider > 200 stays TRUE when input$slider goes from 100 to 101, it triggers the plotting anyways.
Please tell me I am wrong!
Instead of using observeEvent(), you could use a regular observe() and use the condition for an if statement and simply return() if the condition fails.
Something like
observe({
if (input$slider <= 200) return()
...
})
EDIT: In the comments you wanted to somehow track the last value. Here's how you can do this.
library(shiny)
ui <- fluidPage(
sliderInput("slider", "Slider", 1, 500, 100)
)
server <- function(input, output, session) {
values <- reactiveValues(last = 0)
observe({
if (input$slider <= 200 & values$last > 200) {
cat("check!")
}
values$last <- input$slider
})
}
shinyApp(ui = ui, server = server)
So, inspired by #daattali and our discussion, one possible solution is to use a reactiveValue to store the last value of the slider in order to test when the threshold is passed in either directions. The test itself is carried inside an observe function:
ui <- bootstrapPage(
sliderInput("slider", label='a number', min=100, max=400, value = 150),
plotOutput("plot")
)
server <- function(input, output, session) {
output$plot <- renderPlot(plot(rnorm(10000), rnorm(10000)))
last <- reactiveValues(value = 0)
observe({
if ((input$slider <= 200 & last$value > 200)|(input$slider > 200 & last$value <= 200)) {
output$plot <- renderPlot(plot(rnorm(10000), rnorm(10000)))
}
last$value <- input$slider
})
}
shinyApp(ui, server)
With this solution, I correctly have an update only when the threshold (200 on the slider) is passed in either directions.

Resources