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

pprl5pva  于 5个月前  发布在  其他
关注(0)|答案(2)|浏览(60)

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

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

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

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

library(shiny)
library(bslib)

all_forms <- c("Dynamic Tab1", "Dynamic Tab2")

ui <- fluidPage(
  bslib::page_navbar(
    id = "all_tabs",
    sidebar = bslib::sidebar(textOutput("active_tab")), 
    bslib::nav_panel("static tab")
  ) 
)

server <- function(input, output, session) {
  lapply(all_forms, \(i){
    bslib::nav_insert(
      id = "all_tabs",
      bslib::nav_panel(i)
    )
  })
  
  output[["active_tab"]] <- renderText({
    input$all_tabs
  })
  
}

shinyApp(ui, server)

字符串
会话信息:

R version 4.3.1 (2023-06-16 ucrt)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 11 x64 (build 22621)

Matrix products: default

locale:
[1] LC_COLLATE=German_Germany.utf8  LC_CTYPE=German_Germany.utf8    LC_MONETARY=German_Germany.utf8 LC_NUMERIC=C                   
[5] LC_TIME=German_Germany.utf8    

time zone: Europe/Berlin
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices datasets  utils     methods   base     

other attached packages:
[1] bslib_0.5.1   shiny_1.7.5.1

loaded via a namespace (and not attached):
 [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     
 [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       
[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        
[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

library(shiny)
library(bslib)

all_forms <- c("Dynamic Tab1", "Dynamic Tab2")

link_shiny <- tags$a(
  shiny::icon("github"), "Shiny",
  href = "https://github.com/rstudio/shiny",
  target = "_blank"
)
link_posit <- tags$a(
  shiny::icon("r-project"), "Posit",
  href = "https://posit.co",
  target = "_blank"
)

ui <- fluidPage(
  uiOutput("all_tabs"),
  textOutput("active_tab")
)

server <- function(input, output, session) {
  
  output[["all_tabs"]] <- renderUI({
    do.call(page_navbar, c(title = "My App",
                           id = "all_tabs",
                           bg = "#0062cc",
                           list(
                             nav_panel(title = "One", p("First tab content.")),
                             nav_panel(title = "Two", p("Second tab content.")),
                             nav_panel(title = "Three", p("Third tab content"))),
                           lapply(all_forms, \(nav){bslib::nav_panel(nav, p(nav))}),
                           list(
                             nav_spacer(),
                             nav_menu(
                               title = "Links",
                               align = "right",
                               nav_item(link_shiny),
                               nav_item(link_posit)
                             )
                           )))
  })
  
  output[["active_tab"]] <- renderText({
    paste("You selected tab ",input$all_tabs)
  })
  
}

shinyApp(ui, server)

字符串

tyky79it

tyky79it2#

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

library(shiny)
library(bslib)

all_forms <- c("Dynamic Tab1", "Dynamic Tab2")

ui <- bslib::page_fluid(
  bslib::page_navbar(
    id = "all_tabs",
    sidebar = bslib::sidebar(textOutput("active_tab")), 
    bslib::nav_panel("static tab")
  ) 
)

server <- function(input, output, session) {
  lapply(all_forms, \(i){
    bslib::nav_insert(
      id = "all_tabs",
      bslib::nav_panel(i)
    )
  })
  
  output[["active_tab"]] <- renderText({
    input$all_tabs
  })
  
}

shinyApp(ui, server)

字符串

相关问题