shiny：可以将updateSliderInput（）与基于radioButton（）的限制滑动范围结合吗？

Question

我正在生成包含app和radioButton()的updateSliderInput()。

radioButton()对应于患者是否接受了放射治疗"Yes"/"No"。 updateSliderInput对应于在radioButton=="Yes"的情况下接收到的辐射剂量，其范围在40和60之间，并带有step=0.2。逻辑上，如果为radioButton=="no"，则为updateSliderInput==0。因此，用户绝对不能访问>0和<40之间的范围。

问题：如何将（1）sliderInput==0组合为radioButton=="No"，将（2）sliderInput==40 to 60组合为radioButton=="Yes"。

我已经寻求一种将sliderInput-function，observeEvent()和updateSliderInput组合在一起的解决方案。但是，如果是全新的，则非常欢迎常规反馈和其他解决方案。

重要的是，不能选择值>0和<40。因此，ticks和slider-axis-values范围内的>0和<40不应显示在sliderInput

预期输出：

和

library(shiny)
library(shinyjs)



sliderInput2 <- function(inputId, label, min, max, value, step=NULL, from_min, from_max){
  x <- sliderInput(inputId, label, min, max, value, step)
  x$children[[2]]$attribs <- c(x$children[[2]]$attribs, 
                               "data-from-min" = from_min, 
                               "data-from-max" = from_max, 
                               "data-from-shadow" = TRUE)
  x
}


ui <- fluidPage(

  useShinyjs(),

  radioButtons("EXBR", "External Beam Radiation", choiceValues=list("No","Yes"),
               choiceNames=list("No","Yes"), selected ="No", inline=T),
  sliderInput2("EXBRGy", "Cumulative Gy",
               min = 0, max = 60, value = 54.2, step = 0.2, from_min = 40, from_max = 60
  )
)

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

  observeEvent(input$EXBR, {
    if((input$EXBR == "No")){
      disable("EXBRGy")
    }else{
      enable("EXBRGy")
    }
  })


  rvs <- reactiveValues(EXBR = "No")


  observeEvent(input$EXBR, {
    if ((input$EXBR == "No")) {
      updateSliderInput(session, "EXBRGy", value=0)
    }
    rvs$EXBR <- input$EXBR
  })




}

shinyApp(ui, server)

Answer 1

您可以再次更新滑块，如下所示：

library(shiny)
library(shinyjs)

sliderInput2 <- function(inputId, label, min, max, value, step=NULL, from_min, from_max){
    x <- sliderInput(inputId, label, min, max, value, step)
    x$children[[2]]$attribs <- c(x$children[[2]]$attribs,
                                 "data-from-min" = from_min,
                                 "data-from-max" = from_max,
                                 "data-from-shadow" = TRUE)
    x
}

ui <- fluidPage(
    useShinyjs(),
    radioButtons("EXBR", "External Beam Radiation", choiceValues=list("No","Yes"),
                 choiceNames=list("No","Yes"), selected ="No", inline=T),
    sliderInput2("EXBRGy", "Cumulative Gy",
                 min = 0, max = 60, value = 54.2, step = 0.2, from_min = 40, from_max = 60
    )
)

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

    rvs <- reactiveValues(prev_value = 54.2)

    observeEvent(input$EXBR, {
        if(input$EXBR == "No"){
            updateSliderInput(session, "EXBRGy",min = 0, max = 0, value=0)
            rvs$prev_value <- input$EXBRGy
            disable("EXBRGy")
        }else{
            updateSliderInput(session, "EXBRGy",  min = 0, max = 60, value = rvs$prev_value)
            enable("EXBRGy")
        }
    })

    observeEvent(input$EXBRGy, {
        print(input$EXBRGy)
    })
}

shinyApp(ui, server)