如何在 Shiny 中包含 2 个向相反方向移动的滑块?

How to include 2 sliders which move in opposite directions in Shiny?

我需要在需要 2 个滑块的地方创建一个 UI。一个从左向右移动,一个从右向左移动。

我能够基于此创建从右到左的滑块 post

但是一旦我包含此代码,另一个滑块似乎也只能从右向左移动。我怎样才能进行更改以使 2 个滑块以相反的方式移动?

类似这样,请注意 .js-irs-1 是第二个滑块,.js-irs-0 是第一个

library(shiny)
my_max <- 10

ui <- fluidPage(
    tags$head( tags$style( type = "text/css", '
      .js-irs-1 .irs-line-mid{
        background: #428bca ;
        border: 1px solid #428bca ;
      }
      .js-irs-1 .irs-line-right{
        background: #428bca ;
      }
      .js-irs-1 .irs-bar {
        background: linear-gradient(to bottom, #DDD -50%, #FFF 150%);
        border-top: 1px solid #CCC ;
        border-bottom: 1px solid #CCC ;
      }
      .js-irs-1 .irs-bar-edge {
        background: inherit ;
        border: inherit ;
      }

    ')), 
    sliderInput("slider1", "Slider 1",min = 0, max = my_max, value = 2, step = 1),
    sliderInput("slider2", "Slider 2",min = 0, max = my_max, value = 8, step = 1)
    
)
server <- function(input, output, session){
    
    observeEvent(input$slider1,{
        updateSliderInput(session, "slider2", value = my_max-input$slider1)
    })
    
    observeEvent(input$slider2,{
        updateSliderInput(session, "slider1", value = my_max-input$slider2)
    })
    
}
shinyApp(ui = ui, server=server)


要更改滑块的方向,您只需更改 .js-irs-0 ,其中 0 是第一个滑块,1 是第二个,2 是第三个,依此类推...
library(shiny)
my_max <- 10

ui <- fluidPage(
    tags$head( tags$style( type = "text/css", '
      .js-irs-0 .irs-line-mid{
        background: #428bca ;
        border: 1px solid #428bca ;
      }
      .js-irs-0 .irs-line-right{
        background: #428bca ;
      }
      .js-irs-0 .irs-bar {
        background: linear-gradient(to bottom, #DDD -50%, #FFF 150%);
        border-top: 1px solid #CCC ;
        border-bottom: 1px solid #CCC ;
      }
      .js-irs-0 .irs-bar-edge {
        background: inherit ;
        border: inherit ;
      }

    ')), 
    sliderInput("slider1", "Slider 1",min = 0, max = my_max, value = 2, step = 1),
    sliderInput("slider2", "Slider 2",min = 0, max = my_max, value = 8, step = 1)
    
)
server <- function(input, output, session){
    
    observeEvent(input$slider1,{
        updateSliderInput(session, "slider2", value = my_max-input$slider1)
    })
    
    observeEvent(input$slider2,{
        updateSliderInput(session, "slider1", value = my_max-input$slider2)
    })
    
}
shinyApp(ui = ui, server=server)

当我运行这个例子时,第二个滑块右边没有蓝线:它根本没有蓝线,两边都是灰色的。

我的会话信息:

R version 4.0.4 (2021-02-15)
Platform: x86_64-apple-darwin17.0 (64-bit)
Running under: macOS Catalina 10.15.7

Matrix products: default
BLAS:   /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib

locale:
[1] en_GB.UTF-8/en_GB.UTF-8/en_GB.UTF-8/C/en_GB.UTF-8/en_GB.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] shiny_1.6.0

loaded via a namespace (and not attached):
 [1] compiler_4.0.4    fastmap_1.1.0     ellipsis_0.3.1    magrittr_2.0.1    R6_2.5.0          promises_1.2.0.1  later_1.1.0.1    
 [8] htmltools_0.5.1.1 tools_4.0.4       Rcpp_1.0.6        digest_0.6.27     xtable_1.8-4      httpuv_1.5.5      lifecycle_1.0.0  
[15] mime_0.10         rlang_0.4.10