R 在Shiny中创建的每个新动态选项卡的唯一侧栏输入
我希望在Shiny中为每个新创建的选项卡提供唯一的用户输入，但是，一旦用户选择了它存储的输入，并且没有为创建的其他选项卡进行更改 场景：R 在Shiny中创建的每个新动态选项卡的唯一侧栏输入,r,input,shiny,tabs,output,R,Input,Shiny,Tabs,Output,我希望在Shiny中为每个新创建的选项卡提供唯一的用户输入，但是，一旦用户选择了它存储的输入，并且没有为创建的其他选项卡进行更改 场景： 用户从本地计算机选择的数据 用户从下拉列表中进行选择 单击添加新选项卡 单击“新建”选项卡 用户自定义输入=图形动态更改 返回主页选择新数据并单击添加新选项卡 单击“新建”选项卡 用户自定义输入=图形不更改，并根据步骤5中的用户输入进行更改 数据：任何包含两列A和B的简单csv表都将复制以下结果 所需结果：每个选项卡都有唯一的用户输入，并动态更改活动选项卡图
library(shiny)
library(plyr)
library(dplyr)
library(DT)
library(shinyjs)
library(data.table)
library(ggplot2)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = "Test", id = "tabs",
tabPanel("Home",
sidebarPanel(
fileInput("file", "Upload data",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
checkboxInput("header", "Header", TRUE),
actionButton("append", "Add new tab"),
uiOutput('tabnamesui')
),
mainPanel(
)
)
)
)
server <- function(input, output, session) {
userfile <- reactive({
input$file
})
filereact <- reactive({
read.table(
file = userfile()$datapath,
sep = ',',
header = T,
stringsAsFactors = T
)
})
tabsnames <- reactive({
names(filereact())
})
output$tabnamesui <- renderUI({
req(userfile())
selectInput(
'tabnamesui',
h5('Tab names'),
choices = as.list(tabsnames()),
selected="",multiple = FALSE
)
})
tabnamesinput <- reactive({
input$tabnamesui})
#Append selected tab logic
observeEvent(input$append,{
appendTab(inputId = "tabs",
tabPanel(input$tabnamesui,
sidebarPanel(
actionButton(paste0("remove_", input$tabnamesui), "Delete"),
textInput("x", "X-axis label"),
textInput("titlename", "Title"),
sliderInput("bins", "Number of bins", value = 50, min = 1, max = 100)
),
mainPanel(
plotOutput(paste0("dp2",input$tabnamesui))
)
)
)
})
# Delete selected tab logic
observeEvent(lapply(grep(pattern = "^remove_", x = names(input), value = TRUE), function(x){input[[x]]}),{
if(input$tabs != "Home"){
if (input[[paste0("remove_",input$tabs)]]) { ## remove tab only if delete button has been clicked
removeTab(inputId = "tabs", target = input$tabs)
updateSelectInput(session, "tabnamesui", selected = input$tabnamesui) # keep the selection when re-rendering sidebarPanel
}
}
})
#New tab logic to prevent inserting same tab twice with enable/disable action button
forcecombine = function(idtab,checker) {
colnames(idtab) = colnames(checker)
rbind(idtab,checker)
}
checker<-as.data.frame("checker")
idtab<-as.data.frame("checkers")
#only allow tab entry once
observeEvent(input$append, {
idtab <- paste0(tabnamesinput())
idtab<-as.data.frame(idtab)
checkerx<-forcecombine(idtab,checker)
repeated<-length(grep(idtab,checkerx))
if(repeated==1)
{
shinyjs::disable("append")
}
else {shinyjs::enable("append")
}
})
observeEvent(input$tabnamesui, {
shinyjs::enable("append")
lapply(tabnamesinput(), function(x) {
df <- as.data.table(filereact()[[as.name(tabnamesinput())]])
output[[paste0("dp2",input$tabnamesui)]] <- renderPlot({
bins <- seq(min(as.numeric(unlist(df))), max(as.numeric(unlist(df))), length.out = input$bins + 1)
hist(as.numeric(unlist(df)), # histogram
col="gray",
xlim=c(min(as.numeric(unlist(df))), max(as.numeric(unlist(df)))),
border="black",
breaks = seq(min(as.numeric(unlist(df))), max(as.numeric(unlist(df))), length.out = input$bins+1),
prob = TRUE, # show densities instead of frequencies
xlab = input$x,
main = input$titlename)
})
})
})
shinyjs::disable("append")
observeEvent(input$file, {
shinyjs::enable("append")
})
}
shinyApp(ui, server)
库（闪亮）
图书馆（plyr）
图书馆（dplyr）
图书馆（DT）
图书馆（shinyjs）
库（数据表）
图书馆（GG2）
ui试试这个
ui <- fluidPage(
useShinyjs(),
navbarPage(title = "Test", id = "tabs",
tabPanel("Home",
sidebarPanel(
fileInput("file", "Upload data",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
checkboxInput("header", "Header", TRUE),
actionButton("append", "Add new tab"),
uiOutput('tabnamesui')
),
mainPanel(
)
)
)
)
server <- function(input, output, session) {
userfile <- reactive({
input$file
})
filereact <- reactive({
read.table(
file = userfile()$datapath,
sep = ',',
header = T,
stringsAsFactors = T
)
})
tabsnames <- reactive({
names(filereact())
})
output$tabnamesui <- renderUI({
req(userfile())
selectInput(
'tabnamesui',
h5('Tab names'),
choices = as.list(tabsnames()),
selected="",multiple = FALSE
)
})
tabnamesinput <- reactive({
input$tabnamesui})
#Append selected tab logic
observeEvent(input$append,{
appendTab(inputId = "tabs",
tabPanel(input$tabnamesui,
sidebarPanel(
actionButton(paste0("remove_", input$tabnamesui), "Delete"),
textInput(paste0("x.",input$tabnamesui), "X-axis label"),
textInput(paste0("titlename",input$tabnamesui), "Title"),
sliderInput("bins", "Number of bins", value = 50, min = 1, max = 100)
),
mainPanel(
plotOutput(paste0("dp2",input$tabnamesui))
)
)
)
})
# Delete selected tab logic
observeEvent(lapply(grep(pattern = "^remove_", x = names(input), value = TRUE), function(x){input[[x]]}),{
if(input$tabs != "Home"){
if (input[[paste0("remove_",input$tabs)]]) { ## remove tab only if delete button has been clicked
removeTab(inputId = "tabs", target = input$tabs)
updateSelectInput(session, "tabnamesui", selected = input$tabnamesui) # keep the selection when re-rendering sidebarPanel
}
}
})
#New tab logic to prevent inserting same tab twice with enable/disable action button
forcecombine = function(idtab,checker) {
colnames(idtab) = colnames(checker)
rbind(idtab,checker)
}
checker<-as.data.frame("checker")
idtab<-as.data.frame("checkers")
#only allow tab entry once
observeEvent(input$append, {
idtab <- paste0(tabnamesinput())
idtab<-as.data.frame(idtab)
checkerx<-forcecombine(idtab,checker)
repeated<-length(grep(idtab,checkerx))
if(repeated==1)
{
shinyjs::disable("append")
}
else {shinyjs::enable("append")
}
})
observeEvent(input$tabnamesui, {
shinyjs::enable("append")
lapply(tabnamesinput(), function(x) {
df <- as.data.table(filereact()[[as.name(tabnamesinput())]])
tab_name <- input$tabnamesui
output[[paste0("dp2",input$tabnamesui)]] <- renderPlot({
bins <- seq(min(as.numeric(unlist(df))), max(as.numeric(unlist(df))), length.out = input$bins + 1)
hist(as.numeric(unlist(df)), # histogram
col="gray",
xlim=c(min(as.numeric(unlist(df))), max(as.numeric(unlist(df)))),
border="black",
breaks = seq(min(as.numeric(unlist(df))), max(as.numeric(unlist(df))), length.out = input$bins+1),
prob = TRUE, # show densities instead of frequencies
xlab = input[[paste0("x.",tab_name)]],
main = input[[paste0("titlename",tab_name)]] )
})
})
})
shinyjs::disable("append")
observeEvent(input$file, {
shinyjs::enable("append")
})
}
shinyApp(ui, server)
ui再次感谢您的帮助YBS，您的逻辑对于-textInput（粘贴0（“x.”，输入$tabnamesui），“x轴标签”）非常有意义，但不幸的是，它仍然无法工作……当创建另一个选项卡时，第一个选项卡将恢复为空白值。当在新选项卡中进行输入时，它也会更改第一个选项卡。@Ken，请尝试更新的代码。非常感谢YBS，tab\u的名称很有趣