我正在尝试创建一个Shinyapp，用户可以根据需要添加任意数量的新标签并进行数据分析。在原型应用程序中，我可以添加新选项卡并使用不同的参数集绘制不同的图
但是问题是，如果我先说2个选项卡并在这些选项卡中准备了某种绘图，并且我想再添加一个选项卡进行另一种分析，那么当我创建第三个选项卡时，前两个绘图标签会重新生成。
请帮助我解决添加新标签后重新生成现有标签的问题。
工作代码如下。请在“标签名称”字段中选择值以创建新标签。
library(shiny)
library(plyr)
library(dplyr)
library(DT)
library(data.table)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = 'mtcar anlyisis'),
dashboardSidebar(sidebarMenu(
menuItem("Tab names", tabName = "tabnamesuiTab", icon = icon("table"))
)),
dashboardBody(tabItems(
tabItem(
tabName = 'tabnamesuiTab',
sidebarLayout(position = 'right',
sidebarPanel(fluidRow(box(
fluidRow(column(12, uiOutput('tabnamesui')))
))),
mainPanel(fluidRow(
splitLayout(cellWidths = c("100%"),
uiOutput("tabsets"))
)))
)
))
)
server <- function(input, output, session) {
mtcarsFile <- reactive({
input$mtcars
})
# )
xxmtcars <- reactive({
as.data.table(mtcars)
})
tabsnames <- reactive({
names(xxmtcars())
})
output$tabnamesui <- renderUI({
selectInput(
'tabnamesui',
h5('Tab names'),
choices = as.list(tabsnames()),
multiple = T
)
})
YAxisValues <-
reactive({
names(xxmtcars()[, sapply(xxmtcars(), is.numeric)])
})
tabnamesinput <- reactive({
input$tabnamesui
})
output$tabsets <- renderUI({
tabs <-
reactive({
lapply(tabnamesinput(), function(x)
tabPanel(
title = basename(x)
,
fluidRow(
#splitLayout(cellWidths = c("20%", "20%","15%","15%","15%","15%")
column(2, uiOutput(
paste0('ui1', x)
)),
column(2, uiOutput(
paste0('calculationUi2', x)
)),
column(2, uiOutput(
paste0('ui5', x)
)),
column(2, uiOutput(
paste0('ui2', x)
)),
column(2, uiOutput(
paste0('ui3', x)
)),
column(2, uiOutput(
paste0('ui4', x)
))
),
fluidRow(#splitLayout(cellWidths = c("20%", "20%","20%","20%","20%")
column(
2, uiOutput(paste0('ui6', x))
)),
fluidRow(
splitLayout(
cellWidths = c("100%"),
plotlyOutput(paste0('plot1', x))
)
)
))
})
do.call(tabsetPanel, c(tabs()))
})
#########
observe(lapply(tabnamesinput(), function(x) {
output[[paste0('ui1', x)]] <-
renderUI({
selectInput(
paste0('ui1', x),
h5('Measurement'),
choices = YAxisValues(),
multiple = F,
width = '75%'
# selected = 'wt'
)
})
}))
observe(lapply(tabnamesinput(), function(x) {
output[[paste0('calculationUi2', x)]] <-
renderUI({
selectInput(
paste0('calculationUi2', x),
h5('Calculation'),
choices = c('sum', 'mean', 'min', 'max', 'count'),
multiple = F,
width = '75%'
)
})
}))
observe(lapply(tabnamesinput(), function(x) {
output[[paste0('ui2', x)]] <-
renderUI({
selectInput(
paste0('ui2', x),
h5('Colour'),
choices = names(xxmtcars()),
multiple = F,
width = '75%'
)
})
}))
observe(lapply(tabnamesinput(), function(x) {
output[[paste0('ui3', x)]] <-
renderUI({
selectInput(
paste0('ui3', x),
h5('Mousehover info'),
choices = names(xxmtcars()),
multiple = F,
width = '75%'
)
})
}))
observe(lapply(tabnamesinput(), function(x) {
output[[paste0('ui4', x)]] <-
renderUI({
selectInput(
paste0('ui4', x),
h5('PlotType'),
choices = c('markers', 'lines+markers'),
multiple = F,
width = '75%'
)
})
}))
#########
#################
subsetdata_x <- reactive({
list_of_subdata_x <- lapply(tabnamesinput(), function(x) {
as.data.table((select(xxmtcars(
), x)))
})
names(list_of_subdata_x) <- tabnamesinput()
return(list_of_subdata_x)
})
subsetdata_y <- reactive({
list_of_subdata_y <- lapply(tabnamesinput(), function(x) {
as.data.table((select(
xxmtcars(), input[[paste0('ui1', x)]]
)))
})
names(list_of_subdata_y) <- tabnamesinput()
return(list_of_subdata_y)
})
subsetdata_col <- reactive({
list_of_subdata_col <- lapply(tabnamesinput(), function(x) {
as.data.table((select(
xxmtcars(), input[[paste0('ui2', x)]]
)))
})
names(list_of_subdata_col) <- tabnamesinput()
return(list_of_subdata_col)
})
subsetdata_hover <- reactive({
list_of_subdata_hover <- lapply(tabnamesinput(), function(x) {
as.data.table((select(
xxmtcars(), input[[paste0('ui3', x)]]
)))
})
names(list_of_subdata_hover) <- tabnamesinput()
return(list_of_subdata_hover)
})
observe(lapply(tabnamesinput(), function(x) {
output[[paste0('plot1', x)]] <-
{
renderPlotly({
cbind.data.frame(
subsetdata_x()[[x]],
subsetdata_y()[[x]],
subsetdata_col()[[x]],
subsetdata_hover()[[x]]
) %>% setnames(c('x', 'y', 'col', 'hover')) %>% group_by(x, col, hover) %>%
summarize(y = sum(y)) %>% plot_ly(
x = ~ x,
y = ~ y,
type = 'scatter',
mode = input[[paste0('ui4', x)]],
marker = (list(size = 10)),
color = ~ col,
text = ~ paste(hover)
) %>% layout(autosize =
T)
})
}
}))
}
runApp(list(ui = ui, server = server))