Dynami c содержимое для меню уведомлений не обновляется в Shinydashboard - PullRequest
0 голосов
/ 23 апреля 2020

Я создаю динамическое c меню уведомлений для приложения shinydashboard.

У меня есть таблица с 1 столбцом «тема» и другой столбец «условие». У меня есть раскрывающееся меню для выбора одного предмета из таблицы.

> data
  subjet condition
1      A        dA
2      B        dB
3      C        dA
4      C        dB
5      D      <NA>

Я хочу создать уведомление, если у субъекта есть dA при условии (например, субъект A). И другое уведомление, если у него есть дБ (например, субъект B). Кроме того, я хочу создать оба уведомления, если присутствуют и дА, и дБ (например, тема C).

Это работает безупречно. Проблема заключается в том, что я выбираю тему D. Когда я выбираю тему D после выбора любой другой темы, приложение показывает последнее уведомление. Я попытался создать реактивное выражение для удаления уведомления без удачи. Можете ли вы направить меня в правильном направлении?

Лучший!

Пример кода:

# ========== Dynamic dropdownMenu ==========
# Example notificacion data in a data frame
data <- data.frame(subject = c("A", "B", "C", "C", "D"),
                   condition = c("dA", "dB", "dA", "dB", NA))


ui <- dashboardPage(
  dashboardHeader(
    title = "Dynamic menus",
    dropdownMenuOutput("notifMenu")
  ),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
      box(
        title = "Controls",
        selectInput("subject", "Subject: ", choices = unique(data$subject), selected = "A"),
        textOutput("result"),
        tableOutput("table")
      )
    )
  )
)

server <- function(input, output) {

  alertsdf <- reactive({
      df <- subset(data, data$subject == input$subject)
      alertsdf <- list()

      if("dA" %in% df$condition){
        alertsdf[[1]] <- cbind(text = "dA present", status = "warning")
      } 
      if("dB" %in% df$condition){
        alertsdf[[2]] <-  cbind(text = "dB present", status = "warning")
      }
      if(length(alertsdf) > 0){
        alertsdf <- do.call(rbind, alertsdf)
      } else {alertsdf <- data.frame(text = character(), status = character())}
      alertsdf <- alertsdf
  })

  output$result <- renderText({
    paste("You chose", input$subject)
  })

  output$table <- renderTable({
    df <- subset(data, data$subject == input$subject)
  })


  output$notifMenu <- renderMenu({
    if(nrow(alertsdf()) >=1){
        msgs <- apply(alertsdf(), 1, function(row) {
          notificationItem(text = row[["text"]], status = row[["status"]])})
        dropdownMenu(type = "notifications", .list = msgs)
      }
  })

}

shinyApp(ui, server)

...