блестящий: возможно ли объединить updateSliderInput () с ограниченным диапазоном скольжения на основе radioButton ()? - PullRequest
Новая
       63

блестящий: возможно ли объединить updateSliderInput () с ограниченным диапазоном скольжения на основе radioButton ()?

1 голос
/ 28 апреля 2020

Я производю 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

Ожидаемый результат: enter image description here

и

enter image description here

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)

1 Ответ

2 голосов
/ 28 апреля 2020

Вы можете снова обновить слайдер, например: 

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)
...