У меня есть приложение, которое имеет несколько зависимых selectInputs, поэтому, если вы выбираете что-то в первом, второе должно обновиться до определенного значения. Это отлично работает. Тем не мение! Теперь я хочу навязать конкретную комбинацию двум выборкам, которые не соответствуют логике обновления, но после того, как я обновлю два выбора, изменение первого запускает обновление другого, и я получаю неправильный результат. Также после применения принудительной комбинации, если новое изменение первого выбора сделано, тогда «старое» правило должно повторно применяться.
library(shiny)
ui <- fluidPage(
selectInput("A_sel","select" ,c("A","B","C","D"),"A",FALSE)
,selectInput("B_sel","same" ,c("A","B","C","D"),"A",FALSE)
,actionButton("ForceCombi","force C and D")
)
server <- function(input, output, session) {
observeEvent(input$A_sel,{
updateSelectInput(session,"B_sel",selected = input$A_sel)
})
observeEvent(input$ForceCombi,{
updateSelectInput(session,"A_sel",selected = "C")
updateSelectInput(session,"B_sel",selected = "D")
})
}
shinyApp(ui, server)
РЕДАКТИРОВАТЬ - Таймер решение:
Я устанавливаю временную метку для каждой активации и вижу, какая из них активировалась последней, за исключением того, что если разница во времени меньше секунды, то я предполагаю, что была нажата кнопка, активировавшая выбор. Затем возврат от этого реактива решает, как обновить выборки. Немного взломать:
library(shiny)
library(dplyr)
ui <- fluidPage(
selectInput("A_sel","select",c("A","B","C","D"),"A",FALSE)
,selectInput("B_sel","same as above",c("A","B","C","D"),"A",FALSE)
,actionButton("A_to_B","force C and D")
)
server <- function(input, output, session) {
but <- eventReactive(input$A_to_B,{tibble(src = "but", time = Sys.time())})
sel <- eventReactive(input$A_sel ,{tibble(src = "sel", time = Sys.time())})
src <- eventReactive(c(input$A_to_B,input$A_sel),{
df <- try(rbind(but(),sel()))
if(typeof(df) == "character") return("sel")
if(abs(difftime(df$time[1],df$time[2],units = "sec")) < 1) return("but")
df %>% arrange(time) %>% pull(src) %>% last -> df
return(df)
})
observe({
src <- src()
if(src == "sel") {
updateSelectInput(session,"B_sel",selected = input$A_sel)
} else if (src == "but") {
updateSelectInput(session,"A_sel",selected = "C")
updateSelectInput(session,"B_sel",selected = "D")
}
})
}
shinyApp(ui, server)