two sliders controlling each other

[Max Geraschenko]

Is it possible to have 2 sliders controlling each other? The code below represents an endless loop if there are both updateSlidersInput() present. If either one of updateSlidersInput() is deleted that would be a typical slider "a" controls slider "b" solution. I tried eventReactive() with no success.

library(shiny)
ui <- fluidPage(
      titlePanel("Test"),
       sidebarLayout(
       sidebarPanel(
       sliderInput("Slider1", "Slider1", min = 1, max = 10, value = 5),
       sliderInput("Slider2", "Slider2", min = 1, max = 10, value = 1),
    ),
    mainPanel(  )
  )
)
server <- shinyServer(function(input, output, session) {
          v <- reactiveValues(x=NULL)

          observeEvent(input$Slider1, {v$x <- input$Slider1
                                       updateSliderInput(session, "Slider2", value=v$x )
                                       print(paste0(v$x, " slider1"))
          })
          observeEvent(input$Slider2, {v$x <- input$Slider2
                                       updateSliderInput(session, "Slider1", value=v$x )
                                       print(paste0(v$x, " slider2"))
          })
})
shinyApp(ui, server)

[Winston Chang]

You could do something like this:

library(shiny)

ui <- fluidPage(

  titlePanel("Test"),

  sidebarLayout(

    sidebarPanel(

      sliderInput("Slider1", "Slider1", min = 1, max = 10, value = 5),

      sliderInput("Slider2", "Slider2", min = 1, max = 10, value = 1)

    ),

    mainPanel(  )

  )

)

server <- shinyServer(function(input, output, session) {

  v <- reactiveValues(x = NULL)

  

  observeEvent(input$Slider1, {

    v$x <- input$Slider1

  })

  observeEvent(input$Slider2, {

    v$x <- input$Slider2

  })

  observeEvent(v$x, {

    if (v$x != input$Slider1) {

      updateSliderInput(session, "Slider1", value = v$x)

    }

    if (v$x != input$Slider2) {

      updateSliderInput(session, "Slider2", value = v$x)

    }

  })

})

shinyApp(ui, server)

Note that, by default, the order of the observeEvents isn't guaranteed, so v$x could hypothetically update from Slider1 before Slider2 or vice versa. If you want to set the order, you can add `priority = 10` to one of the observeEvents. For example, if you add it to the second one, then the sliders will be set to 5, the starting value for Slider1.

-Winston

--
You received this message because you are subscribed to the Google Groups "Shiny - Web Framework for R" group.
To unsubscribe from this group and stop receiving emails from it, send an email to shiny-discuss+unsubscribe@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/c4162b39-58e2-48dc-a853-f394d455bb90%40googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

[Max Geraschenko]

Dear Winston,

Thank you, your solution is very close to what I'd like to achieve. The is one issue though: Is there any way to prevent Slider1 to take Slider2 value before I manually move the slider? I mean the initial position of the sliders has to be different. It feels like I am searching for the way to pause the observer until a user starts interacting with sliders.

Maxim 

[Winston Chang]

This isn't super elegant, but you could keep track of the number of times a slider value has changed. After they've each changed at least once, then any further change will result in the updates.

library(shiny)

ui <- fluidPage(

  titlePanel("Test"),

  sidebarLayout(

    sidebarPanel(

      sliderInput("Slider1", "Slider1", min = 1, max = 10, value = 5),

      sliderInput("Slider2", "Slider2", min = 1, max = 10, value = 1)

    ),

    mainPanel(  )

  )

)

server <- shinyServer(function(input, output, session) {

  v <- reactiveValues(x = NULL)

  slider1_actions <- 0

  slider2_actions <- 0

  

  observeEvent(input$Slider1, {

    slider1_actions <<- slider1_actions + 1

    v$x <- input$Slider1

  })

  observeEvent(input$Slider2, {

    slider2_actions <<- slider2_actions + 1

    v$x <- input$Slider2

  })

  observeEvent(v$x, {

    if (slider1_actions <= 1 && slider2_actions <= 1)

      return()

[Dean Attali]

Max, look into the suspend() and resume() methods of observers (look at the documentation for `?observe()`), they might help you achieve the behaviour you want

[Joe Cheng]

This all sounds very complicated from a UX perspective--why are these sliders coordinated only after one of them is moved? Perhaps there's a different UI representation that might more directly convey what you're trying to do?

--

You received this message because you are subscribed to the Google Groups "Shiny - Web Framework for R" group.

To unsubscribe from this group and stop receiving emails from it, send an email to shiny-discus...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/a428b6f5-efdc-4dac-82e8-c7f2c3670c73%40googlegroups.com.

[Max Geraschenko]

Joe,

My real application is even more entangled. I have a dynamic slider (uiOutput) depending on values provided by a user controlled slider and a text box. The slider and the box would provide two ways to input data. The part with a slider and a box controlling each other is clear now, thanks to Winston and Dean, however the dynamic slider is really tough to implement correctly and I thought the ability to control the order or pause observers would help me. 

When I run the code below a encountered a number of curious things and I can see know how the execution order of observers works. The code seems to work for the most part (slider1 does not refresh slider2), but it runs twice (or even more?), which is fine in this example, but awkward for more sophisticated graphics. It looks clumsy, but I'm not a programmer unfortunately.

Max

library(shiny)

 

ui <- fluidPage(

      titlePanel("Test"),

      sidebarLayout(

        sidebarPanel(

           sliderInput("Slider1", "Slider1", min = 1, max = 10, value = 5),

           sliderInput("Slider2", "Slider2", min = 1, max = 10, value = 1),

           uiOutput("Slider3")

           ),

         mainPanel()

       )

    )

server <- shinyServer(function(input, output, session) {

          v <- reactiveValues(x=NULL)

     

          output$Slider3 <- renderUI({sliderInput("Slider3", label="Slider3", min=1, max=10, value=v$x)})

          

          observeEvent(input$Slider1, {print(paste0("Slider1 initial value ", input$Slider1));  v$x <- input$Slider1 })

        

          observeEvent(input$Slider2, {print(paste0("Slider2 initial value ", input$Slider2));  v$x <- input$Slider2 })

       

          observeEvent(v$x, {

              print(input$Slider1)

              print(input$Slider2)

              print(input$Slider3)

              if (v$x != input$Slider1) {

                  updateSliderInput(session, "Slider1", value = v$x)

               }

           

                 # if (v$x != input$Slider2) {

                 #   updateSliderInput(session, "Slider2", value = v$x)

                 # }

               })

 

})

[Max Geraschenko]

I figured out the problem (but not the solution). There seem to be a difference with how the slider and the textbox objects are observed. Consider two examples below:

Two sliders controlling each other. Everything works perfectly fine.

library(shiny)

ui <- fluidPage(
      titlePanel("Test"),
      sidebarLayout(
        sidebarPanel(

           sliderInput(inputId = "Slider0", label = "Plots per page:", min = 1,  max = 3, value = 1),
           sliderInput(inputId = "Slider1", "Slider1", min = 1, max = 100, value = 50),
           sliderInput(inputId = "Slider2", "Slider2", min = 1, max = 100, value = 50)
           ),
        mainPanel(uiOutput("plots"))

       )
    )
server <- shinyServer(function(input, output, session) {

         
          max_plots <- 3 # maximum allowed number of plots per page
          plot_num <- reactiveValues(value=NULL)
          list_num <- reactiveValues(value=NULL)
          list_index <- reactiveValues(value=NULL)


          observeEvent(input$Slider0, { plot_num$value <- input$Slider0
                                        list_num$value <- round(100/input$Slider0)
                                                    })
         
          observeEvent(list_num$value, { updateSliderInput(session, "Slider1", max=list_num$value)
                                         updateSliderInput(session, "Slider2", max=list_num$value)

                                       })
         
          observeEvent(input$Slider1, { print(paste0("Slider1 initial value ", input$Slider1))

                                        list_index$value <- input$Slider1
                                       })

       
          observeEvent(input$Slider2, { print(paste0("Slider2 initial value ", input$Slider2))

                                        list_index$value <- input$Slider2
                                       })
         
          observeEvent (list_index$value, {
            if(list_index$value != input$Slider1) { updateSliderInput(session, "Slider1", value=list_index$value) }
            else {updateSliderInput(session, "Slider2", value=list_index$value)}
          })
         
          output$plots <- renderUI({
            plot_output_list <- lapply(1:plot_num$value, function(i) {
              plotname <- paste("plot", i, sep="")
              plotOutput(plotname)
            })
            do.call(tagList, plot_output_list)  # Convert the list to a tagList - this is necessary for the list of items to display properly.
          })
         
          for (i in 1:max_plots) {
            local ({   j <- i;  plotname <- paste("plot", j, sep="")
                       output[[plotname]] <- renderPlot({
                           print("plotting")
                           d <- rnorm(100, mean = list_index$value, sd =1)
                           plot(density(d))
                       })
            })
           
          }
})
shinyApp(ui, server)

Similar logic with one slider and one textbox. For some reason, the plotting is done twice. Any ideas why?

library(shiny)


ui <- fluidPage(
  titlePanel("Test"),
  sidebarLayout(
    sidebarPanel(

      sliderInput(inputId = "Slider0", label = "Plots per page:", min = 1,  max = 3, value = 1),
      sliderInput(inputId = "Slider1", "Slider1", min = 1, max = 100, value = 50),
      textInput(inputId = "Text1", "Text1", value = 50)
    ),
    mainPanel(uiOutput("plots"))

  )
)
server <- shinyServer(function(input, output, session) {

 
  max_plots <- 3 # maximum allowed number of plots per page
  plot_num <- reactiveValues(value=NULL)
  list_num <- reactiveValues(value=NULL)
  list_index <- reactiveValues(value=NULL)
 
  observeEvent(input$Slider0, { plot_num$value <- input$Slider0
                                list_num$value <- round(100/input$Slider0)
  })
 
  observeEvent(list_num$value, { updateSliderInput(session, "Slider1", max=list_num$value)

   
  })
 
  observeEvent(input$Slider1, { print(paste0("Slider1 initial value ", input$Slider1))

                                list_index$value <- input$Slider1
  })
 
  observeEvent(input$Text1, { print(paste0("Text1 initial value ", input$Text1))
                              list_index$value <- as.numeric(input$Text1)
  })
 
  observeEvent (list_index$value, {
    if(list_index$value != input$Slider1) { updateSliderInput(session, "Slider1", value=list_index$value) }
    else {updateTextInput(session, "Text1", value=list_index$value)}
   
  })
 
  output$plots <- renderUI({
    plot_output_list <- lapply(1:plot_num$value, function(i) {
      plotname <- paste("plot", i, sep="")
      plotOutput(plotname)
    })
    do.call(tagList, plot_output_list)  # Convert the list to a tagList - this is necessary for the list of items to display properly.
  })
 
  for (i in 1:max_plots) {
    local ({   j <- i;  plotname <- paste("plot", j, sep="")
    output[[plotname]] <- renderPlot({
      print("plotting")
      d <- rnorm(100, mean = list_index$value, sd =1)
      plot(density(d))
    })
    })
   
  }
})
shinyApp(ui, server)