如何在服务器中使用bslib::nav_insert()生成标签时在Shiny应用中显示活动标签的名称?

pprl5pva  于 2024-01-03  发布在  其他
关注(0)|答案(2)|浏览(206)

(MRE给定一个带有标签集(bslib::navset_tab)的Shiny应用程序,其中包含一个在UI中创建的静态标签,以及一些在服务器中使用bslib::insert()创建的动态标签,并且活动标签名称显示在应用程序的侧边栏中:

  • 如果静态选项卡处于活动状态,则选项卡的名称将按预期显示在侧边栏中:

  • 但是,如果任何动态创建的选项卡处于活动状态,则侧边栏中的名称不会显示,并在输入变量中保留NULL

我需要修改什么才能在输入变量input$all_tabs中再次获得活动选项卡的名称?

  1. library(shiny)
  2. library(bslib)
  3. all_forms <- c("Dynamic Tab1", "Dynamic Tab2")
  4. ui <- fluidPage(
  5. bslib::page_navbar(
  6. id = "all_tabs",
  7. sidebar = bslib::sidebar(textOutput("active_tab")),
  8. bslib::nav_panel("static tab")
  9. )
  10. )
  11. server <- function(input, output, session) {
  12. lapply(all_forms, \(i){
  13. bslib::nav_insert(
  14. id = "all_tabs",
  15. bslib::nav_panel(i)
  16. )
  17. })
  18. output[["active_tab"]] <- renderText({
  19. input$all_tabs
  20. })
  21. }
  22. shinyApp(ui, server)

字符串
会话信息:

  1. R version 4.3.1 (2023-06-16 ucrt)
  2. Platform: x86_64-w64-mingw32/x64 (64-bit)
  3. Running under: Windows 11 x64 (build 22621)
  4. Matrix products: default
  5. locale:
  6. [1] LC_COLLATE=German_Germany.utf8 LC_CTYPE=German_Germany.utf8 LC_MONETARY=German_Germany.utf8 LC_NUMERIC=C
  7. [5] LC_TIME=German_Germany.utf8
  8. time zone: Europe/Berlin
  9. tzcode source: internal
  10. attached base packages:
  11. [1] stats graphics grDevices datasets utils methods base
  12. other attached packages:
  13. [1] bslib_0.5.1 shiny_1.7.5.1
  14. loaded via a namespace (and not attached):
  15. [1] digest_0.6.33 later_1.3.1 R6_2.5.1 httpuv_1.6.12 fastmap_1.1.1 magrittr_2.0.3 cachem_1.0.8
  16. [8] memoise_2.0.1 htmltools_0.5.6.1 lifecycle_1.0.3 promises_1.2.1 cli_3.6.1 xtable_1.8-4 sass_0.4.7
  17. [15] jquerylib_0.1.4 renv_1.0.3 compiler_4.3.1 rstudioapi_0.15.0 tools_4.3.1 ellipsis_0.3.2 mime_0.12
  18. [22] Rcpp_1.0.11 yaml_2.3.7 fs_1.6.3 jsonlite_1.8.7 rlang_1.1.1

pu3pd22g

pu3pd22g1#

一种方法是在renderUI中使用do.call

  1. library(shiny)
  2. library(bslib)
  3. all_forms <- c("Dynamic Tab1", "Dynamic Tab2")
  4. link_shiny <- tags$a(
  5. shiny::icon("github"), "Shiny",
  6. href = "https://github.com/rstudio/shiny",
  7. target = "_blank"
  8. )
  9. link_posit <- tags$a(
  10. shiny::icon("r-project"), "Posit",
  11. href = "https://posit.co",
  12. target = "_blank"
  13. )
  14. ui <- fluidPage(
  15. uiOutput("all_tabs"),
  16. textOutput("active_tab")
  17. )
  18. server <- function(input, output, session) {
  19. output[["all_tabs"]] <- renderUI({
  20. do.call(page_navbar, c(title = "My App",
  21. id = "all_tabs",
  22. bg = "#0062cc",
  23. list(
  24. nav_panel(title = "One", p("First tab content.")),
  25. nav_panel(title = "Two", p("Second tab content.")),
  26. nav_panel(title = "Three", p("Third tab content"))),
  27. lapply(all_forms, \(nav){bslib::nav_panel(nav, p(nav))}),
  28. list(
  29. nav_spacer(),
  30. nav_menu(
  31. title = "Links",
  32. align = "right",
  33. nav_item(link_shiny),
  34. nav_item(link_posit)
  35. )
  36. )))
  37. })
  38. output[["active_tab"]] <- renderText({
  39. paste("You selected tab ",input$all_tabs)
  40. })
  41. }
  42. shinyApp(ui, server)

字符串

展开查看全部
tyky79it

tyky79it2#

出于某种神秘的原因,将函数shiny::fluidPage()更改为bslib::page_fluid()为我解决了这个问题。

  1. library(shiny)
  2. library(bslib)
  3. all_forms <- c("Dynamic Tab1", "Dynamic Tab2")
  4. ui <- bslib::page_fluid(
  5. bslib::page_navbar(
  6. id = "all_tabs",
  7. sidebar = bslib::sidebar(textOutput("active_tab")),
  8. bslib::nav_panel("static tab")
  9. )
  10. )
  11. server <- function(input, output, session) {
  12. lapply(all_forms, \(i){
  13. bslib::nav_insert(
  14. id = "all_tabs",
  15. bslib::nav_panel(i)
  16. )
  17. })
  18. output[["active_tab"]] <- renderText({
  19. input$all_tabs
  20. })
  21. }
  22. shinyApp(ui, server)

字符串

展开查看全部

相关问题