Related
I am trying to run a shiny app with several scripted functions attached. I have a sidebar select input that accesses a variable which is only created after a file is uploaded and the "db_prep" R script is processed. The "db_prep" R script also combines elements of the "full_db" that is first loaded. I have tried to use renderUI to solve this problem but I cant identify where I am going wrong. Ideally, I would like to run the app, upload my file and then run my functions on the uploaded file and full_db to generate the output in the next boxplot tab.
Here is the ui:
#compiled db
full_db <- read.csv("./full_db.csv", header = TRUE, sep = ",", stringsAsFactors = FALSE)
# ui ----
ui <- fluidPage(
theme = shinytheme("superhero"),
titlePanel("Title"),
tabsetPanel(type = "tabs",
tabPanel("File Upload",
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select a file ----
fileInput("file1", "Choose CSV File",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = ","),
# Input: Select quotes ----
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
# Horizontal line ----
tags$hr(),
# Input: Select number of rows to display ----
radioButtons("disp", "Display",
choices = c(Head = "head",
All = "all"),
selected = "head")
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Data file ----
tableOutput("contents")
)
)
),
uiOutput("moreControls"),
# Main panel for displaying outputs ----
mainPanel(
h1("Actions"),
plotOutput("plot", width = "100%"))
))
Server:
# server ----
# Define server logic to plot various variables against
server <- function(input, output, session) {
#server logic for file upload tab
output$contents <- renderTable({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default,
# or all rows if selected, will be shown.
req(input$file1)
# when reading semicolon separated files,
# having a comma separator causes `read.csv` to error
tryCatch(
{
df_x <- read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
if(is.null(input$file1)){
return(NULL)
}
},
error = function(e) {
# return a safeError if a parsing error occurs
stop(safeError(e))
}
)
if(input$disp == "head") {
return(head(df_x))
}
else {
return(df_x)
}
})
#server logic for boxplot tab
#required scripts & functions
source("db_prep.R")
source("box_75_test.R")
source("box_80_test.R")
source("box_85_test.R")
source("box_90_test.R")
source("box_95_test.R")
output$moreControls <- renderUI({
if(is.null(input$file1())) return()
tabPanel("Boxplot",
sidebarPanel("output.fileUploaded",
selectInput("variable", "Action:", unique(qc$Action)),
sliderInput("quantile", "Quantile Range:",
min = 75, max = 95, value = c(85), step = 5
)
))
})
# reprex ----
s_75 <- function(var) box_75_test(var)
s_80 <- function(var) box_80_test(var)
s_85 <- function(var) box_85_test(var)
s_90 <- function(var) box_90_test(var)
s_95 <- function(var) box_95_test(var)
fn <- reactive(get(paste0("s_", input$quantile)))
output$plot <- renderPlot(fn()(input$variable), height = 800, width = 800)
# ^^^ note the reactive value goes fn()(var)
}
shinyApp(ui, server)
The problem I was having was due to calling the source code which was also dependent on the creation of the data frame that could only be built after a csv file was uploaded. Initially, I was only able to create a data frame as an object after the shiny session had ended but I was able to fix this by wrapping my source files and functions in an observeEvent handler like this:
observeEvent(input$file1, {
req(df_x)
source("db_prep.R")
# reprex ----
s_75 <- function(var) box_75(var)
s_80 <- function(var) box_80(var)
s_85 <- function(var) box_85(var)
s_90 <- function(var) box_90(var)
s_95 <- function(var) box_95(var)
fn <- reactive(get(paste0("s_", input$quantile)))
output$plot <- renderPlot(fn()(input$variable), height = 800, width = 800)
There is probably a more elegant way to achieve this but hey it works.
I'm writing a shiny app that will help my colleagues to inspect csv files a bit closer.
The first tab allows for import, and the second for grouping of data.
For ease of coding, if no csv is uploaded, it uses the mtcars
data set.
It takes a dataset, and then writes summaries based on selected columns and groupings.
I've managed to develop a reactive input which takes the columns you would like to select. The grouping input is then updated with only those the 'selected' columns as choices. However, it does not seem pass this to the function which creates the summary output. It creates a warning:
Warning: Error in : Must subset columns with a valid subscript vector.
x Subscript has the wrong type list.
ℹ It must be numeric or character.
119:
The hashed code causes the shiny app to crash.
library(shiny)
library(DT)
library(dplyr)
server <- shinyServer(function(input, output, session){
myData <-reactive({
if(is.null(input$file1)) return(mtcars)
as.data.frame(rbindlist(lapply(X=input$file1$datapath, FUN=read.csv,
quote=input$quote, sep=input$sep, header=input$header, dec=input$decimal),
use.names = TRUE,fill=TRUE
))
})
output$contents <-
DT::renderDataTable({
return(DT::datatable(myData(), filter='top'))
})
observe({
data <- myData()
updateSelectInput(session, 'selected',choices=names(data))
})
# observeEvent(input$selected, {
# data <- myData() %>% select(all_of(input$selected))
# updateSelectInput(session, 'groupby', choices= names(data))
# })
output$group_summary <- renderPrint({
myData() %>%
select(all_of(input$selected)) %>%
group_by(across(all_of(input$groupby))) %>%
summary()
})
}
)
ui <- shinyUI(fluidPage(
titlePanel("Nya Statistikhanteraren"),
# Input: Select a file ----
navlistPanel(
tabPanel("Import",
fileInput("file1", "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = "\t"),
# Input: Select quotes ----
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
# Input: Select decimal ----
radioButtons("decimal","Decimal",
choices = c(Comma = ",",
Dot = "."),
selected=","),
# Horizontal line ----
tags$hr(),
# Main panel for displaying outputs ----
# Output: Data file ----
DT::dataTableOutput("contents")
),
tabPanel("Grouping",
varSelectInput("selected", "Selected:", data, multiple = TRUE),
varSelectInput("groupby", "Grouping:", data, multiple=TRUE),
box(
title="Summary",
status="warning",
solidHeader=TRUE,
verbatimTextOutput("group_summary")
)
)
)
)
)
shinyApp(ui,server)
I think this is more in line with what you want. The main problem with the selectors is that they were returning lists and all_of() wanted a vector, so wrapping input$selected in as.character() solved that problem. The other problem that you would encounter is that the summary that was being generated wasn't affected by the group_by() statement. I modified that part of the function so you would get a summary for each group in your group_by argument. There is still a labels missing warning, but I suspect you can troubleshoot that.
library(shiny)
library(DT)
library(dplyr)
server <- shinyServer(function(input, output, session){
# Add to your server
observeEvent(input$browser,{
browser()
})
myData <-reactive({
if(is.null(input$file1)) return(mtcars)
as.data.frame(rbindlist(lapply(X=input$file1$datapath, FUN=read.csv,
quote=input$quote, sep=input$sep, header=input$header, dec=input$decimal),
use.names = TRUE,fill=TRUE
))
})
output$contents <-
DT::renderDataTable({
return(DT::datatable(myData(), filter='top'))
})
observe({
data <- myData()
updateSelectInput(session, 'selected',choices=names(data))
})
observeEvent(input$selected, {
data <- myData() %>% dplyr::select(all_of(as.character(input$selected)))
updateSelectInput(session, 'groupby', choices= names(data))
})
output$group_summary <- renderPrint({
if(length(input$groupby) >0){
tmp <- myData() %>%
dplyr::select(all_of(as.character(input$selected))) %>%
group_by(across(all_of(as.character(input$groupby))))
tk <- tmp %>% group_keys
tk <- tk %>% as.matrix() %>% apply(1, paste, collapse="-")
tmp <- tmp %>% group_split() %>% setNames(tk)
lapply(tmp, summary)
}
}, width=600)
}
)
ui <- shinyUI(fluidPage(
titlePanel("Nya Statistikhanteraren"),
# Input: Select a file ----
navlistPanel(
tabPanel("Import",
fileInput("file1", "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = "\t"),
# Input: Select quotes ----
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
# Input: Select decimal ----
radioButtons("decimal","Decimal",
choices = c(Comma = ",",
Dot = "."),
selected=","),
# Horizontal line ----
tags$hr(),
# Main panel for displaying outputs ----
# Output: Data file ----
DT::dataTableOutput("contents")
),
tabPanel("Grouping",
actionButton("browser", label = ),
varSelectInput("selected", "Selected:", data, multiple = TRUE),
varSelectInput("groupby", "Grouping:", data, multiple=TRUE),
box(
title="Summary",
status="warning",
solidHeader=TRUE,
verbatimTextOutput("group_summary")
)
)
)
)
)
shinyApp(ui,server)
Here's how I eventually solved it using rlang. Note: code below has a chain of v$data.... which I would like to utilise in order.
#Grouping functionality.
observe({
if(is.null(v$datarecoded)){
if(is.null(v$datafiltered)){
data <- myData()
} else {
data <- v$datafiltered
}
} else{
data <- v$datarecoded
}
updateSelectInput(session, 'selected',choices=names(data),selected = names(data)[1])
})
observeEvent(input$selected, {
updateSelectInput(session, 'groupby', choices= input$selected)
})
output$summary <- renderPrint({
if(is.null(v$datarecoded)){
if(is.null(v$datafiltered)){
data <- mydata()
} else {
data <- v$datafiltered
}
} else{
data <- v$datarecoded
}
data %>%
select(!!!rlang::syms(input$selected)) %>%
group_by(!!!rlang::syms(input$groupby)) %>%
summary()
})
grouped_summary_temp <- reactive({
if(is.null(v$datarecoded)){
if(is.null(v$datafiltered)){
data <- mydata()
} else {
data <- v$datafiltered
}
} else{
data <- v$datarecoded
}
data2 <- data %>%
select(!!!rlang::syms(input$selected)) %>%
group_by(!!!rlang::syms(input$groupby)) %>%
summarise(across(.fns=list(Min=min,Max=max,Mean=mean,Median=median,SD=sd)))
return(data2)
})
output$grouped_summary <- DT::renderDataTable({
DT::datatable(grouped_summary_temp(), filter='top')
})
I'm building a shiny app and I'm noticing that when I submit the code to console everything loads correctly and runs as expected; however when I render the app with the Run App button I'm getting errors.
Specifically, when I use the Run App button I get the following error in the application:'Error: cannot open the connection.' Additionally, I'm getting this error in the console: 'Error: cannot open the connection,' while the console reads: 'Warning in gzfile(file, "rb") :cannot open compressed file 'DATA//grm_mod.rds', probable reason 'No such file or directory''
The application is straightforward: A user uploads a data file, while on the back end an R model object is loaded, scores are estimated from the model, and results display in a table that the user can download.
What is the likely cause of this error? Note, the likely source of the error is under the code comment "Conversion steps" in the server logic.
Thank you.
# load packages
if(!require("pacman"))install.packages("pacman")
p_load(dplyr, shiny, shinythemes, mirt)
# Define UI for data upload app ----
ui <- fluidPage(
# Set theme ----
theme = shinytheme("superhero"),
# App title ----
titlePanel("Raw Score to MAP Score Conversion"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select a file ----
fileInput("file1", "Choose CSV File",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = ","),
# Input: Select quotes ----
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
# Horizontal line ----
tags$hr(),
# Input: Select number of rows to display ----
radioButtons("disp", "Display",
choices = c(Head = "head",
All = "all"),
selected = "head")
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Data file ----
tableOutput("contents"),
# Download button
downloadButton('downloadData', 'Download')
)
)
)
# Define server logic to read selected file ----
server <- function(input, output) {
output$contents <- renderTable(striped = TRUE,
{
# input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default,
# or all rows if selected, will be shown.
req(input$file1)
# when reading semicolon separated files,
# having a comma separator causes `read.csv` to error
tryCatch(
{
df <- read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
# Conversion steps ----
# import the model object
mod <- readRDS('DATA//grm_mod.rds')
# generate scores
df <- data.frame(fscores(obj = mod, type = 'MAP', response.pattern = df))
# transform scores
x10_50 <- function(x) {
10 * x + 50
}
df <-
df %>%
mutate_at(vars(matches("^F.$")), .funs = list(T = ~x10_50(.)))
# add download handler
output$downloadData <- downloadHandler(
filename = function() { paste(input$file1, '.csv', sep='') },
content = function(file) {
write.csv(df, file, row.names = FALSE)
}
)
},
error = function(e) {
# return a safeError if a parsing error occurs
stop(safeError(e))
}
)
if(input$disp == "head") {
return(head(df))
}
else {
return(df)
}
# download
output$downloadData <- downloadHandler(
filename = function() {
paste('data-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
write.csv(data, file)
}
)
})
}
# Create Shiny app ----
shinyApp(ui, server)
The filepath is relative to the Shiny App, not your working directory, so when you use runApp() and call readRDS('DATA//grm_mod.rds') it expects a directory DATA that is a subdirectory of the directory in which the .R file that contains your app is stored. If you move DATA to the same directory as app.r it should work.
Hoping for some expertise. the following code snippet does the following:
allows the user to select which variables (columns) they want from a CSV file, then generates numeric input fields for each one.
populates the dataframe with the values entered by the user.
However, Shiny assigns column headers to the data frame, and I've tried everything I could find to change them and nothing seems to work.
Can anyone tell me what I'm doing wrong?
df_sel() - this the function that selected the variables
this is the R.UI Section
ui <- fluidPage(
# App title ----
titlePanel(title = h1("Variable Selection Example", align = "center")),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select a file ----
fileInput("uploaded_file", "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ---- This allows the user to create a bunch of repeated values for the numerica inputs they later create
sliderInput("months", "Forecast Months:",
min = 0, max = 60,
value = 1),
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Semicolon = ";",
Comma = ",",
Tab = "\t"),
selected = ","),
# Horizontal line ----
tags$hr(),
# Input: Select number of rows to display ----
radioButtons("disp", "Display",
choices = c(All = "all",
Head = "head"),
selected = "all"),
# Select variables to display ----
uiOutput("checkbox")
),
# Main panel for displaying outputs ----
mainPanel(
uiOutput("input_ui"), #numeric inputs
tableOutput("table1")) #table to display input values
)
)
this is in the R.Server section
server <- function(input, output, session) {
#assign csv file to dataframe df
df <- reactive({
req(input$uploaded_file)
read.csv(input$uploaded_file$datapath,
header = input$header,
sep = input$sep)
})
# Dynamically generate UI input when data is uploaded ----
output$checkbox <- renderUI({
checkboxGroupInput(inputId = "select_var",
label = "Select variables",
choices = setdiff(names(df()), input$select_dev),
selected = setdiff(names(df()), input$select_dev))
})
# Select columns to print ----
df_sel <- reactive({
req(input$select_var)
df_sel <- df() %>% select(input$select_var)
})
output$input_ui <- renderUI({ #this creates dynamic numeric inputs based on the variables selected by the user
pvars <- df_sel()
varn = names(df_sel())
lapply(seq(pvars), function(i) {
numericInput(inputId = paste0("range", pvars[i]),
label = varn,
value = 0)
})
})
numbers <- reactive({ #this creates a reactive dataframe for the numbers
pvars <- df_sel()
num = as.integer(ncol(pvars))
print(num)
pred <- data.frame(lapply(1:num, function(i) {
input[[paste0("range", pvars[i])]]
}))
n = input$months #pull number from that slider up in the UI section
pd = data.frame(pred, i=rep(1:n,ea=NROW(input$months)))
pd[1:(length(pd)-1)]
#colnames(pd, c(df_sel())) #this does not seem to work at all!!!
})
output$table1 <- renderTable({
numbers()
fv = numbers()
print(dim(fv)) #check the dimensions of the table
print(fv) # chcek the table is populating correctly.
#df1 <- fv #show the table
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
I came up with a solution to my own question. If anyone can improve upon it, please let me know. This code goes in the R.Server section.
#This creates sliders from the selected variables from the reactive function called
#"df_sel()". Note the use of "tagList". The RenderUI function below creates as
#many sliders as variables selected, and passes in the correct variable name.
#It selects the last data value from each column, since this is time series data,
#the last data value \ (most recent) was desired.
output$scplan <- renderUI({
vars <- df_sel()
n = nrow(vars)
tagList(lapply(colnames(vars), function(z) {
sliderInput(
sprintf("%s",z),
label = z,
min = ceiling(min(vars[[z]])), # min value is the minimum of the column
max = ceiling(max(vars[[z]])), # max is the max of the column
value = vars[[z]][[n]])
}))
#this reactive function creates a dataframe from variables that were selected from
#checkboxes. The user moves the sliders to generate the values, and the code
#repeats the values for as many "input$months" as were selected.
sp_numbers <- reactive({
vars <- df_sel()
num = as.integer(ncol(vars))
sp_pred <- data.frame(lapply(colnames(vars), function(z) {
input[[z]]
}))
names(sp_pred) <- colnames(vars)
n = input$sp_months
df_sp_pred = data.frame(sp_pred, z=rep(z:n,ea=NROW(input$sp_months)))
df_sp_pred[1:(length(df_sp_pred)-1)] #this removes the last column which just shows the repeat count
})
#this code renders the table of the dataframe created above.
output$spo_table <- renderTable({
sp_numbers()
})
i've looked all over the internet and tried multiple solution but none of them seems to be working.
In short this is my problem: I created a shiny app where the user can upload csv files and save them in a dataset. Now i want to save each uploaded dataset in a list which would help me via a selectInput button to choose which dataset to view this is the code i wrote so far :
server <- function(input, output) {
datasetlist <- list()
output$contents <- renderTable({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default,
# or all rows if selected, will be shown.
req(input$file1)
input$update
tryCatch({
df <- read.csv(
input$file1$datapath,
header = isolate(input$header),
sep = isolate(input$sep),
dec = isolate(input$dec),
quote = isolate(input$quote)
)
},
error = function(e) {
# return a safeError if a parsing error occurs
stop(safeError(e))
})
# when reading semicolon separated files,
# having a comma separator causes `read.csv` to error
if (isolate(input$disp == "head")) {
return(head(df))
}
else {
return(df)
}
})
output$manage <- renderUI({
selectInput("dataset", "Dataset", choices = datasetlist[], selected = datasetlist[1])
})
}
Bonus point : i would be glad if someone were also to point how to deleter records from the list without affection the whole list
EDIT 1: following the answer i received earlier here's the complete code now, the problem is that i can't seem to find a way to display the tables of the datasets
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
library(shinydashboard)
library(shinythemes)
library(shinyFiles)
options(shiny.maxRequestSize = 30 * 1024 ^ 2)
# Define UI for application
ui <- fluidPage(#theme= shinytheme("paper"),
# Application title
navbarPage(
"Title",
# Sidebar with input
tabPanel("Data Manager",
sidebarLayout(
sidebarPanel(
uiOutput("manage"),
fileInput(
"file1",
"Choose CSV File",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
# Horizontal line ----
tags$hr(),
fluidRow(
# Input: Checkbox if file has header ----
column(4 ,checkboxInput("header", "Header", TRUE)),
# Input: Select number of rows to display ----
column(8, radioButtons(
"disp",
"Display",
choices = c(Head = "head",
All = "all"),
selected = "head",
inline = TRUE
))),
fluidRow(# Input: Select separator ----
column(
4, selectInput(
"sep",
"Separator",
choices = c(
Comma = ",",
Semicolon = ";",
Tab = "\t"
),
selected = ";"
)
),
# Input: Select decimals ----
column(
4 , selectInput(
"dec",
"Decimal",
choices = c("Comma" = ",",
"Period" = '.'),
selected = ','
)
)),
# Input: Select quotes ----
fluidRow(column(8 , selectInput(
"quote",
"Quote",
choices = c(
None = "",
"Double Quote" = '"',
"Single Quote" = "'"
),
selected = '"'
))),
# Horizontal line ----
tags$hr(),
actionButton("update", "Update")
),
mainPanel(fluidRow(tableOutput("contents")))
))
))
# Define server logic
server <- function(input, output, session) {
rv <- reactiveValues(
datasetlist = list()
)
observe({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default,
# or all rows if selected, will be shown.
req(input$file1)
input$update
tryCatch({
df <- read.csv(
input$file1$datapath,
header = isolate(input$header),
sep = isolate(input$sep),
dec = isolate(input$dec),
quote = isolate(input$quote)
)
},
error = function(e) {
# return a safeError if a parsing error occurs
stop(safeError(e))
})
# when reading semicolon separated files,
# having a comma separator causes `read.csv` to error
isolate(
rv$datasetlist <- c(rv$datasetlist,list(df))
)
})
observe({
updateSelectInput(
session = session,
inputId = "selected_dataset",
choices = 1:length(rv$datasetlist),
selected = input$selected_dataset
)
})
output$contents <- renderTable({
req(length(rv$datasetlist) >= input$selected_dataset)
df <- rv$datasetlist[[input$selected_dataset]]
if (isolate(input$disp == "head")) {
return(head(df))
}
else {
return(df)
}
})
output$manage <- renderUI({
tagList(
selectInput("selected_dataset", "Dataset", choices = '', selected = 1)
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Copy the uploaded files by user to a folder say Selected_Files using file.copy(), then use eventReactive() to read all the files in the folder to a list say datasetlist. Name the elements of the datasetlist to the file names. You can use this list reactive context in renderUI/renderTable using datasetlist().
I have written the code below which might solve your purpose.Further note read.csv has sep argument which takes care of different separators. I used radioButtons for user to provide file separators.
Edit: To capture the file format of all the uploaded files correctly I created a list df capturing the user input file formats and saving it as an R Object File_Format.rds in the working directory. Then use readRDS to load the saved list as old_df and append it to current df.
Edit2: I figured that when same file is uploaded with different parameters the name of the list File_Format remains identical hence the first element of the duplicate gets selected. I fixed this issue by prefixing the count of upload as an index to the names. Further, at the beginning of the code I added two statements to delete the RDS file and all the files in the folder Selected_Files. Hence whenever the application is opened these files are deleted first and then the interactive session follows.
Updated code is below
library(shiny)
if (file.exists("File_Format.rds")) file.remove("File_Format.rds")
do.call(file.remove, list(list.files("Selected_Files", full.names = TRUE)))
ui <- fluidPage(
# tableOutput("contents"),
sidebarPanel(
fileInput("file1", "Choose CSV File",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = ","),
# Input: Select quotes ----
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
# Horizontal line ----
tags$hr(),
# Upload Button
actionButton("uploadId", "Upload")
),
# Main panel for displaying outputs ----
mainPanel(
# # Output: Data file ----
uiOutput("manage"),
# Input: Select number of rows to display ----
uiOutput("select"),
# Display Button
actionButton("displayid", "Display"),
tableOutput("contents")
)
)
########### Server ###########
server <- function(input, output, session) {
# Copy uploaded files to local folder
observeEvent(input$uploadId,{
if (is.null(input$file1) ) { return(NULL) }
file.copy(from = input$file1$datapath, to = paste0('Selected_Files/',input$file1$name ) )
df <- list(file = input$file1$name , header= input$header,
sep = input$sep,dec = input$dec,
quote = input$quote,
index = input$uploadId)
if(input$uploadId > 1){
old_df <- readRDS("File_Format.rds")
df <- sapply(names(old_df),function(n){c(old_df[[n]],df[[n]])},simplify=FALSE)
}
saveRDS(df, "File_Format.rds")
})
# Load all the uplaoded files to a list
datasetlist <- eventReactive(input$uploadId,{
# Selected_Files <- list.files("Selected_Files/")
File_Format <- readRDS("File_Format.rds")
datalist <- list()
datalist <- lapply(1:length(File_Format[[1]]), function(d) read.csv(paste0("Selected_Files/",File_Format$file[d] ),
header = File_Format$header[d],
sep = File_Format$sep[d],
dec = File_Format$dec[d],
quote = File_Format$quote[d]))
names(datalist) <- paste(File_Format$index, File_Format$file,sep = ". ")
return(datalist)
})
output$manage <- renderUI({
data <- datasetlist()
selectInput("dataset", "Dataset", choices = names(data), selected = names(data))
})
output$select <- renderUI({
data <- datasetlist()
radioButtons("disp", "Display", choices = c(Head = "head",All = "all"),
selected = "head")
})
# Display Selected File
observeEvent(input$displayid, {
output$contents <- renderTable({
data <- datasetlist()
sub_df <- data[[paste0(input$dataset)]]
if (isolate(input$disp == "head")) {
return(head(sub_df))
}
else {
return(sub_df)
}
})
})
}
shinyApp(ui, server)
Hope this was helpful.
Something like this should do it. I haven't tested it since you only supplied half of your code and I am to lazy at the moment to build my own ui file.
server <- function(input, output) {
rv <- reactiveValues(
datasetlist = list()
)
observe({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default,
# or all rows if selected, will be shown.
req(input$file1)
input$update
tryCatch({
df <- read.csv(
input$file1$datapath,
header = isolate(input$header),
sep = isolate(input$sep),
dec = isolate(input$dec),
quote = isolate(input$quote)
)
},
error = function(e) {
# return a safeError if a parsing error occurs
stop(safeError(e))
})
# when reading semicolon separated files,
# having a comma separator causes `read.csv` to error
isolate(
rv$datasetlist = c(rv$datasetlist,list(df))
)
})
observe({
updateSelectInput(
session = session,
inputId = "selected_dataset",
choices = 1:length(rv$datasetlist),
selected = input$selected_dataset
)
})
output$contents <- renderTable({
req(length(rv$datasetlist) >= input$selected_dataset)
df <- rv$datasetlist[[input$selected_dataset]]
if (isolate(input$disp == "head")) {
return(head(df))
}
else {
return(df)
}
})
output$manage <- renderUI({
tagList(
selectInput("selected_dataset", "Dataset", choices = 1, selected = 1)
)
})
}
you might have to add some as.numeric() around the input$selected_dataset since selectInput normally returns a string and not a numeric.
Hope this helps!!