闪亮：是否可以将 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 if radioButton=="No" 但 (2) sliderInput==40 to 60 if 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)

闪亮：是否可以将 updateSliderInput() 与基于 radioButton() 的受限滑动范围相结合？

shiny: is it possible to combine updateSliderInput() with a restricted sliding range based on radioButton()?

r

shiny

uislider

shinyapps