1

我正在尝试在一个闪亮的应用程序中创建一个消息系统,当某些任务完成时会收到通知,但目前它不起作用:

用户界面:

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!"))
  })
})

你看出我的意图了吗?我希望能够推送分析或行动进展的消息。我认为在 M_Store 中有一个反应式 DF 意味着每当它被操纵时,任何依赖它的东西都是如此,即 output$messageMenu。

我想做的类似于闪亮的进度条:当您进行计算时,您只需更新它们的变量,它们就会在屏幕上发生变化。

谢谢,本。

4

1 回答 1

2

您可以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$frominput$message更改时,newMessage将更改,这又将rbind是一个新行。如果M_Store在任何renderUI函数内,它将更新该值。

如果我得到您想要做的事情,您可能希望将 newMessage 更改为 an 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(每次按下按钮时)。如果您将其他输入或反应值放在这里,您可以将其绑定到其他进程或 ui 元素

于 2015-12-11T03:37:25.810 回答