Включить кнопку действия, если ввод изменился
Мое приложение должно следовать следующей логике: при нажатии кнопки действия все входы отключаются и выполняется длительное вычисление. Когда вычисление завершено и его результаты нанесены на график, все входы, кроме кнопки действия, снова становятся активными. Если пользователь решает изменить один вход, кнопка действия становится активной.
Большая часть этого желаемого поведения работает, за исключением последнего бита, включения кнопки действия. Вот моя серверная функция (кнопка действия называется "go"):
server <- function(input, output, session) {
allinputIds <- reactive(names(input))
shiny::observeEvent(input$go, {
for (id in allinputIds()) shinyjs::disable(id)
})
# ==> here is some trouble: not working
shiny::observeEvent(allinputIds(), shinyjs::enable("go"))
# from here starts the real work
bins <- shiny::eventReactive(input$go, {
x <- faithful$waiting
Sys.sleep(1.5)
seq(min(x), max(x), length.out = input$bins + 1)
})
output$figure <- shiny::renderPlot({
x <- faithful$waiting
hist(
x, breaks = bins(), col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times"
)
for (id in setdiff(allinputIds(), "go")) shinyjs::enable(id)
})
}
Как я могу увидеть, что какой-либо ввод был изменен? Вместо allinputIds() после строки с пометкой «==>» я попробовал input, но это тоже не сработало.
В качестве второго вопроса, что бы вы порекомендовали для инкапсуляции этой кнопки/отключения/включения паттерна, который я планирую использовать более чем на одном блестящем модуле. Было бы неплохо, если бы я мог сосредоточиться на основном коде, то есть на bins и output$figure <- ....
Любая подсказка приветствуется!
Для воспроизводимости вот функция ui:
ui <- shiny::tagList(
shinyjs::useShinyjs(),
shiny::navbarPage(title = "Test 2",
tabPanel(title = "Old Faithful",
shiny::sidebarLayout(
shiny::sidebarPanel(
shiny::sliderInput(
inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30
)
),
shiny::mainPanel(
shiny::actionButton("go", "Update"),
shinycssloaders::withSpinner(plotOutput(outputId = "figure")),
shiny::h4(shiny::textOutput("msg"))
)
)
)
)
)
shiny::shinyApp(ui, server)
Ответы 1
Проблема в том, что в shiny::observeEvent(allinputIds(), shinyjs::enable("go")) вы просто проверяете, меняются ли имена/количество входных идентификаторов — они не меняются. На самом деле вам нужно проверить, не изменились ли значения каких-либо входов (кроме кнопки действия). Поэтому вы можете либо поместить все входные данные непосредственно в наблюдение, например c(input$bins, input$...), либо сделать дополнительный реактив для проверки значений и просто вызвать его реактивным.
library(shiny)
server <- function(input, output, session) {
allinputIds <- reactive(names(input))
changingInputValues <- reactive({
checkIds <- setdiff(names(input), "go")
lapply(checkIds, function(x) input[[x]])
})
observeEvent(input$go, {
lapply(allinputIds(), shinyjs::disable)
})
# ==> here is some trouble: not working
observeEvent(changingInputValues(), shinyjs::enable("go"))
# from here starts the real work
bins <- eventReactive(input$go, {
x <- faithful$waiting
Sys.sleep(1.5)
seq(min(x), max(x), length.out = input$bins + 1)
})
output$figure <- renderPlot({
x <- faithful$waiting
hist(
x, breaks = bins(), col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times"
)
lapply(setdiff(allinputIds(), "go"), shinyjs::enable)
})
}
ui <- tagList(
shinyjs::useShinyjs(),
navbarPage(title = "Test 2",
tabPanel(title = "Old Faithful",
sidebarLayout(
sidebarPanel(
sliderInput(
inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30
)
),
mainPanel(
actionButton("go", "Update"),
shinycssloaders::withSpinner(plotOutput(outputId = "figure")),
h4(textOutput("msg"))
)
)
)
)
)
shinyApp(ui, server)
Обратите внимание, что я изменил for петли на lapply, так как for петли, как правило, плохо работают с блестящими (к сожалению, я не знаю почему). Несколько раз не работало включение входов при использовании цикла, но с lapply проблем не было.
Это имеет смысл. Большое спасибо.