Reputation: 31
I would like to have unique user inputs for each newly created tab in Shiny, however once the user selects the inputs it stores and does not change for the additional tabs created.
Scenario:
Data: Any simple csv table with two columns A and B will replicate the result below
Desired result: Each tab has unique user input and changes the active tab graph dynamically
Section of code where I think the problem is: At lines 68 and 120. Is there a way to set unique inputs for each ammended tab?
Thanks for looking into my problem.
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)
Upvotes: 0
Views: 311
Reputation: 21287
Try this
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)
Upvotes: 1