這個問題似乎是重複的,但讓我解釋它爲什麼不是。Navbar/Tabset與反應面板號碼,但沒有呈現所有內容
我想創建一個閃亮的navbarPage
,它具有固定的元素和一個響應號碼tabPanels
,它對其他輸入元素有反應。關於如何創建被動tabsetPanels/navbarPages
有很多問題,但他們主要針對看起來像。最常見的答案(以及我不尋求的答案)是使整個navbarPage
呈現更新後的一組tabPanels
。我知道這個概念,我在下面的代碼中使用它。
下面是我想我的應用程序樣子:
library(shiny)
runApp(
shinyApp(
ui = shinyUI(
fluidPage(
uiOutput("navPage")
)
),
server = function(input, output, session){
MemoryValue1 <- 1
MemoryValue2 <- 1
makeReactiveBinding("MemoryValue1")
observeEvent(input$button, {
output[[paste0("plot_", input$number)]] <- renderPlot({
hist(rnorm(1000))
})
})
observeEvent(input$insidepanels, {
MemoryValue1 <<- input$insidepanels
})
observeEvent(input$number, {
MemoryValue2 <<- input$number
})
output$navPage <- renderUI({
OutsidePanel1 <- tabPanel("Outside1",
numericInput("insidepanels", label = "Number of panels inside NavMenu", value = isolate(MemoryValue1), step = 1, min = 1),
numericInput("number", label = "Panel to add Output-Element to", value = 1, step = isolate(MemoryValue2), min = 1),
actionButton("button", label = "Add Output-Element")
)
OutsidePanel2 <- tabPanel("Ouside2", "Outside 2")
InsidePanels <- lapply(1:MemoryValue1, function(x){tabPanel(paste0("Inside", x), plotOutput(paste0("plot_", x)))})
do.call(navbarPage, list("Nav", OutsidePanel1, OutsidePanel2, do.call(navbarMenu, c("Menu", InsidePanels))))
})
}
)
)
正如你可能已經看到,它需要很多的努力來存儲,如果他們有其他的面板內,將是你的輸入值重新呈現=一直重置。由於不必要的渲染,我發現這個解決方案難以辨認和緩慢。它還會中斷點擊input$insidepanels
的值的用戶。
我想要的應用程序就像是外面板是固定的,不重新渲染。主要問題是內部閃亮,navbarPage
渲染分發HTML元素到兩個不同的位置。在導航面板內部以及作爲標籤內容的正文。這意味着添加了posteori的元素將不會被正確嵌入。
到目前爲止,我試圖創建帶有自定義標籤的navbarPage
,並且動態輸出只改變其中的一部分。這對導航面板非常有效,但與選項卡內容無關。原因是所有標籤(他們的div容器)都是一個接一個地列出來的,一旦我想一次注入多個標籤,我就排除在htmlOutput
之外,因爲它(看起來)必須有 a container
並且不能僅僅遞送純HTML。因此,所有自定義選項卡都沒有正確識別。
這裏我到目前爲止的代碼:
library(shiny)
runApp(
shinyApp(
ui = shinyUI(
fluidPage(
tags$nav(class = "navbar navbar-default navbar-static-top", role = "navigation",
tags$div(class = "container",
tags$div(class = "navbar-header",
tags$span(class = "navbar-brand", "Nav")
),
tags$ul(class = "nav navbar-nav",
tags$li(
tags$a(href = "#tab1", "data-toggle" = "tab", "data-value" = "Outside1", "Outside1")
),
tags$li(
tags$a(href = "#tab2", "data-toggle" = "tab", "data-value" = "Outside2", "Outside2")
),
tags$li(class = "dropdown",
tags$a(href = "#", class = "dropdown-toggle", "data-toggle" = "dropdown", "Menu1"),
htmlOutput("dropdownmenu", container = tags$ul, class = "dropdown-menu")
)
)
)
),
tags$div(class = "container-fluid",
tags$div(class = "tab-content", id = "tabContent",
tags$div(class = "tab-pane active", "data-value" = "Outside1", id = "tab1",
numericInput("insidepanels", label = "Number of panels inside NavMenu", value = 1, step = 1, min = 1),
numericInput("number", label = "Panel to add Output-Element to", value = 1, step = 1, min = 1),
actionButton("button", label = "Add Output-Element")
),
tags$div(class = "tab-pane", "data-value" = "Outside2", id = "tab2", "Content 2"),
htmlOutput("tabcontents")
)
)
)
),
server = function(input, output, session){
observeEvent(input$button, {
output[[paste0("plot_", input$number)]] <- renderPlot({
hist(rnorm(1000))
})
})
output$dropdownmenu <- renderUI({
lapply(1:input$insidepanels, function(x){tags$li(tags$a(href = paste0("#tab-menu-", x), "data-toggle" = "tab", "data-value" = paste0("Inside", x), paste("Inside", x)))})
})
output$tabcontents <- renderUI({
tagList(
lapply(1:input$insidepanels, function(x){div(class = "tab-pane", "data-value" = paste("Inside", x), id = paste0("tab-menu-", x), plotOutput(paste0("plot_", x)))})
)
})
}
)
)
注:我還試圖創建與從內部server
觸發JavaScript的HTML大塊。這適用於簡單的標籤內容,但我希望我的tabPanels
仍然有閃亮的輸出元素。我沒有看到如何使用JavaScript來適應這一點。這就是爲什麼我在我的代碼中包含plotOutput
內容的原因。
感謝任何人誰可以幫助解決這個問題!