R Shiny | Chaining input choices to group a dataframe - r

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')
})

Related

Run Render.ui logic only after file has been uploaded

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.

How can I replace a single component of a value in a Datatable?

I am trying to replace the variables '030,066,008,030,066,008' with 100,066,008,100,066,008' in a R shiny app. At the moment, it does not. When I replace all of the values, it works.
Important: I only want to replace a portion of the values, not the complete set.
Could someone please assist me in resolving this problem?
CSV DATA
ID Type Category values
21 A1 B1 030,066,008,030,066,008
22 C1 D1 020,030,075,080,095,100
23 E1 F1 030,085,095,060,201,030
App.R
library(shiny)
library(DT)
library(dplyr)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File", accept = ".csv"),
checkboxInput("header", "Header", TRUE),
selectInput("col", "Column to search:", NULL),
textInput("old", "Replace:"),
textInput("new", "By:"),
actionButton("replace", "Replace!"),
),
mainPanel(
DTOutput("table1")
)
)
)
server <- function(input, output, session) {
my_data <- reactiveVal(NULL)
observeEvent(input$file1, {
file <- input$file1
ext <- tools::file_ext(file$datapath)
req(file)
validate(need(ext == "csv", "Please upload a csv file"))
my_data(read.csv(file$datapath, header = input$header))
updateSelectInput(session, "col", choices = names(my_data()))
})
observeEvent(input$replace, {
req(input$col)
dat <- req(my_data())
traf <- if (is.numeric(dat[[input$col]])) as.numeric else identity
my_data(dat %>%
mutate(!!rlang::sym(input$col) :=
replace(!!rlang::sym(input$col),
as.character(!!rlang::sym(input$col)) == input$old,
input$new) %>%
traf()))
})
output$table1 <- renderDT(
req(my_data())
)
}
shinyApp(ui, server)
One possible solution using stringr. I just changed the replace function by str_replace_all from stringr package.
EDIT : you can use a regex as pattern to detect, in order to specify you want to detect the exact number, and not if it is parts of another number.
Example : str_replace_all("0300", "030", "100") will return 1000 whereas
str_replace_all("0300", my_regex("030"), "100") will return 0300, with my_regex a regex to specify you want the exact pattern (i must admit i do not have the regex to use in my mind right now ...)
library(shiny)
library(DT)
library(stringr)
library(dplyr)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File", accept = ".csv"),
checkboxInput("header", "Header", TRUE),
selectInput("col", "Column to search:", NULL),
textInput("old", "Replace:"),
textInput("new", "By:"),
actionButton("replace", "Replace!"),
),
mainPanel(
DTOutput("table1")
)
)
)
server <- function(input, output, session) {
my_data <- reactiveVal(NULL)
observeEvent(input$file1, {
file <- input$file1
ext <- tools::file_ext(file$datapath)
req(file)
# validate(need(ext == "csv", "Please upload a csv file"))
my_data(read.csv2(file$datapath, header = input$header))
updateSelectInput(session, "col", choices = names(my_data()))
})
observeEvent(input$replace, {
req(input$col)
dat <- req(my_data())
traf <- if (is.numeric(dat[[input$col]])) as.numeric else identity
my_data(dat %>%
mutate(!!rlang::sym(input$col) :=
stringr::str_replace_all(!!rlang::sym(input$col),
input$old,
input$new) %>%
traf()))
})
output$table1 <- renderDT(
req(my_data())
)
}
shinyApp(ui, server)
I assumed you want to filter the dataset by column and by row, and assumed the row value it's always going to be ID (if not, you can put another selectInput for that)
Note: using stringr::str_replace_all is actually more clever, but since I used my entire afternoon, I wanted to post my solution anyways...
Note2: wouldnt stringr::str_replace_all replace the value 03000 with 10000? Nice, then my solution is better!
library(shiny)
library(DT)
library(dplyr)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File", accept = ".csv"),
checkboxInput("header", "Header", TRUE),
textInput("row", "Select row by ID:"),
selectInput("col", "Column to search:", NULL),
textInput("old", "Replace:", value="030"),
textInput("new", "By:", value ="100"),
actionButton("replace", "Replace!"),
),
mainPanel(
DTOutput("table1")
)
)
)
server <- function(input, output, session) {
## two reactVal, one for the dataset and another for the vector with new values
my_data <- reactiveVal(NULL)
vector1 <- reactiveVal(NULL)
observeEvent(input$file1, {
file <- input$file1
ext <- tools::file_ext(file$datapath)
req(file)
validate(need(ext == "csv", "Please upload a csv file"))
my_data(read.csv(file$datapath, header = input$header))
updateSelectInput(session, "col", choices = names(my_data()))
})
observeEvent(input$replace, {
req(input$col, input$row, input$new, input$old)
my_data <- my_data()
old <- input$old
new <- input$new
col1 <- input$col
row1 <- input$row
## create a new vector by:
vector1(
my_data %>%
filter(ID == row1) %>% ## 1. filtering by row
select(all_of(col1)) %>% ## 2. selecting column
stringr::str_split(",") %>% ## 3. creating a list of values separated by ','
unlist() %>% ## 4. unlisting the values into a vector of values
replace(., . == old, new) %>% ## 5. changing old values for new values
paste0(collapse = ",") ## 6. colapsing all values of vector with ','
)
## replace that vector in the dataframe
my_data <- my_data %>%
mutate(values = ifelse(ID == row1, vector1(), values))
my_data(my_data)
})
output$table1 <- renderDT(
req(my_data())
)
}
shinyApp(ui, server)

Using autoplotly in shiny app with user selected columns

I am making a shiny app that allows the user to upload a CSV, then select the independent and dependent variables. Right now I am able to upload a file, select variables and run regression analysis. But, I am stuck at the step where I would pass the lm object to autoplot then making it interactive via autoplotly in a new tab. How can I create interactive regression plots via using user selected variables in a shiny app?
UI
ui = navbarPage(tabPanel("Regression Analysis",
dataTableOutput('mytable'),
sidebarLayout(
sidebarPanel(width=3, fileInput("file1", "Please choose a CSV file",
multiple = T,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
tags$hr(),
checkboxInput("header", "Header", TRUE),
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = ","),
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
tags$hr(),
radioButtons("disp", "Display",
choices = c(Head = "head",
All = "all"),
selected = "head")
),
mainPanel(
tableOutput("contents"),
actionButton("choice", "Define Regression Variables"),
selectInput("independent", "Independent Variables:", choices = NULL, multiple = T),
uiOutput("dependent1"),
#tableOutput("Table_selected.col"),
verbatimTextOutput("regTab")
)
),
tabPanel("Plots",
icon = icon("chart-area"),
plotlyOutput(outputId = "RegPlots"))
)
Server
server = function(input, output, session) {
mydf <- reactive({
# 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)
df = read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
if(input$disp == "head") {
return(head(df))
}
else {
return(df)
}
})
output$contents = renderTable({
req(mydf())
mydf()
})
# Code for allowing the user to select the variables/columns of interest
info <- eventReactive(input$choice, {
req(mydf())
f <- mydf()
f
})
observeEvent(input$choice, { ## to update only when you click on the actionButton
req(info())
updateSelectInput(session,"independent", "Please Select independent Variable(s):", choices = names(info()) )
})
# output$Table_selected.col <- renderTable({
# input$choice
# req(info(),input$columns)
# f = info()
# f = subset(f, select = input$columns) #subsetting takes place here
# head(f)
# })
output$dependent1 = renderUI({
req(mydf(),input$independent)
radioButtons("dependent1", "Select a dependent Variable:",choices=names(mydf())[!names(mydf()) %in% input$independent])
})
### need to build your formuila correctly; It will work with multiple independent variables
### model <- reactive({lm(reformulate(input$IndVar, input$DepVar), data = RegData)})
runRegression <- reactive({
req(mydf(),input$independent,input$dependent1)
a = lm(reformulate(input$independent, input$dependent1), data=mydf())
a
# multinom(reformulate(input$independent, input$dependent1), data=mydf()) ### mulitnomial from nnet package
})
output$regTab = renderPrint({
req(runRegression())
if(!is.null(input$independent)){
summary(runRegression())
} else {
print(data.frame(Warning="Please select Model Parameters."))
}
})
}
output$RegPlots = renderPlotly({
req(runRegression())
# Plot the residuals
lm.plot.rsd = autoplot(a, label.size = 3, which = 1) +
theme_bw()
autoplotly(lm.plot.rsd +
ggplot2::ggtitle("Residuals vs Fitted"))
})
shinyApp(ui, server)
Error
Error in : Objects of type function not supported by autoplot.
Try this
output$RegPlots = renderPlot({
req(runRegression())
# Plot the residuals
a = runRegression()
ggplot(a, aes(x = .fitted, y = .resid)) +
geom_point() +
geom_smooth(method = loess, formula = y ~ x) +
labs(title="Residuals vs Fitted")
})
You can try other plots if you want.

Create a t-test and obtain p-value from csv using shiny

I am trying to create a shiny UI to input CSV, perform paired t-test (equal variance) and to generate a heatmap from a sample dataset.
I have been able to generate a UI CSV upload tab, however, I am now struggling with my t-test and p-value tab, I continue to get this error message:
Warning: Error in : evaluation nested too deeply: infinite recursion / options(expressions=)?
90:
shinyServer <- function(input, output, session){
data5<- reactive({
req(input$file1)
data5<-read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
})
output$contents <- renderTable({
req(input$file1)
if(input$disp == "head") {
return(head(data5()))
}
else {
return(data5())
}
})
####ttests
data1 <- reactive({
data1 <- data.matrix(data5())
})
ctrl <- reactive({
ctrl <- data1()[, c(2:11)]
})
smple <- reactive({
smple <- data1()[, c(12:21)]
})
vector1 <- c(1:10)
pvalue <- c()
pval <- reactive ({
for (i in vector1) {
pvalue[i] <-
t.test(ctrl()[i, ],
smple()[i, ],
paired = FALSE,
var.equal = FALSE)$p.value
}
pvalue
})
signif <- reactive({
sig <- c()
for (n in vector1) {
if (pval()[n] < 0.05) {
sig <- append(sig, n)
}
}
sig
})
genecol <- reactive({
genecol <- data5()[, 1]
})
P.Vals <- reactive({
as.character(P.Vals())
})
data6 <- reactive({
data6 < -data.frame(genecol(), P.Vals())
})
output$pvalue <- renderTable(data6())
}
UI:
library(shiny)
library(shinythemes)
ui <- fluidPage(
####name app
titlePanel("Uploading Files"),
tabsetPanel(
tabPanel("Upload CSV"),
# Sidebar
sidebarLayout(
sidebarPanel(
###input option CSV file
fileInput(
"file1",
"Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
tags$hr(),
###check if CSV has a header
checkboxInput("header", "Header", TRUE),
###format text file into table with separator (comma,semicolon,tab)
radioButtons(
"sep",
"Separator",
choices = c(
Comma = ",",
Semicolon = ";",
Tab = "\t"
),
selected = ","
),
tags$hr(),
####select head of data or all
radioButtons(
"disp",
"Display",
choices = c(Head = "head",
All = "all"),
selected = "head"
)
),
####output panel
mainPanel(# Output: DATA
tableOutput("contents"))
)
),
tabPanel("T-Test",
h4("pvalue"),
tableOutput("pvalue"))
)
I understand this may be complicated but I am a complete beginner, really struggling to get my head round it
Without a reproducible example (see the comments), I am guessing it could be your reactives. I.e.:
data1 <- reactive({
data1 <- data.matrix(data5())
})
A reactive is kinda like a function, as it returns the last value (or whatever is passed with a return statement). In your code, you seem to be reassigning the reactive data1 with a value, within it self. This might not be the case due to scoping, but with the recursive error, this is my first guess.
I suggest you start with editing your reactives to:
data1 <- reactive({
data.matrix(data5())
})
EDIT:
Found it:
P.Vals <- reactive({
as.character(P.Vals())
})
This is most definitely a recursive expression. This is your culprit.

R + Shiny : Save Uploaded Dataset to List/ choose from list item to view

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!!

Resources