Question

我正在构建一个Shiny仪表板，它具有多个选项卡，每个选项卡都位于一个独立的页面中，并且可以从侧栏中的选项卡项目进行定向。

的链接在每个标签上添加页面刷新按钮。

但是，我只能将其添加到一个标签中，当我为其他标签复制并粘贴相同的代码时，它会失败

下面是我使用的当前结构：

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

jscode <- "shinyjs.refresh = function() { history.go(0); }"

header <- dashboardHeader(

)

sidebar <- dashboardSidebar(
  tags$head(tags$style(HTML('.content-wrapper { height: 1500px !important;}'))),
  sidebarMenu (
    menuItem("A", tabName = "d1"),
    menuItem("B", tabName = "d2"),
    menuItem("C", tabName = "d3")
  )
)

body <- dashboardBody(
  useShinyjs(),
  extendShinyjs(text = jscode),
  tabItems(
    tabItem(tabName = "d1",
            box(title = "AAA",
                actionButton("refresh", "Save"))
    ),
    tabItem(tabName = "d2",
             box(title = "BBB")
    ),
    tabItem(tabName = "d3",
            box(title = "CCC")
    )
  )
)

# UI
ui <- dashboardPage(header, sidebar, body)

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

  observeEvent({
    input$aa
    input$refresh
  })

  observeEvent(input$refresh, {
    js$refresh();
  })

  observeEvent({
    input$bb
  })

  observeEvent({
    input$cc
  })


}

# Shiny dashboard
shiny::shinyApp(ui, server)

基本上，现在我只在标签1 中输入 aa 的页面刷新按钮称为 SAVE 。

我想知道如何在 tab 2 和 tab 3 上为输入 bb 和< strong> cc 。理想的解决方案是，如果用户单击任意页面上的任何保存按钮，则刷新Shiny仪表板。

预先感谢

Answer 1

您必须为每个选项卡创建3个不同的按钮，然后才能调用其中之一进行刷新：

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

jscode <- "shinyjs.refresh = function() { history.go(0); }"

header <- dashboardHeader(

)

sidebar <- dashboardSidebar(
  tags$head(tags$style(HTML('.content-wrapper { height: 1500px !important;}'))),
  sidebarMenu (
    menuItem("A", tabName = "d1"),
    menuItem("B", tabName = "d2"),
    menuItem("C", tabName = "d3")
  )
)

body <- dashboardBody(
  useShinyjs(),
  extendShinyjs(text = jscode),
  tabItems(
    tabItem(tabName = "d1",
            box(title = "AAA",
                actionButton("b1", "Save"))
    ),
    tabItem(tabName = "d2",
            box(title = "BBB",
                actionButton("b2", "Save"))
    ),
    tabItem(tabName = "d3",
            box(title = "CCC",
                actionButton("b3", "Save"))
    )
  )
)

# UI
ui <- dashboardPage(header, sidebar, body)

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

  observeEvent(c(input$b1,input$b2,input$b3), {
    js$refresh()
  },ignoreNULL = T,ignoreInit = T)

}

# Shiny dashboard
shiny::shinyApp(ui, server)

Answer 2

以防万一您不是ShinyJS的最大乐趣。此代码应为您提供帮助。玩得开心

library(shiny)
library(shinydashboard)


dat = data.frame(id = c("d","a","c","b"), a = c(1,2,3,4), b = c(6,7,8,9))

header <- dashboardHeader(

)

sidebar <- dashboardSidebar(
  tags$head(tags$style(HTML('.content-wrapper { height: 1500px !important;}'))),
  sidebarMenu (
    menuItem("A", tabName = "d1"),
    menuItem("B", tabName = "d2"),
    menuItem("C", tabName = "d3")
  )
)

body <- dashboardBody(

  tabItems(
    tabItem(tabName = "d1",
            box(title = "AAA",
                actionButton("refreshTab1_id", "Refresh Tab 1"),
                actionButton("sortTable1_id", "Sort Table 1"),
                DT::dataTableOutput("table_for_tab_1", width = "100%"))
    ),
    tabItem(tabName = "d2",
             box(title = "BBB",
                actionButton("refreshTab2_id", "Refresh Tab 2"),
                actionButton("sortTable2_id", "Sort Table 2"),
                DT::dataTableOutput("table_for_tab_2", width = "100%"))
    ),
    tabItem(tabName = "d3",
            box(title = "CCC",
                actionButton("refreshTab3_id", "Refresh Tab 3"),
                actionButton("sortTable3_id", "Sort Table 3"),
                DT::dataTableOutput("table_for_tab_3", width = "100%"))
    )
  )
)

# UI
ui <- dashboardPage(header, sidebar, body)

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


    observe({

        if (input$sortTable1_id || input$sortTable2_id || input$sortTable3_id) {
            dat_1 = dat %>% dplyr::arrange(id)
        } else {
            dat_1 = dat
        }

        output$table_for_tab_1 <- output$table_for_tab_2 <- output$table_for_tab_3 <- DT::renderDataTable({ 

            DT::datatable(dat_1, 
                    filter = 'bottom', 
                    selection = "single",
                    colnames = c("Id", "A", "B"),
                    options = list(pageLength = 10,
                                    autoWidth = TRUE#,
                                    # columnDefs = list(list(targets = 9, 
                                    #                        visible = FALSE))
                    )
            )
        })
    })

    observe({
        if (input$refreshTab1_id || input$refreshTab2_id || input$refreshTab3_id) {
            session$reload()
        }
    })

}

# Shiny dashboard
shiny::shinyApp(ui, server)

多个选项卡的R闪亮页面刷新按钮

2 个答案: