Related
We have created a shiny application where either the user can upload a big dataset (RData file over 200MB) or they can pick one from us. Then there are three different tabs where the user can filter the data (tab for numerics, tab for categorics)
So currently I have 3 reactive functions to serve that purpose. But downside is that the object is kept three times in memory. Is there a more efficient way to do this?
Please find a simplified example app below:
note: in this app you only see 1 filter per tab. normally its more like this:
My_Filtered_Data[Species %in% input$filter1 &
x %in% input$x &
y %in% input$y &
z %in% input$z] #etc.
I was looking at reactiveValues but couldn't really find how it works.
Reason I don't want to have it in 1 reactive is that everytime I change one of the filters on one of the sheets, the entire filtering process starts again and that is quite time consuming. I'd prefer to have one dataset that that gets updated with only the filter that is used at that time. That's the reason I included the different reactives
## app.R ##
library(shinydashboard)
library(data.table)
CustomHeader <- dashboardHeader(title='datatest')
iris<-iris
ui <- function(request) {
dashboardPage(
CustomHeader,
## Sidebar content
dashboardSidebar(
sidebarMenu(
menuItem("filter1 & Import", tabName = "filter1", icon = icon("dashboard")),
menuItem("filter2", tabName = "filter2", icon = icon("th")),
menuItem("filter3", tabName = "filter3", icon = icon("th"))
)
),
## Body content
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "filter1",
fluidRow(box(width = 3,
selectInput(inputId = 'filter1','filter1:species',choices = unique(iris$Species))))
),
tabItem(tabName = "filter2",
fluidRow(box(width = 3,
sliderInput(inputId = 'filter2','filter2:Max.Sepal.Length',min = 0,max = 10,value = 10)
))
),
tabItem(tabName = "filter3",
fluidRow(box(width = 3,
sliderInput(inputId = 'filter3','filter3:Min.Sepal.Width',min = 0,max = 10,value = 0)
),
box(width=9,dataTableOutput('mydata')))
)
)
)
)
}
server <- function(input, output) {
My_Uploaded_Data <- reactive({
My_Uploaded_Data<-data.table(iris)
My_Uploaded_Data
})
My_Filtered_Data <- reactive({
My_Filtered_Data<-My_Uploaded_Data()
My_Filtered_Data[Species %in% input$filter1]
})
My_Filtered_Data2 <- reactive({
My_Filtered_Data2<-My_Filtered_Data()
My_Filtered_Data2[Sepal.Length < input$filter2]
})
My_Filtered_Data3 <- reactive({
My_Filtered_Data3<-My_Filtered_Data2()
My_Filtered_Data3[Sepal.Width > input$filter3]
})
output$mydata<-renderDataTable({
My_Filtered_Data3()
})
}
shinyApp(ui, server)
I was hoping something like tthis would work in reactiveValues
react_vals <- reactiveValues(data = NULL)
observe(react_vals$data <- MyLoadedData())
observe(react_vals$data <- react_vals$data[Species %in% input$filter1])
observe(react_vals$data <- react_vals$data[Sepal.Length < input$filter2])
observe(react_vals$data <- react_vals$data[Sepal.Width > input$filter3])
EDIT: I also would like to include bookmarks: https://shiny.rstudio.com/articles/advanced-bookmarking.html and it seems you need reactiveValues for that. So another reason for me to move away from all these reactives/eventReactive
Instead of storing datasets in the reactive variables, just store the rows which qualify. That way, each reactive value is only replaced when it's filter changes; they aren't linked together. The output just uses the rows which pass all filters.
At the top of the program, change iris to a data.table:
library(shinydashboard)
library(data.table)
CustomHeader <- dashboardHeader(title = 'datatest')
iris <- iris
setDT(iris) # Added
Then use this for the server logic:
server <- function(input, output) {
filter1_rows <- reactive({
iris[Species %in% input$filter1, which = TRUE]
})
filter2_rows <- reactive({
iris[Sepal.Length < input$filter2, which = TRUE]
})
filter3_rows <- reactive({
iris[Sepal.Width > input$filter3, which = TRUE]
})
output$mydata <- renderDataTable({
final_rows <- intersect(filter1_rows(), filter2_rows())
final_rows <- intersect(final_rows, filter3_rows())
iris[final_rows]
})
}
This uses the often-overlooked which argument for data.table[...], which means only the row numbers of the subsetted table should be returned.
I think your problem has nothing to do with shiny and/or reactive programming. It's a "classic time vs memory" situation. Basically speaking you have only two options: Store "partially" filtered objects or not.
If you do store them, you use a lot of memory but can return the object instantly. If not, you need only store the original object but you have to filter it everytime again. There is nothing in between. You just cannot create an object that is different from the original (i.e. filtered) but takes no additional memory, not even with reactiveValues.
Of course you can do tradeoffs, e.g. creating an intermediate object for the first filter and computing the second and the third filter on-the-fly, but that does not change the underlying problem.
Instead of specifying separate fileInput variables, I'd like to use reactiveValues to store uploaded CSV dataframes, manipulate them in some way, and then store them for accession later. My design is to name each dataframe by its filename and append to the reactiveValue rvTL. My questions are,
How can I access individual dataframes under the list I created using reactiveValuesToList(rvTL)?
Next step, how to create a selectInput menu to access the individual dataframes uploaded by fileInput
To learn this concept, I am piggybacking off the answer from Dean Attali and made rvTL the same as his values variable.
R shiny: How to get an reactive data frame updated each time pressing an actionButton without creating a new reactive data frame?
I've gone over many example codes on reactiveValues, yet still at an incomplete understanding. Most examples are using some sort variation on reactiveValuesToList(input) R Shiny: Keep/retain values of reactive inputs after modifying selection, I'm really not seeing the logic here. Any help/suggestions would be appreciated!
library(shiny)
runApp(shinyApp(
ui=(fluidPage(
titlePanel("amend data frame"),
mainPanel(
fileInput("file", "Upload file", multiple=T),
tabsetPanel(type="tabs",
tabPanel("tab1",
numericInput("Delete", "Delete row:", 1, step = 1),
actionButton("Go", "Delete!"),
verbatimTextOutput("df_data_files"),
verbatimTextOutput("values"),
verbatimTextOutput("rvTL"),
tableOutput("rvTL_out")
),
tabPanel("tab2",
tableOutput("df_data_out")
)
)))),
server = (function(input, output) {
values <- reactiveValues(df_data = NULL) ##reactiveValues
rvTL <- reactiveValues(rvTL = NULL)
observeEvent(input$file, {
values$df_data <- read.csv(input$file$datapath)
rvTL[[input$file$name]] <- c(isolate(rvTL), read.csv(input$file$datapath))
})
observeEvent(input$Go, {
temp <- values$df_data[-input$Delete, ]
values$df_data <- temp
})
output$df_data_files <- renderPrint(input$file$name)
output$values <- renderPrint(names(values))
output$rvTL <- renderPrint(names(reactiveValuesToList(rvTL))[1] )
output$rvTL_out <- renderTable(reactiveValuesToList(rvTL)[[1]])
output$df_data_out <- renderTable(values$df_data)
})
))
It really is as straightforward as you thought. You were close too, just fell into some syntax traps. I made the following changes:
that c(isolate(.. call was messing things up, I got rid of it. It was leading to those "Warning: Error in as.data.frame.default: cannot coerce class "c("ReactiveValues", "R6")" to a data.frame" errors.
Also you were reusing the rvTL name too often which is confusing and can lead to conflicts, so I renamed a couple of them.
I also added a loaded file name list (lfnamelist) to keep track of what was loaded. I could have used names(rvTL$dflist) for this but it didn't occur to me at the time - and I also this is a useful example of how to organize related reactive values into one declaration.
And then I added rendered selectInput so you can inspect what is saved in the reactiveValue list.
So here is the adjusted code:
library(shiny)
runApp(shinyApp(
ui=(fluidPage(
titlePanel("amend data frame"),
mainPanel(
fileInput("file", "Upload file", multiple=T),
tabsetPanel(type="tabs",
tabPanel("rvTL tab",
numericInput("Delete", "Delete row:", 1, step = 1),
uiOutput("filesloaded"),
actionButton("Go", "Delete!"),
verbatimTextOutput("df_data_files"),
verbatimTextOutput("values"),
verbatimTextOutput("rvTL_names"),
tableOutput("rvTL_out")
),
tabPanel("values tab",
tableOutput("df_data_out")
)
)))),
server = (function(input, output) {
values <- reactiveValues(df_data = NULL) ##reactiveValues
rvTL <- reactiveValues(dflist=NULL,lfnamelist=NULL)
observeEvent(input$file, {
req(input$file)
values$df_data <- read.csv(input$file$datapath)
rvTL$dflist[[input$file$name]] <-read.csv(input$file$datapath)
rvTL$lfnamelist <- c( rvTL$lfnamelist, input$file$name )
})
observeEvent(input$Go, {
temp <- values$df_data[-input$Delete, ]
values$df_data <- temp
})
output$df_data_files <- renderPrint(input$file$name)
output$values <- renderPrint(names(values))
output$rvTL_names <- renderPrint(names(rvTL$dflist))
output$rvTL_out <- renderTable(rvTL$dflist[[input$lftoshow]])
output$df_data_out <- renderTable(values$df_data)
output$filesloaded <- renderUI(selectInput("lftoshow","File to show",choices=rvTL$lfnamelist))
})
))
And here is a screen shot:
The goal
I am working on a Shiny app that allows the user to upload their own data and focus on the entire data or a subset by providing data filtering widgets described by the below graph
The select input "Variable 1" will display all the column names of the data uploaded by the user and the selectize input "Value" will display all the unique values of the corresponding column selected in "Variable 1". Ideally, the user will be able to add as many such rows ("Variable X" + "Value") as possible by some sort of trigger, one possibility being clicking the "Add more" action button.
A possible solution
After looking up online, I've found one promising solution given by Nick Carchedi pasted below
ui.R
library(shiny)
shinyUI(pageWithSidebar(
# Application title
headerPanel("Dynamically append arbitrary number of inputs"),
# Sidebar with a slider input for number of bins
sidebarPanel(
uiOutput("allInputs"),
actionButton("appendInput", "Append Input")
),
# Show a plot of the generated distribution
mainPanel(
p("The crux of the problem is to dynamically add an arbitrary number of inputs
without resetting the values of existing inputs each time a new input is added.
For example, add a new input, set the new input's value to Option 2, then add
another input. Note that the value of the first input resets to Option 1."),
p("I suppose one hack would be to store the values of all existing inputs prior
to adding a new input. Then,", code("updateSelectInput()"), "could be used to
return inputs to their previously set values, but I'm wondering if there is a
more efficient method of doing this.")
)
))
server.R
library(shiny)
shinyServer(function(input, output) {
# Initialize list of inputs
inputTagList <- tagList()
output$allInputs <- renderUI({
# Get value of button, which represents number of times pressed
# (i.e. number of inputs added)
i <- input$appendInput
# Return if button not pressed yet
if(is.null(i) || i < 1) return()
# Define unique input id and label
newInputId <- paste0("input", i)
newInputLabel <- paste("Input", i)
# Define new input
newInput <- selectInput(newInputId, newInputLabel,
c("Option 1", "Option 2", "Option 3"))
# Append new input to list of existing inputs
inputTagList <<- tagAppendChild(inputTagList, newInput)
# Return updated list of inputs
inputTagList
})
})
The downside
As pointed by Nick Carchedi himself, all the existing input widgets will undesirably get reset every time when a new one is added.
A promising solution for data subsetting/filtering in Shiny
As suggested by warmoverflow, the datatable function in DT package provides a nice way to filter the data in Shiny. See below a minimal example with data filtering enabled.
library(shiny)
shinyApp(
ui = fluidPage(DT::dataTableOutput('tbl')),
server = function(input, output) {
output$tbl = DT::renderDataTable(
iris, filter = 'top', options = list(autoWidth = TRUE)
)
}
)
If you are going to use it in your Shiny app, there are some important aspects that are worth noting.
Filtering box type
For numeric/date/time columns: range sliders are used to filter rows within ranges
For factor columns: selectize inputs are used to display all possible categories
For character columns: ordinary search boxes are used
How to obtain the filtered data
Suppose the table output id is tableId, use input$tableId_rows_all as the indices of rows on all pages (after the table is filtered by the search strings). Please note that input$tableId_rows_all returns the indices of rows on all pages for DT (>= 0.1.26). If you use the DT version by regular install.packages('DT'), only the indices of the current page are returned
To install DT (>= 0.1.26), refer to its GitHub page
Column width
If the data have many columns, column width and filter box width will be narrow, which makes it hard to see the text as report here
Still to be solved
Despite some known issues, datatable in DT package stands as a promising solution for data subsetting in Shiny. The question itself, i.e. how to dynamically append arbitrary number of input widgets in Shiny, nevertheless, is interesting and also challenging. Until people find a good way to solve it, I will leave this question open :)
Thank you!
are you looking for something like this?
library(shiny)
LHSchoices <- c("X1", "X2", "X3", "X4")
#------------------------------------------------------------------------------#
# MODULE UI ----
variablesUI <- function(id, number) {
ns <- NS(id)
tagList(
fluidRow(
column(6,
selectInput(ns("variable"),
paste0("Select Variable ", number),
choices = c("Choose" = "", LHSchoices)
)
),
column(6,
numericInput(ns("value.variable"),
label = paste0("Value ", number),
value = 0, min = 0
)
)
)
)
}
#------------------------------------------------------------------------------#
# MODULE SERVER ----
variables <- function(input, output, session, variable.number){
reactive({
req(input$variable, input$value.variable)
# Create Pair: variable and its value
df <- data.frame(
"variable.number" = variable.number,
"variable" = input$variable,
"value" = input$value.variable,
stringsAsFactors = FALSE
)
return(df)
})
}
#------------------------------------------------------------------------------#
# Shiny UI ----
ui <- fixedPage(
verbatimTextOutput("test1"),
tableOutput("test2"),
variablesUI("var1", 1),
h5(""),
actionButton("insertBtn", "Add another line")
)
# Shiny Server ----
server <- function(input, output) {
add.variable <- reactiveValues()
add.variable$df <- data.frame("variable.number" = numeric(0),
"variable" = character(0),
"value" = numeric(0),
stringsAsFactors = FALSE)
var1 <- callModule(variables, paste0("var", 1), 1)
observe(add.variable$df[1, ] <- var1())
observeEvent(input$insertBtn, {
btn <- sum(input$insertBtn, 1)
insertUI(
selector = "h5",
where = "beforeEnd",
ui = tagList(
variablesUI(paste0("var", btn), btn)
)
)
newline <- callModule(variables, paste0("var", btn), btn)
observeEvent(newline(), {
add.variable$df[btn, ] <- newline()
})
})
output$test1 <- renderPrint({
print(add.variable$df)
})
output$test2 <- renderTable({
add.variable$df
})
}
#------------------------------------------------------------------------------#
shinyApp(ui, server)
Now, I think that I understand better the problem.
Suppose the user selects the datasets::airquality dataset (here, I'm showing only the first 10 rows):
The field 'Select Variable 1' shows all the possible variables based on the column names of said dataset:
Then, the user selects the condition and the value to filter the dataset by:
Then, we want to add a second filter (still maintaining the first one):
Finally, we get the dataset filtered by the two conditions:
If we want to add a third filter:
You can keep adding filters until you run out of data.
You can also change the conditions to accommodate factors or character variables. All you need to do is change the selectInput and numericInput to whatever you want.
If this is what you want, I've solved it using modules and by creating a reactiveValue (tmpFilters) that contains all selections (variable + condition + value). From it, I created a list with all filters (tmpList) and from it I created the proper filter (tmpListFilters) to use with subset.
This works because the final dataset is "constantly" being subset by this reactiveValue (the tmpFilters). At the beginning, tmpFilters is empty, so we get the original dataset. Whenever the user adds the first filter (and other filters after that), this reactiveValue gets updated and so does the dataset.
Here's the code for it:
library(shiny)
# > MODULE #####################################################################
## |__ MODULE UI ===============================================================
variablesUI <- function(id, number, LHSchoices) {
ns <- NS(id)
tagList(
fluidRow(
column(
width = 4,
selectInput(
inputId = ns("variable"),
label = paste0("Select Variable ", number),
choices = c("Choose" = "", LHSchoices)
)
),
column(
width = 4,
selectInput(
inputId = ns("condition"),
label = paste0("Select condition ", number),
choices = c("Choose" = "", c("==", "!=", ">", ">=", "<", "<="))
)
),
column(
width = 4,
numericInput(
inputId = ns("value.variable"),
label = paste0("Value ", number),
value = NA,
min = 0
)
)
)
)
}
## |__ MODULE SERVER ===========================================================
filter <- function(input, output, session){
reactive({
req(input$variable, input$condition, input$value.variable)
fullFilter <- paste0(
input$variable,
input$condition,
input$value.variable
)
return(fullFilter)
})
}
# Shiny ########################################################################
## |__ UI ======================================================================
ui <- fixedPage(
fixedRow(
column(
width = 5,
selectInput(
inputId = "userDataset",
label = paste0("Select dataset"),
choices = c("Choose" = "", ls("package:datasets"))
),
h5(""),
actionButton("insertBtn", "Add another filter")
),
column(
width = 7,
tableOutput("finalTable")
)
)
)
## |__ Server ==================================================================
server <- function(input, output) {
### \__ Get dataset from user selection ------------------------------------
originalDF <- reactive({
req(input$userDataset)
tmpData <- eval(parse(text = paste0("datasets::", input$userDataset)))
if (!class(tmpData) == "data.frame") {
stop("Please select a dataset of class data.frame")
}
tmpData
})
### \__ Get the column names -----------------------------------------------
columnNames <- reactive({
req(input$userDataset)
tmpData <- eval(parse(text = paste0("datasets::", input$userDataset)))
names(tmpData)
})
### \__ Create Reactive Filter ---------------------------------------------
tmpFilters <- reactiveValues()
### \__ First UI Element ---------------------------------------------------
### Add first UI element with column names
observeEvent(input$userDataset, {
insertUI(
selector = "h5",
where = "beforeEnd",
ui = tagList(variablesUI(paste0("var", 1), 1, columnNames()))
)
})
### Update Reactive Filter with first filter
filter01 <- callModule(filter, paste0("var", 1))
observe(tmpFilters[['1']] <- filter01())
### \__ Other UI Elements --------------------------------------------------
### Add other UI elements with column names and update the filter
observeEvent(input$insertBtn, {
btn <- sum(input$insertBtn, 1)
insertUI(
selector = "h5",
where = "beforeEnd",
ui = tagList(variablesUI(paste0("var", btn), btn, columnNames()))
)
newFilter <- callModule(filter, paste0("var", btn))
observeEvent(newFilter(), {
tmpFilters[[paste0("'", btn, "'")]] <- newFilter()
})
})
### \__ Dataset with Filtered Results --------------------------------------
resultsFiltered <- reactive({
req(filter01())
tmpDF <- originalDF()
tmpList <- reactiveValuesToList(tmpFilters)
if (length(tmpList) > 1) {
tmpListFilters <- paste(tmpList, "", collapse = "& ")
} else {
tmpListFilters <- unlist(tmpList)
}
tmpResult <- subset(tmpDF, eval(parse(text = tmpListFilters)))
tmpResult
})
### \__ Print the Dataset with Filtered Results ----------------------------
output$finalTable <- renderTable({
req(input$userDataset)
if (is.null(tmpFilters[['1']])) {
head(originalDF(), 10)
} else {
head(resultsFiltered(), 10)
}
})
}
#------------------------------------------------------------------------------#
shinyApp(ui, server)
# End
If you are looking for a data subsetting/filtering in Shiny Module :
filterData from package shinytools can do the work. It returns an expression as a call but it can also return the data (if your dataset is not too big).
library(shiny)
# remotes::install_github("ardata-fr/shinytools")
library(shinytools)
ui <- fluidPage(
fluidRow(
column(
3,
filterDataUI(id = "ex"),
actionButton("AB", label = "Apply filters")
),
column(
3,
tags$strong("Expression"),
verbatimTextOutput("expression"),
tags$br(),
DT::dataTableOutput("DT")
)
)
)
server <- function(input, output) {
x <- reactive({iris})
res <- callModule(module = filterDataServer, id = "ex", x = x, return_data = FALSE)
output$expression <- renderPrint({
print(res$expr)
})
output$DT <- DT::renderDataTable({
datatable(data_filtered())
})
data_filtered <- eventReactive(input$AB, {
filters <- eval(expr = res$expr, envir = x())
x()[filters,]
})
}
shinyApp(ui, server)
You can also use lazyeval or rlang to evaluate the expression :
filters <- lazyeval::lazy_eval(res$expr, data = x())
filters <- rlang::eval_tidy(res$expr, data = x())
You need to check for existing input values and use them if available:
# Prevent dynamic inputs from resetting
newInputValue <- "Option 1"
if (newInputId %in% names(input)) {
newInputValue <- input[[newInputId]]
}
# Define new input
newInput <- selectInput(newInputId, newInputLabel, c("Option 1", "Option 2", "Option 3"), selected=newInputValue)
A working version of the gist (without the reset problem) can be found here: https://gist.github.com/motin/0d0ed0d98fb423dbcb95c2760cda3a30
Copied below:
ui.R
library(shiny)
shinyUI(pageWithSidebar(
# Application title
headerPanel("Dynamically append arbitrary number of inputs"),
# Sidebar with a slider input for number of bins
sidebarPanel(
uiOutput("allInputs"),
actionButton("appendInput", "Append Input")
),
# Show a plot of the generated distribution
mainPanel(
p("This shows how to add an arbitrary number of inputs
without resetting the values of existing inputs each time a new input is added.
For example, add a new input, set the new input's value to Option 2, then add
another input. Note that the value of the first input does not reset to Option 1.")
)
))
server.R
library(shiny)
shinyServer(function(input, output) {
output$allInputs <- renderUI({
# Get value of button, which represents number of times pressed (i.e. number of inputs added)
inputsToShow <- input$appendInput
# Return if button not pressed yet
if(is.null(inputsToShow) || inputsToShow < 1) return()
# Initialize list of inputs
inputTagList <- tagList()
# Populate the list of inputs
lapply(1:inputsToShow,function(i){
# Define unique input id and label
newInputId <- paste0("input", i)
newInputLabel <- paste("Input", i)
# Prevent dynamic inputs from resetting
newInputValue <- "Option 1"
if (newInputId %in% names(input)) {
newInputValue <- input[[newInputId]]
}
# Define new input
newInput <- selectInput(newInputId, newInputLabel, c("Option 1", "Option 2", "Option 3"), selected=newInputValue)
# Append new input to list of existing inputs
inputTagList <<- tagAppendChild(inputTagList, newInput)
})
# Return updated list of inputs
inputTagList
})
})
(The solution was guided on Nick's hints in the original gist from where you got the code of the promising solution)
I am trying to figure out how to write a .csv based on selections made by the end user. The selections made will subset the "geodata.csv" and write a separate "solution.csv" file in the application folder.
N.B. - I have created a github repo to make solving the question easier. It contains the geodata.csv, ui.R & server.R but no solution.csv yet!
geodata.csv
Postcode,HC,BSL,Position Location
10,1,A,C
10,1,A,D
10,1,A,D
11,1,B,C
11,1,B,C
ui.R
shinyUI(
pageWithSidebar(
headerPanel('Min. working example - write a csv based on user input'),
sidebarPanel(
selectInput("filter1", "First selection:"
, choices = c(Choose='', "A", "B")
#, multiple=T
),
selectInput("filter2", "Second selection:",
choices = c(Choose='', "C", "D")
),
br(),
p("Include actionButton to prevent write occuring before user finalises selection"),
actionButton("generateButton","Write Data")
),
mainPanel()
)
)
server.R
# Load data
setwd("/Users/lukesingham/SOtestApp")
geodata <- read.csv("geodata.csv", na.string = "#N/A", row.names=NULL)
# Reactivity to subset data ####
shinyServer(function(input, output) {
geodatasetInput <- reactive({
# BSL switch
selection <-switch(input$BSL
, A = "A"
, B = "B"
)
# Location switch
selection2 <-switch(input$Location
, C = "C"
, D = "D"
)
# subset based on selection
Subgeodata <- subset(geodata, BSL == selection & Position.Location == selection2)
# Execute selections on data upon button-press
input$generateButton
# aggregate by postcode
Subgeodata <- Subgeodata[1:2] #no longer need other columns
AggSubGdata <- aggregate(. ~ Postcode, data=Subgeodata, FUN=sum)
isolate(write.csv(AggSubGdata
, file = "/Users/lukesingham/SOtestApp/solution.csv"
, row.names=F
))
})
})
solution.csv
For example, based on user selections of A and D the solution file should look like this:
Postcode,HC
10,2
Here is the working example:
# Load data
setwd("/Users/lukesingham/SOtestApp")
geodata <- read.csv("geodata.csv", na.string = "#N/A", row.names=NULL)
# Reactivity to subset data ####
shinyServer(function(input, output) {
geodatasetInput <- observe({
# Execute selections on data upon button-press
if(input$generateButton == 0) return()
inp.BSL <- isolate(input$filter1)
inp.loc <- isolate(input$filter2)
if (inp.BSL=='' | inp.loc=='') return()
# BSL switch
selection <-switch(inp.BSL
, A = "A"
, B = "B"
)
# Location switch
selection2 <-switch(inp.loc
, C = "C"
, D = "D"
)
# subset based on selection
Subgeodata <- subset(geodata, BSL == selection & Position.Location == selection2)
# browser()
# aggregate by postcode
Subgeodata <- Subgeodata[1:2] #no longer need other columns
AggSubGdata <- aggregate(. ~ Postcode, data=Subgeodata, FUN=sum)
write.csv(AggSubGdata
, file = "solution.csv"
, row.names=F
)
})
})
and a short analysis of your code:
The main reason geodatasetInput does not start at all is because it is a reactive() expression. reactive() is evaluated only when it is called by something else like renderTable() in the answer of #pops. If you want it to be executed by itself, it should be observe().
It might be a good idea to have input$generateButton in the beginning of your observe() expression.
In ui.R, you call a numeric input field filter1, but you try to obtain its value as input$BSL from server.R; the same is true for filter2.
As you want geodataSetInput to be triggered only on generateButton, all other input$ and reactive expressions withing geodataSetInput should be isolated with isolate(). On the other hand, there is no need to isolate write.csv because this particular function call does not involve any 'dynamic' parameters.
you would need to Render your the table you're subsetting, perhaps someone else can explain why you need this co-dependance. Below is the working example of the way I went to solve it. It will save the solution.csv in the working directory.
rm(list = ls())
library(shiny)
# You can change this directory
setwd("/Users/lukesingham/SOtestApp")
geodata <- read.csv("geodata.csv", header = TRUE, sep = ",",stringsAsFactors =FALSE)
ui = pageWithSidebar(
headerPanel('Min. working example - write a csv based on user input'),
sidebarPanel(
selectInput("filter1", "First selection:", choices = c("A", "B"),selected = "A"),
selectInput("filter2", "Second selection:", choices = c("C", "D"),selected = "C"),
br(),
p("Include actionButton to prevent write occuring before user finalises selection"),
actionButton("generateButton","Write Data")),mainPanel(tableOutput("test1"))
)
server = function(input, output) {
geodatasetInput <- reactive({
if(input$generateButton == 0){return()}
isolate({
input$generateButton
test_data <- geodata[geodata$BSL %in% as.character(input$filter1),]
test_data <- geodata[geodata$Position.Location %in% as.character(input$filter2),]
test_data <- test_data[,1:2]
test_data <- aggregate(. ~ Postcode, data=test_data, FUN=sum)
test_data
})
write.csv(test_data,"solution.csv",row.names=F)
})
output$test1 <- renderTable({geodatasetInput()})
}
runApp(list(ui = ui, server = server))
I am new to R and R Shiny.
For the code i have at the moment i need to manually input the file name, i would like to generalize the case and let the user to pick working directory and corresponding file name.
1, user choose working directory
then shiny able to store all the file names under the selected working directory. similar to list.files()
2, then the box list files will list all file names under the selected wd
and user able to check which dataset should be shown
3, in the mainpanel
top 10 instances of the dataset with the header will be shown
What i have tried is
server.R
library(shiny)
setwd("C:/Users/HKGGAIT001/Google Drive/GA Project/Cargo/Cargo.Statistics/data/Hactl")
data1 <- read.csv(list.files()[1])
data2 <- read.csv(list.files()[2])
# Define server logic required to summarize and view the selected
# dataset
shinyServer(function(input, output) {
# Return the requested dataset
datasetInput <- reactive({
switch(input$dataset,
"data1" = data1,
"data2" = data2)
})
# Generate a summary of the dataset
output$summary <- renderPrint({
dataset <- datasetInput()
summary(dataset)
})
# Show the first "n" observations
output$view <- renderTable({
head(datasetInput(), n = input$obs)
})
})
ui.R
library(shiny)
# Define UI for dataset viewer application
shinyUI(fluidPage(
# Application title
titlePanel("Shiny Text"),
# Sidebar with controls to select a dataset and specify the
# number of observations to view
sidebarLayout(
sidebarPanel(
selectInput("dataset", "Choose a dataset:",
choices = c("data1", "data2")),
numericInput("obs", "Number of observations to view:", 10)
),
# Show a summary of the dataset and an HTML table with the
# requested number of observations
mainPanel(
verbatimTextOutput("summary"),
tableOutput("view")
)
)
))
The situation is similar to This website while my case is request user to pick local working directory.
Thanks for your gentle help
First, create the .csv files to reproducibility:
write.csv(x = data.frame(V1 = 1:13, V2 = letters[1:13]),
file = "teste1.csv", row.names = FALSE)
write.csv(x = data.frame(V1 = 14:26, V2 = letters[14:26]),
file = "teste2.csv", row.names = FALSE)
write.csv(x = data.frame(V1 = rnorm(15), V2 = runif(15)),
file = "teste3.csv", row.names = FALSE)
Add a global.R script in your app might be useful. In this script you would be able to:
i. let the user select the working directory,
ii. read the .csv files in that folder,
iii. create a list of files that could be used by ui.R and server.R
# global.R
library(shiny)
wd <<- choose.dir()
setwd(wd)
csv <<- list.files(pattern = ".csv")
files <<- vector("list", length(csv))
for (i in seq_along(files)) {
files[[i]] <- read.csv(csv[i], stringsAsFactors = FALSE)
}
list_of_datasets <<- seq_along(files)
names(list_of_datasets) <- gsub(pattern = ".csv", replacement = "", x = csv)
Then you just have to make a few changes in the original scripts you provided us. In ui.R I would redefine the selectInput function so that displays the name of the files to the users. Also, you can't be sure that the selected folder would have 2 files.
selectInput("dataset", "Choose a dataset:",
choices = list_of_datasets)
In server.R you should i) remove the 2nd, 3rd and 4th lines (already handled by global.R) and ii) change datasetInput function:
datasetInput <- reactive({
files[[as.numeric(input$dataset)]]
})