如何在反应过程完成之前强制shiny更新UI

Question

我正在开发一个与shinyChatR包一起使用的聊天机器人。当用户输入完必要的信息后，服务器需要几秒钟的时间来处理请求。发生这种情况时，整个 UI（包括聊天）都会冻结，在进程完成后立即显示加载消息

如何在反应过程完成之前强制shiny更新UI？下面的模型可以让问题变得清晰：

library(shiny)
library(shinyChatR)
library(promises)
library(future)
library(shinyjs)
plan(multisession)

csv_path <- "chat.csv"
id_chat <- "chat1"
id_sendMessageButton <- paste0(id_chat, "-chatFromSend")
chat_user <- "Client"
bot <- "Bot"
bot_message <- "Hello!"

# drop this if the chat log shall not be deleted
if (file.exists(csv_path)) {
  file.remove(csv_path)
}

ChatData <- shinyChatR:::CSVConnection$new(csv_path, n = 100)

# Define UI
ui <- fluidPage(titlePanel("Chatbot Demo"),
                chat_ui(id = id_chat, ui_title = "Chat Area"))

# Define server logic
server <- function(input, output, session) {
  
  # Initialize chat server
  chat <- chat_server(
    id = id_chat,
    chat_user = chat_user,
    csv_path = csv_path  # Using CSV to store messages
  )
  placa <- reactiveVal()
  cedula <- reactiveVal()
  trigger <- reactiveVal(F)
  ChatData$insert_message(user = bot,
                          message = "Please enter your plate",
                          time = strftime(Sys.time()))
  
  # Observe incoming messages and respond
  observeEvent(cedula(),{
    mensaje_actual_bot <- ChatData$get_data()[ChatData$get_data()$user=="Bot",2]
    mensaje_actual_bot <- as.vector(mensaje_actual_bot[nrow(mensaje_actual_bot),])$text
    mensaje_actual_cliente <- ChatData$get_data()[ChatData$get_data()$user=="Client",2]
    mensaje_actual_cliente <- as.vector(mensaje_actual_cliente[nrow(mensaje_actual_cliente),])$text
    
    if(mensaje_actual_bot=="Loading..."){
      Sys.sleep(10)
      result <- F
      if(result){
        ChatData$insert_message(user = bot,
                                message = "Response A",
                                time = strftime(Sys.time()))
      }else{
        ChatData$insert_message(user = bot,
                                message = "Response B",
                                time = strftime(Sys.time()))
        ChatData$insert_message(user = bot,
                                message = "For a new query please enter your plate",
                                time = strftime(Sys.time()))
      }
    }
  })
  observeEvent(input[[id_sendMessageButton]], {
    #browser()
    mensaje_actual_bot <- ChatData$get_data()[ChatData$get_data()$user=="Bot",2]
    mensaje_actual_bot <- as.vector(mensaje_actual_bot[nrow(mensaje_actual_bot),])$text
    mensaje_actual_cliente <- ChatData$get_data()[ChatData$get_data()$user=="Client",2]
    mensaje_actual_cliente <- as.vector(mensaje_actual_cliente[nrow(mensaje_actual_cliente),])$text
    if(mensaje_actual_bot=="Please enter your plate" | mensaje_actual_bot=="For a new query please enter your plate"){
      placa(mensaje_actual_cliente)
      ChatData$insert_message(user = bot,
                              message = "Please enter your ID",
                              time = strftime(Sys.time()))
    }
    if(mensaje_actual_bot=="Please enter your ID"){
      
      ChatData$insert_message(user = bot,
                              message = "Loading...",
                              time = strftime(Sys.time()))
      cedula(mensaje_actual_cliente)
      
    }
    
  })
  
  observeEvent(trigger(),{
    mensaje_actual_bot <- ChatData$get_data()[ChatData$get_data()$user=="Bot",2]
    mensaje_actual_bot <- as.vector(mensaje_actual_bot[nrow(mensaje_actual_bot),])$text
    mensaje_actual_cliente <- ChatData$get_data()[ChatData$get_data()$user=="Client",2]
    mensaje_actual_cliente <- as.vector(mensaje_actual_cliente[nrow(mensaje_actual_cliente),])$text
    
  })
}

# Run the application
shinyApp(ui, server) 

Answer 1

强迫并不是真正的闪亮方式；但在继续下一步之前，您可以给闪亮时间来冲洗和重新渲染。在这里，我使用后来的包中的功能来将填充的 cedula 延迟 1 秒，它似乎可以按照您的意愿工作。

      later::later(func = function{
        cedula(mensaje_actual_cliente)},
        delay=1)

<< this goes where your previously had cedula(mensaje_actual_cliente)