rshinydatatabletabsdata-filtering

Display/plot filtered data (user selected) into newly created navbar tab in Shiny

I am currently facing a problem in Shiny where I am unable to display filtered data (user selected) into a newly created navbar tab. This had also led to another strange new tab removal problem.

Problem: I am stuck with the select data, appendtab (in navbar), outputUI and display/plot logic sequence in Shiny.

Scenario:

  1. User selected data from local computer
  2. User makes first selection from drop down list
  3. Click on Add new tab
  4. User makes second selection from drop down list
  5. Click on Add new tab

Data used: I don't know how to upload data on stackover flow but a simple csv table with two columns A and B will replicate the result below

Result: Tab A: shows "Error: cannot coerce type 'closure' to vector of type 'character'" Tab B: Delete tab function is now broken as well

My end goal to give more context: To be able to use this user selected data display charts, calcs, tables in the new tab.

What I did before it started erroring: I have followed similar logic to this post to display user filtered data in a new tab (not new navbartab though):

  1. How to reuse a dataset in different objects when renderUI is used to create tabs in ShinyR

Also some help I got from Stackoverflow before this problem started. This may help with providing more context, all the answers from contributors worked:

  1. Append and remove tabs using sidebarPanel
  2. Can't get disable button to work with observeEvent with if statement in ShinyR

As always thank you very much for looking into my problem. Cheers

library(shiny)
library(plyr)
library(dplyr)
library(DT)
library(shinyjs)
library(data.table)

ui <- fluidPage(
  useShinyjs(),
  navbarPage(title = "Stackoverflow help", 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})
  
  #Delete selected tab logic
  observeEvent(input$append,{
    appendTab(inputId = "tabs",
              tabPanel(input$tabnamesui, 
                       sidebarPanel(
                       actionButton(paste0("remove_", input$tabnamesui), "Delete")),
                       mainPanel(
                       uiOutput("tabsets") #This is where I think something is broken
                       )
              )
    )
    
  })
  
  observeEvent(lapply(grep(pattern = "^remove_", x = names(input), value = TRUE), function(x){input[[x]]}),{
    if(input$tabs != "Home"){
      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(tabnamesinput(), {
    shinyjs::enable("append")
  })
  
  shinyjs::disable("append")
  
  observeEvent(input$file, {
    shinyjs::enable("append")
  })
  
  
  #Subdata section, I want to only use the data the user has selected for the new Navbar tab
  output$tabsets<-renderUI({
    req(userfile())
    tabtable<-reactive({
      lapply(tabnamesinput(), function(x)
        dataTableOutput(paste0('table',x)))
    })
  })
  
  subsetdata<-reactive({
    list_of_subdata<-lapply(tabnamesinput(), function(x) {
      as.data.table((select(filereact(),x)))
    })
    names(list_of_subdata)<-tabnamesinput()
    return(list_of_subdata)
  })
  
  observe(
    lapply(tabnamesinput(), function(x) {
      output[[paste0('table',x)]] <- 
        renderDataTable({
          subsetdata()[[x]]
        })}))
  
}

shinyApp(ui, server)
Solution

  • You cannot output same ID in multiple tabs. Once you fix that, it works. You still need to define what you wish to display in each tab. I am just displaying a filtered table and a sample plot. Also, tab removal required minor tweak. Working code is shown below.

    ui <- fluidPage(
  useShinyjs(),
  navbarPage(title = "Stackoverflow help", 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")),
                       mainPanel(
                         #uiOutput("tabsets") #This is where I think something is broken
                         DTOutput(paste0("table",input$tabnamesui)),
                         plotOutput(paste0("plot",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")
    output[[paste0("plot",input$tabnamesui)]] <- renderPlot(plot(cars))
    lapply(tabnamesinput(), function(x) {
      df <- as.data.table(filereact()[[as.name(tabnamesinput())]])
      output[[paste0('table',x)]] <- renderDT({
          df
          #subsetdata()[[x]]
        })})
  })

  shinyjs::disable("append")

  observeEvent(input$file, {
    shinyjs::enable("append")
  })

}

shinyApp(ui, server)

    output