R Shiny, мониторинг переменной и обновление пользовательского интерфейса

Я пытаюсь создать систему сообщений в блестящем приложении, которое получает уведомления, когда определенные задачи выполнены, но в настоящее время это не работает:

UI:

library(shinydashboard)
dashboardPage(
  dashboardHeader(title = "My Dashboard",
                  dropdownMenuOutput("messageMenu")
),
dashboardSidebar(),
dashboardBody("Hi", actionButton("go", label="DO STUFF!"), actionButton("go2", label="DO MORE STUFF!"))
)

Сервер:

library(shinydashboard)

shinyServer(function(input, output) {

  M_Store <- reactiveValues(DF = data.frame(
    from = c("Admininstrator", "New User", "Support"),
    message = c(
      "Sales are steady this month.",
      "How do I register?",
      "The new server is ready."
    ),
    stringsAsFactors = FALSE
  ))

  output$messageMenu <- renderMenu({
    msgs <- apply(M_Store$DF, 1, function(row) {
      messageItem(from = row[["from"]], message = row[["message"]])
    })
    dropdownMenu(type = "messages", .list = msgs)
  })

  reactive({
    input$go
    message("Button pressed. Execute analysis!")
    message("Pretend analysis got done!")
    message("Now want to send a message that the analysis is done!")
    M_Store$DF <- rbind(isolate(M_Store$DF), data.frame(from="Meee", message="Done message!"))
    })

  reactive({
    input$go2
    message("Second button pressed. Execute second analysis!")
    message("Some computation!")
    message("Want to update the user on progress with a message!")
    M_Store$DF <- rbind(isolate(M_Store$DF), data.frame(from="Someone else!", message="Progress message2!"))
    message("More computations....")
    message("Done, want to tell user I'm done!")
    M_Store$DF <- rbind(isolate(M_Store$DF), data.frame(from="Someone else!", message="Done message2!"))
  })
})

Вы видите мое намерение? Я хотел бы иметь возможность отправлять сообщения анализа или прогресса действий. Я думал, что наличие реактивного DF в M_Store будет означать всякий раз, когда им манипулируют, то есть что-то зависящее от него, т.е. вывод $ messageMenu.

То, что я хотел бы сделать, аналогично блестящим индикаторам выполнения: когда вы выполняете вычисления, вы просто обновляете их переменные, и они меняются на экране.

Спасибо, Бен.

1 ответ

Решение

Вы можете использовать reactiveValues функция в сочетании с isolate, Ваш случай будет выглядеть примерно так:

messageData <- data.frame(from = character(0),  message = character(0), stringsAsFactors = F) #simplified this a bit

shinyServer(function(input, output) {

  M_Store <- reactiveValues(DF = messageData)

  newMessage <- reactive(data.frame(from = as.character(input$from),message = as.character(input$message)))
  observe({
    M_Store$DF <- rbind(isolate(M_Store$DF), newMessage())
  })

  output$myUI <- renderUI({

   #some code
   ... M_Store$DF ...
   #some code

  })
})

M_Store$DF теперь реактивное значение. Когда любой из input$from или же input$message менять, newMessage изменится, что в свою очередь rbind новый ряд. Если M_Store в любом renderUI Функция обновит это значение как WLL.

Если я получу то, что вы пытаетесь сделать, вы можете изменить newMessage на eventReactive, так что пользователь должен нажать кнопку, чтобы зафиксировать любые изменения (вместо того, чтобы срабатывать каждый раз, когда изменяется вход).

РЕДАКТИРОВАТЬ:

Исходя из вашего редактирования выше, вы хотите следующее вместо ваших реактивных функций:

observeEvent(input$go,{
    message("Button pressed. Execute analysis!")
    message("Pretend analysis got done!")
    message("Now want to send a message that the analysis is done!")
    M_Store$DF <- rbind(isolate(M_Store$DF), data.frame(from="Meee", message="Done message!"))
  })

Это срабатывает каждый раз, когда значение input$go меняется (при каждом нажатии кнопки). Если вы поместите здесь другие входные или реактивные значения, вы можете связать их с другими процессами или элементами пользовательского интерфейса.

Другие вопросы по тегам