Реактивный sliderInput заканчивается тем же слайдером

Question

Я хотел бы создать ползунок диапазона, в котором при выборе одного конца ползунка обновляется другой конец того же ползунка.Я знаю, что хитрость заключается в том, чтобы наблюдать изменение на одном конце и использовать его для обновления другого конца.Тем не менее, я получаю поведение, когда ползунки переворачиваются взад и вперед, и я не могу понять, почему это не устанавливается.

Ради этого примера я бы хотел, чтобы ползунки были центрированыв пределах шкалы 0-100, поэтому, когда input$slider[1] установлен на 10, input$slider[2] перемещается на 90, а когда input$slider[2] перемещается на 80, input$slider[1] перемещается на 20,Пример (глючный) кода ниже:

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)

Объяснение того, что я делаю неправильно, и рабочие предложения будут с благодарностью.

Спасибо!

Answer 1

Кажется, что ваш ползунок входит в бесконечный цикл.

input$slider[1] изменить → input$slider[2] изменить → input$slider[1] изменить ......

Вы можете использовать reactiveValues, чтобы проверить, изменилось ли начальное значение sliderinput или конечное значение sliderinput, затем используйте updateSliderInput, чтобы обновить значение вашего sliderinput.

См. Следующий код:

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)