Home > Net >  Dynamically load a file and subset data from it (any column) in Shiny
Dynamically load a file and subset data from it (any column) in Shiny

Time:08-11

I'm trying to build an app that A) can load any given csv file B) from that loaded file, select 2 columns to then subset the data by selected attributes from these 2 columns. Obviously everything has to be done dynamically as the columns names and csv files would be different every time. I've had a go and am able to load the csv files, and select columns I want to display those 2 that I wish to select upon but somehow the -breakdown- choices from these 2 columns do not seem to follow through the process and no list is visible when i hit the drop down input selector....

Any help would be much appreciated. Thank you very much

library(dplyr)
library(shinyWidgets)

fpath <- '/dbfs/May2022'

# Define UI
  ui <- fluidPage(theme = shinytheme("spacelab"),
    navbarPage(
      "MyQA Machine Learning Platform",
      tabPanel(
        "Select File",
  sidebarPanel(
    selectInput('selectfile','Select File',choice = list.files(fpath, pattern = ".csv")),
    mainPanel("Main Panel",dataTableOutput("ftxtout"),style = "font-size:50%") # mainPanel
  ), #sidebarPanel
              ), #tabPanel
      tabPanel("Subset Data",
               sidebarPanel(                
#                selectInput("columns", "Select Columns", choices = NULL,multiple = TRUE), # no choices before uploading 
#                ), #
                 dropdown(
    label = "Please Select Columns to Display", 
    icon = icon("sliders"),
    status = "primary",
    pickerInput(
      inputId = "columns",
#       label = "Select Columns",
      choices = NULL,
      multiple = TRUE
    )#pickerInput
  ), #dropdown
    selectInput("v_attribute1", "First Attribute to Filter Data", choices = NULL), 
    selectInput("v_attribute2", "Second Attribute to Filter Data", choices = NULL),
    selectInput("v_filter1", "First Filter", choices = NULL),
    selectInput("v_filter2", "Second Filter", choices = NULL),
                 
               ), #sidebarPanel
               
               mainPanel(tags$br(),tags$br(),
                            h4("Data Selection"),
                            dataTableOutput("txtout"),style = "font-size:70%"
                        ) # mainPanel
               
      ), # Navbar 1, tabPanel
      tabPanel("Create Label", "This panel is intentionally left blank")     
  
    ) # navbarPage
  ) # fluidPage

  
  # Define server function  
  server <- function(input, output, session) {     
        output$fileselected<-renderText({
      paste0('You have selected: ', input$selectfile)
    })
    
     info <- eventReactive(input$selectfile, {
#     inFile <- input$selectfile
    # Instead # if (is.null(inFile)) ... use "req"
    req(input$selectfile)
    fullpath <- file.path(fpath,input$selectfile)
    df <- read.csv(fullpath, header = TRUE,  sep = ",")
    vars <- names(df)
    # Update select input immediately after clicking on the action button. 
    updatePickerInput(session, "columns","Select Columns", choices = vars)
    updateSelectInput(session, "v_attribute1","First Attribute to Filter Data", choices = vars)
    updateSelectInput(session, "v_attribute2","Second Attribute to Filter Data", choices = vars) #everything seems to work until here...
    var1 = paste0(input$v_attribute1)
    choicesvar1=unique(df$var1)
    req(choicesvar1)
    updateSelectInput(session, "v_filter1","First Filter", choices = choicesvar1)
    var2 = paste0(input$v_attribute2)
    choicesvar2=unique(df$var2)
    req(choicesvar2)
    updateSelectInput(session, "v_filter2","Second Filter", choices = choicesvar2)
    df
  })   
    
    output$ftxtout <- renderDataTable({
      req(input$selectfile)
      fullpath <- file.path(fpath,input$selectfile)
      df <- read.csv(fullpath, header = TRUE,  sep = ",")
      head(df)
      }, options =list(pageLength = 5))
    
    output$txtout <- renderDataTable({
    f <- info()
    f <- subset(f, select = input$columns)
    f <- filter(f, input$v_attribute1 == input$v_filter1 & input$v_attribute1 == input$v_filter2)
    head(f)
  }, options =list(pageLength = 5)
                                            )
    
  } # server

  # Create Shiny object
  shinyApp(ui = ui, server = server)

CodePudding user response:

As suggested by @Limey, you need to perform data wrangling separately. Try this

# Define UI
ui <- fluidPage(theme = shinytheme("spacelab"),
                navbarPage(
                  "MyQA Machine Learning Platform",
                  tabPanel(
                    "Select File",
                    sidebarPanel(
                      selectInput('selectfile','Select File',choice = list.files(fpath, pattern = ".csv")),
                      mainPanel("Main Panel",dataTableOutput("ftxtout"),style = "font-size:50%") # mainPanel
                    ), #sidebarPanel
                  ), #tabPanel
                  tabPanel("Subset Data",
                           sidebarPanel(
                             dropdown(
                               label = "Please Select Columns to Display",
                               icon = icon("sliders"),
                               status = "primary",
                               pickerInput(
                                 inputId = "columns",
                                 #       label = "Select Columns",
                                 choices = NULL,
                                 multiple = TRUE
                               )#pickerInput
                             ), #dropdown
                             selectInput("v_attribute1", "First Attribute to Filter Data", choices = NULL),
                             selectInput("v_attribute2", "Second Attribute to Filter Data", choices = NULL),
                             selectInput("v_filter1", "First Filter", choices = NULL),
                             selectInput("v_filter2", "Second Filter", choices = NULL),

                           ), #sidebarPanel

                           mainPanel(tags$br(),tags$br(),
                                     h4("Data Selection"),
                                     dataTableOutput("txtout"),style = "font-size:70%"
                           ) # mainPanel

                  ), # Navbar 1, tabPanel
                  tabPanel("Create Label", "This panel is intentionally left blank")

                ) # navbarPage
) # fluidPage


# Define server function
server <- function(input, output, session) {
  
  output$fileselected<-renderText({
    paste0('You have selected: ', input$selectfile)
  })

  info <- eventReactive(input$selectfile, {
    fullpath <- file.path(fpath,input$selectfile)
    read.csv(fullpath, header = TRUE,  sep = ",")
  })

  observeEvent(info(), {
    df <- info()
    vars <- names(df)
    # Update select input immediately after clicking on the action button.
    updatePickerInput(session, "columns","Select Columns", choices = vars, selected=vars[1:2])
  })
  
  observeEvent(input$columns, {
    vars <- input$columns
    updateSelectInput(session, "v_attribute1","First Attribute to Filter Data", choices = vars)
    updateSelectInput(session, "v_attribute2","Second Attribute to Filter Data", choices = vars, selected=vars[2]) #everything seems to work until here...
  })

  observeEvent(input$v_attribute1, {
    choicesvar1=unique(info()[[input$v_attribute1]])
    req(choicesvar1)
    updateSelectInput(session, "v_filter1","First Filter", choices = choicesvar1)
  })

  observeEvent(input$v_attribute2, {
    choicesvar2=unique(info()[[input$v_attribute2]])
    req(choicesvar2)
    updateSelectInput(session, "v_filter2","Second Filter", choices = choicesvar2)
  })

  output$ftxtout <- renderDataTable({
    head(info())
  }, options =list(pageLength = 5))

  output$txtout <- renderDataTable({
    f <- info() %>% subset(select = input$columns) 
    f$var1 <- f[[input$v_attribute1]]
    f$var2 <- f[[input$v_attribute2]]
    ff <- f %>% dplyr::filter(var1 == input$v_filter1 & var2 == input$v_filter2) 
    fff <- ff %>% subset(select=-c(var1,var2))
    head(fff)
  }, options =list(pageLength = 5)
  )

} # server

# Create Shiny object
shinyApp(ui = ui, server = server)
  • Related