Question

我想在导航栏中点击其他标签时，尝试向闪亮的导航栏页面添加新标签。

以下按预期工作，但我想跳转到新添加的标签（而不是跳回＆＃34; Home＆＃34;）。

ui.R

library(shiny)

shinyUI(
  fillPage(
    uiOutput("updateableNavbar")
  )

)

server.R

function(input, output, session) {
  navbarParams <- reactiveValues(
    params = list(
      id = "navbar", 
      title = "navbar", 
      home = tabPanel("Home", titlePanel("Home")),
      add = navbarMenu("AddPanels",
                       tabPanel("AddPanel1", titlePanel("AddPanel1")), 
                       tabPanel("AddPanel2", titlePanel("AddPanel2"))
      )
    )
  )

  lastPanelKlicked <- NULL
  observe({    
    if(!is.null(input$navbar) && substr(input$navbar, 1, 8) == "AddPanel" && 
         (is.null(lastPanelKlicked) || lastPanelKlicked != input$navbar)) {   
      lastPanelKlicked <<- input$navbar
      print(input$navbar)
      params <- navbarParams$params
      params[[length(params) + 1]] <- tabPanel(input$navbar, titlePanel(input$navbar))
      names(params)[length(params)] <- input$navbar
      navbarParams$params <<- params
    }
  })  

  output$updateableNavbar <- renderUI({
    do.call(navbarPage, navbarParams$params)
  })  
}

Answer 1

那怎么样？

### server.R

function(input, output, session) {

  navbarParams <- reactiveValues(
    params = list(
      id = "navbar", 
      title = "navbar", 
      home = tabPanel("Home", titlePanel("Home")),
      add = navbarMenu("AddPanels",
                       tabPanel("AddPanel1", titlePanel("AddPanel1")), 
                       tabPanel("AddPanel2", titlePanel("AddPanel2"))
      )
    )
  )

  lastPanelKlicked <- NULL
  makeReactiveBinding("lastPanelKlicked")

  observe({    
    if(!is.null(input$navbar) && substr(input$navbar, 1, 8) == "AddPanel" && 
       (is.null(lastPanelKlicked) || paste0("Add", lastPanelKlicked) != input$navbar)) {

      # Above and below I changed the Value of lastPanelClicked

      lastPanelKlicked <<- substr(input$navbar, 4, 1000)
      print(lastPanelKlicked)
      params <- navbarParams$params
      params[[length(params) + 1]] <- tabPanel(lastPanelKlicked, titlePanel(lastPanelKlicked))
      names(params)[length(params)] <- lastPanelKlicked
      navbarParams$params <<- params
    }
  })  

  output$updateableNavbar <- renderUI({
    do.call(navbarPage, navbarParams$params)
  })  

  observe({
    updateNavbarPage(session, "navbar", lastPanelKlicked)
  })

}

我基本上使lastPanelKlicked反应，以便在设置参数后，触发observe - updateNavbarPage语句。

但有一个问题是您多次分配了tabPanel - ID。您的所有面板（在原始代码中）都被称为AddPanel1或AddPanel2，如果您想选择一个面板，它会选择第一个具有此名称的面板（{{1 }}）。因此，我必须使用navbarMenu或Panel1重命名生成的面板，以说明其工作原理。

如果您想应用此解决方案，我建议您考虑如何命名选项卡的模式，以便您可以明确地调用它们。

如果不清楚，请询问！

动态添加选项卡到navbarPage并选择新选项卡

1 个答案: