Kiểm soát dòng chảy thực hiện sau khi cập nhật một số phụ thuộc phản ứng

Question

Đây là một vấn đề đơn giản nhưng tiên tiến. Đây là một hương:

tôi có ba đầu vào i_1, I_2, i_3, dẫn đến ba giá trị phản ứng được sử dụng trong các chức năng khác nhau:

I1 <- reactive({input$i_1}) 
I2 <- reactive({input$i_2}) 
I3 <- reactive({input$i_3}) 

Cụ thể, ba giá trị này được sử dụng để vẽ một đồ thị như một thiết bị đầu cuối phản ứng:

output$plot <- renderPlot {(
    plot(f(I1(), I2(), I3())) 
)} 

sự kỳ diệu sáng bóng hoạt động ra và tất cả mọi thứ hoạt động tốt, cho đến khi tôi muốn tải một số dữ liệu và sửa đổi ba giá trị i_X:

observe {(
    input$b_Load #Load button 
    [...] 
    updateSelectInput(session,"i_1", value = 4) 
    updateSelectInput(session,"i_2", value = 3) 
    updateSelectInput(session,"i_3", value = 5) 
    ... 
)} 

Bản cập nhật tự hoạt động tốt và ba giá trị mới cho các biến được gửi cho khách hàng.

Vấn đề: Các giá trị sau đó được cập nhật và gửi lại từng máy chủ, máy chủ này sẽ tính toán lại đồ thị mỗi lần không cần thiết. Tôi chỉ muốn cập nhật biểu đồ một lần, khi tất cả các giá trị được cập nhật. Có thể không?

---

tôi đã cố gắng chờ đợi cho một sự kiện onFlushed:

values <- reactiveValues(loadingProfile = FALSE) 

    session$onFlushed(function() { 
    values$loadingProfile <- FALSE 
    cat("##### DEBUG: loading Profile OFF ##############\n", file = stderr()) 
    }, once = FALSE) 

    output$plot <- renderPlot {(
    if (!values$loadingProfile) { 
     plot(f(I1(), I2(), I3())) 
    } 
)} 

    observe {(
    input$b_Load #Load button 
    values$loadingProfile <- TRUE #Toggle on the watching value 
    cat("##### DEBUG: loading Profile ON ##############\n", file = stderr()) 
    [...] 
    updateSelectInput(session,"i_1", value = 4) 
    updateSelectInput(session,"i_2", value = 3) 
    updateSelectInput(session,"i_3", value = 5) 
    ... 
)} 

nhưng nó không hoạt động vì phiên là đỏ ửng mỗi lần một trong ba phiên bản cập nhật sẽ được gửi lại cho máy chủ ... (tôi đã kiểm tra trên console sau khi kích hoạt các dấu vết)

---

gì sẽ không làm việc đúng cách:

• sự kiện Đếm, theo đề nghị của @jdharrison, có thể là một tốt hack nhưng sẽ không làm việc ở đây vì nếu giá trị được nạp với updateSelectInput() cũng giống như nó đã từng là, giá trị không được gửi trở lại.
• Đợi một chút, với thứ gì đó như invalidateLater(2000, session) kinda works (tôi đã thử) nhưng không mạnh mẽ. Không thể chỉ định thời gian sẽ luôn luôn nắm bắt các trao đổi khác nhau mà không cần quá tải và do đó tạm dừng quá trình thực thi quá lâu.

Answer 1

Câu hỏi này không có câu trả lời theo những gì tôi biết về trạng thái hiện tại của Sáng bóng. Tuy nhiên, bằng cách sử dụng các biểu thức tuyệt vời reactive(), tôi đã có thể cấu trúc lại luồng giá trị và chỉ cập nhật biểu đồ một lần. Trong hành động,

output$plot <- renderPlot {(
    plot(f(User())) 
)} 

observe {(
    input$b_Load #Load button 
    updateSelectInput(session,"i_1", value = 4) 
    updateSelectInput(session,"i_2", value = 3) 
    updateSelectInput(session,"i_3", value = 5) 
    ... 
)} 

User <- reactive({ 
    object <- list() 
    object$i1 <- I1() 
    object$i2 <- I2() 
    object$i3 <- I3() 
)} 

+ viết lại nhỏ f().

Ở đây, biểu thức phản ứng User() đóng vai trò của bộ đệm. Nó sẽ đợi tất cả các thay đổi trước đó được đẩy trước khi gửi giá trị riêng của nó đến f().

Tôi đã chia sẻ dự án Sáng bóng đầy đủ của mình theo số Github, để biết thêm thông tin.

Answer 2

Điều gì đó giống như sau đây rất có thể sẽ giải quyết được sự cố của bạn.Tôi đã không kiểm tra nó nhưng

Set

values <- reactiveValues(loadingProfile = 0) 

Trong renderPlot:

output$plot <- renderPlot {(
    if (values$loadingProfile %/% 4 == 0) { 
    plot(f(I1(), I2(), I3())) 
    }else{ 
    values$loadingProfile <- values$loadingProfile + 1 
    } 
)} 

loại bỏ các cuộc gọi đến session$onFlushed và thay đổi sự phân công trong observe tới:

isolate(values$loadingProfile <- values$loadingProfile + 1) 

Ví dụ:

library(shiny) 
runApp(
    list(
    ui = fluidPage(
     selectInput("id1", "select a number", 1:5) 
     , selectInput("id2", "select a small letter", letters[1:5]) 
     , selectInput("id3", "select a BIG letter", LETTERS[1:5]) 
     , textOutput("text") 
     , actionButton("myBtn", "Press me!!!") 
    ) 
    , server = function(input, output, session){ 
     values <- reactiveValues(loadingProfile = 0) 
     I1 <- reactive({input$id1}) 
     I2 <- reactive({input$id2}) 
     I3 <- reactive({input$id3}) 
     output$text <- renderText({ 
     if (values$loadingProfile %/% 4 == 0) { 
      paste(I1(), I2(), I3()) 
     }else{ 
      values$loadingProfile <- values$loadingProfile + 1 
     } 
     }) 
     observe({ 
     if(input$myBtn > 0){ 
      isolate(values$loadingProfile <- values$loadingProfile + 1) 
      updateSelectInput(session,"id1", "select a number", 1:5, selected = 5) 
      updateSelectInput(session,"id2", "select a small letter", letters[1:5], selected = "e") 
      updateSelectInput(session,"id3", "select a BIG letter", LETTERS[1:5], selected = "E") 
     } 
     }) 
    } 
) 
)