Периодически отключать updateSelectInput () - PullRequest
Новая
       7

Периодически отключать updateSelectInput ()

0 голосов
/ 14 ноября 2018

У меня есть приложение, которое имеет несколько зависимых 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)

Ответы [ 2 ]

0 голосов
/ 16 ноября 2018

Надеюсь, я правильно понял вашу проблему; 

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) {
  ind <- reactiveValues(ind=data.frame(A=0,B=0))

  observeEvent(input$A_sel,{
    ind$ind$A <- 0
  })

  observeEvent(input$B_sel,{

    ind$ind$B <- 0
  })

  observeEvent(input$ForceCombi,{
    ind$ind$A <- 1
    ind$ind$B <- 1
  })

  observe({
    if(ind$ind$A + ind$ind$B==2){
      ind$ind$A <- 0
      ind$ind$B <- 0
      updateSelectInput(session,"A_sel",selected = "C")
      updateSelectInput(session,"B_sel",selected = "D")
    }
  })
}

shinyApp(ui, server)
0 голосов
/ 16 ноября 2018

Вот более простая реализация вашей идеи отметки времени. Я установил порог на 0,5 секунды, но фактический порог можно определить только после рассмотрения других реактивных зависимостей в приложении. Вам также следует изучить priority аргументы observe и observeEvent, с помощью которых вы потенциально можете контролировать последовательность выполнения реактивов.

Сказав это, я все еще чувствую, что есть лучший способ сделать это. Я думаю, что ?shiny::throttle и ?shiny::debounce также могут помочь. 

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

  tstamp <- reactiveValues(t = Sys.time())

  observeEvent(input$A_sel, {
    req((Sys.time() - tstamp$t) > 0.5)
    tstamp$t <- Sys.time()
    updateSelectInput(session,"B_sel", selected = input$A_sel)
  })

  observeEvent(input$ForceCombi, {
    updateSelectInput(session,"A_sel", selected = "C")
    updateSelectInput(session,"B_sel", selected = "D")
    tstamp$t <- Sys.time()
  })
}

shinyApp(ui, server)
...