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)