Yen
Yen

Reputation: 31

Unique sidebar inputs for each new dynamic tab created in Shiny

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:

  1. User selected data from local computer
  2. User makes selection from drop down list
  3. Click on Add new tab
  4. Click on the new tab
  5. User custom input = graph changes dynamically
  6. Go back to homepage select new data and Click on Add new tab
  7. Click on the new tab
  8. User custom input = graph does not change and changes as per user input from step 5

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

Answers (1)

YBS
YBS

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

Related Questions