Question

我正在对我的代码进行最后一次改进，我想放一些通知菜单，以便人们可以看到文件是否正确加载以及计算的状态，但是我有一些麻烦更新此通知下拉菜单...

这是我不断拥有的屏幕：

这就是我想要实现的目标：

1。文件上传时

2。在计算期间

第3。计算后

使用example from renderMenu documentation我制作了那种代码：

ui.R

library(shiny)
library(shinyjs)
library(shinydashboard)

header <-   dashboardHeader(title = "MyDashboard",
                            dropdownMenuOutput("notif")
                            )

sidebar <- dashboardSidebar(
  useShinyjs(),
  sidebarMenu(
    br(),
    fileInput('in_X', 'Upload X',
              accept=c(".csv")),
    fileInput('in_Y', 'Upload Y',
              accept=c(".csv")),
    br(),
    actionButton("compute","Compute"))
  )

body <- dashboardBody()

ui <- dashboardPage(header, sidebar, body, skin = skin_color)

server.R

server <- function(input, output, session) { 

  shinyjs::disable("compute")

  rv <- reactiveValues(X=data.frame(),
                       Y=data.frame())

  # Upload first file
  in_X <- reactive({
    infile <- input$in_X
    if (!is.null(infile)) read.csv(infile$datapath) else NULL
  })

  # Upload second file
  in_Y <- reactive({
    infile <- input$in_Y
    if (!is.null(infile)) read.csv(infile$datapath) else NULL
  })

  # Update notification
  observe({
  rv$X <- in_X()
  rv$Y <- in_Y()
  if(!is.null(rv$X) && !is.null(rv$Y)){
      shinyjs::enable("compute")
      messageNotif$icon[1] <- icon_right
      messageNotif$status[1] <- status_right
    }
  })

  observeEvent(input$compute, {
    computeSV()
  })

  computeSV <- reactive({
    shinyjs::disable("compute")
    messageNotif$icon[2] <- icon_current
    messageNotif$status[2] <- status_current
    messageNotif$icon[3] <- icon_current
    messageNotif$status[3] <- status_current
      # CALIBRATION FUNCTION
    messageNotif$icon[2] <- icon_right
    messageNotif$status[2] <- status_right
      # SIMULATION FUNCTION
    messageNotif$icon[3] <- icon_right
    messageNotif$status[3] <- status_right
    shinyjs::enable("compute")
    return()
  })

  # Notifications and updates about the computations :
  output$notif <- renderMenu({
    notifs <- apply(messageNotif, 1, function(row) {
      notificationItem(
        text = row[["text"]],
        icon = icon(row[["icon"]]),
        status = row[["status"]]
      )
    })
    dropdownMenu(type = "notifications",
                 badgeStatus = status_warning,
                 .list = notifs)
  })
}

global.R

skin_color = "blue"

icon_current <- "fas fa-spinner"
icon_wrong <- "fas fa-times-circle"
icon_right <- "fas fa-check-circle"
icon_warning <- "exclamation-triangle"

status_current <- "info"
status_warning <- "warning"
status_wrong <- "danger"
status_right <- "success"

icon_files <- icon_wrong
icon_calib <- icon_wrong
icon_simu <- icon_wrong

status_files <- status_wrong
status_calib <- status_wrong
status_simu <- status_wrong

messageNotif <- data.frame(
  text = c("Status of the input files", "Status of the calibration", "Status of the simulation"),
  icon = c(icon_files, icon_calib, icon_simu),
  status = c(status_files, status_calib, status_simu),
  stringsAsFactors = FALSE
)

（我猜你会在家里有一个.csv文件来测试它。：p）

我不确定为什么它没有按照我想要的方式更新（好吧，我有一个猜测，但它更像是'感觉'而不是完全理解的解释......）

感谢您的帮助，不要犹豫，要求更多的精确度。问候。

更新闪亮的下拉菜单（来自shinydashboard包）

0 个答案: