如何访问/打印/跟踪 Shiny 应用程序中的当前选项卡选择？
Posted
技术标签:
【中文标题】如何访问/打印/跟踪 Shiny 应用程序中的当前选项卡选择？【英文标题】：How do I access/print/track the current tab selection in a Shiny app? 【发布时间】：2016-08-10 02:15:50 【问题描述】：我在一个闪亮的应用程序中工作，我希望能够访问用户在会话中当前选项卡上的信息。
我有一个观察事件，用于侦听要单击的特定按钮。简单来说，我想存储/打印用户单击此按钮时所在的当前选项卡。在他们单击此按钮后，该选项卡将更改为带有 updateTabItems 的“帮助”，该 updateTabItems 将会话、inputId 和选定的值作为参数。
# Observe event when someone clicks a button
observeEvent(input$help,
# if they are logged in
if(USER$Logged == TRUE)
# current_tab <- ???
shiny_session <<- session
updateTabItems(session, "sidebar", selected = "help")
)
由于会话具有一定的价值，我试图探索它。
> class(shiny_session)
[1] "ShinySession" "R6"
> names(shiny_session)
[1] ".__enclos_env__" "session"
[3] "groups" "user"
[5] "singletons" "request"
[7] "closed" "downloads"
[9] "files" "token"
[11] "clientData" "output"
[13] "input" "progressStack"
[15] "clone" "decrementBusyCount"
[17] "incrementBusyCount" "outputOptions"
[19] "manageInputs" "manageHiddenOutputs"
[21] "registerDataObj" "registerDownload"
[23] "fileUrl" "saveFileUrl"
[25] "handleRequest" "@uploadEnd"
[27] "@uploadInit" "@uploadieFinish"
[29] "reload" "reactlog"
[31] "onFlushed" "onFlush"
[33] "sendInputMessage" "sendCustomMessage"
[35] "dispatch" "sendProgress"
[37] "showProgress" "flushOutput"
[39] "defineOutput" "setShowcase"
[41] "isEnded" "isClosed"
[43] "wsClosed" "close"
[45] "unhandledError" "onInputReceived"
[47] "onEnded" "onSessionEnded"
[49] "ns" "makeScope"
[51] "initialize"
我试图探索闪亮会话的这些元素，它们大多被构造为函数，在当前选项卡上找不到任何东西。
UpdateTabItems 似乎接受值并将它们发送到 sendInputMessage。
> updateTabItems
function (session, inputId, selected = NULL)
message <- dropNulls(list(value = selected))
session$sendInputMessage(inputId, message)
这似乎是在闪亮的应用程序中执行的某种命令堆栈，所以我停止探索它。
> shiny_session$sendInputMessage
function (inputId, message)
data <- list(id = inputId, message = message)
private$inputMessageQueue[[length(private$inputMessageQueue) +
1]] <- data
关于如何在给定时间点访问变量中的当前选项卡信息有什么建议吗？
谢谢。
【问题讨论】：
【参考方案1】：由于您没有提供minimal reproducible example，因此我必须做出一些猜测来生成一个合适的示例 - 但这很好 :) 看来您正在使用 shinydashboard 并且在应用程序中您有一个 @987654323 @ 至少有两个标签。
我希望能够访问用户在会话中所在的当前选项卡上的信息。
您可以给sidebarMenu 一个ID，比如tabs，然后您可以通过input$tabs 访问当前选项卡上的信息。
让我们看一下下面突出这两个方面的示例
首先，我们以独特的ID“奖励”sidebarMenu
sidebarMenu(id = "tabs",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Help", tabName = "help", icon = icon("h-square"))
)
然后用
在服务器端监视它observe(
print(input$tabs)
)
完整示例：
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Example"),
dashboardSidebar(
sidebarMenu(id = "tabs", # note the id
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Help", tabName = "help", icon = icon("h-square"))
),
br(),
# Teleporting button
actionButton("teleportation", "Teleport to HELP", icon = icon("h-square"))
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")
),
tabItem(tabName = "help",
h2("Help tab content")
)
)
)
)
server <- function(input, output, session)
# prints acutall tab
observe(
print(input$tabs)
)
observeEvent(input$teleportation,
# if (USER$Logged == TRUE)
if (input$tabs != "help")
# it requires an ID of sidebarMenu (in this case)
updateTabItems(session, inputId = "tabs", selected = "help")
#
)
shinyApp(ui, server)
【讨论】：
谢谢，这就是我想要的。【参考方案2】：这是你的预期吗？
library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(kableExtra)
sidebar <- dashboardSidebar(
sidebarMenu(id = "tab",
menuItem("1", tabName = "1"),
menuItem("2", tabName = "2"),
menuItem("3", tabName = "3"),
menuItem("4", tabName = "4")
)
)
body <- ## Body content
dashboardBody(box(width = 12,fluidRow(
column(
width = 3,
# pickerInput(
# inputId = "metric",
# label = h4("Metric Name"),
# choices = c(
# "alpha",
# "beta"
# ),
#
# width = "100%"
# )
uiOutput("metric")
, actionButton("show", "Help")
)
)))
ui <- dashboardPage(dashboardHeader(title = "Scorecard"),
sidebar,
body)
# Define the server code
server <- function(input, output,session)
# observeEvent(input$metric,
# if (input$tab == "1")
# choices <- c(
# "alpha",
# "beta"
# )
#
# else if (input$tab == "2")
# choices <- c(
# "apple",
# "orange"
# )
#
# else
# choices <- c(
# "foo",
# "zoo",
# "boo"
# )
#
# updatePickerInput(session,
# inputId = "metric",
# choices = choices)
# )
output$metric<-renderUI(
if (input$tab == "1")
choices <- c(
"alpha",
"beta"
)
else if (input$tab == "2")
choices <- c(
"apple",
"orange"
)
else
choices <- c(
"foo",
"zoo",
"boo"
)
pickerInput(
inputId = "metric",
label = h4("Metric Name"),
choices = choices,
width = "100%"
)
)
faq1 <- data.frame(
Findings = c(
"lorem ipsum"
))
faq2 <- data.frame(
Findings = c(
"lorem ipsum bacon"
))
faq3 <- data.frame(
Findings = c(
"lorem ipsum bacon bacon"
))
observeEvent(input$show,
showModal(modalDialog(
title = "Guildlines",
tableOutput("kable_table"),
easyClose = TRUE
))
)
faqtext<-reactive(
if (input$tab == "1")
return(faq1)
else if (input$tab == "2")
return(faq2)
else if (input$tab == "3")
return(faq3)
else
return(benchmark_faq)
)
output$kable_table<-function()
kable(faqtext()) %>%
kable_styling("striped", full_width = F) %>%
column_spec(1, bold = T, border_right = T)%>%html
shinyApp(ui = ui, server = server)
【讨论】：
以上是关于如何访问/打印/跟踪 Shiny 应用程序中的当前选项卡选择？的主要内容，如果未能解决你的问题，请参考以下文章