Связывание заголовка valueBox с другой панелью вкладок - PullRequest
Новая
       7

Связывание заголовка valueBox с другой панелью вкладок

1 голос
/ 11 февраля 2020

Предположим, у вас есть базовое c shinydashboard приложение с двумя tabPanels внутри tabBox: 

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(),
  dashboardBody(

    fluidRow(width = 12, 
             tabBox(width = 12,
                    tabPanel("Info 1",
                             fluidRow(
                               valueBoxOutput("box")
                             )
                    ) ,

                    tabPanel("Info 2",
                             "Some Info about Tab 2."  
                    )
             )
    )
  )
)


server <- function(input, output) {

  output$box<-renderValueBox(     

    valueBox(
      value = "ValueBox Title",
      subtitle = tagList("Some information about the box.",
                         p(""),
                         "Some more information about the box."
      ),
      icon = icon("user-check"),
      color = "green"
    ))

}

app<-shinyApp(ui = ui, server = server)
runApp(app, host="0.0.0.0",port=5060, launch.browser = TRUE)

В одном tabPanel (здесь он называется "Info 1") у вас есть valueBox с заголовком (в данном случае «ValueBox Title»). Можно ли сделать заголовок valueBox гиперссылкой так, чтобы он открывал tabPanel, называемый «Инфо 2»?

В моем приложении я sh получу tabPanel, который показывает сводную информацию для всего анализа. Если пользователь желает перейти на более подробную информацию и получить более подробную информацию о сводных данных, представленных в valueBox, я хочу перевести их на другую вкладку, которая содержит больше данных.

1 Ответ

1 голос
/ 12 февраля 2020

Чтобы получить желаемое поведение, вам нужно дать id вашему tabBox, чтобы вы могли обновить его с помощью updateTabsetPanel.

Пожалуйста, проверьте следующее: 

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(),
  dashboardBody(fluidRow(
    width = 12,
    tabBox(
      width = 12,
      id = "tabBoxId",
      tabPanel("Info 1",
               fluidRow(valueBoxOutput("box"))) ,
      tabPanel("Info 2",
               "Some Info about Tab 2.")
    )
  ))
)


server <- function(input, output, session) {
  output$box <- renderValueBox({
    valueBox(
      value = actionLink(
        inputId = "valueBoxLink",
        label = div("ValueBox Title", style = "color: white")
      ),
      subtitle = tagList(
        "Some information about the box.",
        p(""),
        "Some more information about the box."
      ),
      icon = icon("user-check"),
      color = "green"
    )
  })

  observeEvent(input$valueBoxLink, {
    updateTabsetPanel(session, inputId = "tabBoxId", selected = "Info 2")
  })
}

app <- shinyApp(ui = ui, server = server)
runApp(app, host = "0.0.0.0", port = 5060, launch.browser = TRUE)

Result

...