R блестящий условно изменить числовой входной цвет фона

Question

Рассмотрим следующий код:

library(shiny)

ui <- shinyUI(
    fluidPage(
        column(12,
               numericInput("test", h5("Test value:"), value = 500, min = 0, max = 10000, step = 100, width = '200px')
        )
    )
)

server <- function(input, output) {
}

shinyApp(ui = ui, server = server)

Я хотел бы изменить цвет фона виджета numericInput на красный в зависимости от недопустимого пользовательского ввода.Поэтому, если пользователь вводит текст или значение вне диапазона min и max, тогда виджет должен быть окрашен в красный цвет.

Обратите внимание, что я не могу использовать решение использования файла CSS с, например:

input:invalid {
    background-color: #FFCCCC !important;
}

Причина в том, что цвет фона будет красным, если пользователь введет любое значение, не кратное значению 'step', в операторе numericInput (см .: R блестящий шаг numericInput иминимальное значение взаимодействия для получения подробной информации).

Так как же я могу реализовать свою собственную ручную проверку, как указано выше, с условным стилем, основанным на определяемых мной правилах проверки?То есть я могу применять любые правила, указывающие, что действительно, например:

• if (is.numeric (input $ test))
• if (input $ test> = 0)
• if (введите $ test <= 10000) </li>

Answer 1

Вы можете достичь этого, используя Shinyjs.Вы можете адаптировать правила для изменения цвета по своему усмотрению (я определил правила на основе 5-шаговой последовательности из вашего другого вопроса ).

library(shiny)

jsCode <- '
shinyjs.backgroundCol = function(params) {
var defaultParams = {
id : null,
col : "red"
};
params = shinyjs.getParams(params, defaultParams);
var el = $("#" + params.id);
el.css("background-color", params.col);
}'

ui <- fluidPage(
  useShinyjs(),
  extendShinyjs(text = jsCode),
  sidebarPanel(
    numericInput("val", "Enter value:", value=50, min = 0, step = 5)
  )
)

server <- function(input, output, session) {
  observeEvent(input$val, {
    x <- input$val
    if (x %% 5 != 0 | x < 0 | is.na(x))  {
      js$backgroundCol("val","red")
    } else {
      js$backgroundCol("val","white")
    }
  })
}

shinyApp(ui, server)