Heber Brandao
Reputation: 57
Unable to make my reactive variables work
As I am fairly new to R scripting, I am having a hard time to make my app work as it should.
What am I trying to achieve:
- User uploads a CSV
- User checks a preview of file (safety check)
- User executes query
- Query appears on mainPanel
- Results are downloadable on csv.
I am able to execute all those points as soon as I upload a file. They happen at the same time, killing the purpose of the application.
Problem: I have three outputs which need to be performed at specific actions (Load Preview, Run Query, Download Query Results).
Can someone please help me?
Here is my code:
#Libraries to load
library(shiny)
library(dplyr)
library('devtools')
#--------------------------------------
# Interface
#--------------------------------------
ui <- fluidPage(
# Application title
titlePanel("Content Upload Report"),
sidebarPanel(
h4("1. Select the desired data range and upload your file. A preview will be shown once it gets loaded."),
# Sidebar with a data range input
dateRangeInput("dates", "Date range",
start = "2017-09-01", end = "2017-09-30",
min = "2017-01-01", max = "2018-12-31",
format = "yyyy-mm-dd", startview = "month", weekstart = 1,
language = "en", separator = " to "),
#Sidebar with a file input
fileInput("file1", "Choose CSV File",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")),
h4("2. Once you see that the list seems correct, click on the button below."),
tableOutput("preview"),
#Submit button
actionButton("startQuery","Start Query",icon ("search"), width = NULL, class="butt"),
tags$head(tags$style(".butt{background-color:#007fad;} .butt{color: white;}")),
tags$br(),
#Warning about loading time
helpText("When you click the button above, it might take a while until the results are ready.",
"The size of your list directly impacts the waiting time for the query."),
#Horizontal Line
tags$hr(),
#Download Results
downloadButton('downloadData1', label = "Download Results", class = "btmcolor"),
tags$head(tags$style(".btmcolor{background-color:#007fad;} .btmcolor{color: white;}"))
),
mainPanel(
dataTableOutput("result"),
tags$style(type="text/css", '#result tfoot {display:none;}')
)
)
#--------------------------------------
# Server
#--------------------------------------
server <- function(input, output) {
d<-reactiveValues()
output$preview <- renderTable({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, it will be a data frame with 'name',
# 'size', 'type', and 'datapath' columns. The 'datapath'
# column will contain the local filenames where the data can
# be found.
inFile <- input$file1
if (is.null(inFile))
return(NULL)
df <- read.csv(inFile$datapath, header = FALSE, sep =",")
#This will be printed on the preview
head(df)
})
output$result <- renderDataTable({
# Fix data input to format yyyymmdd
tmp_str <- paste(as.character(input$dates), collapse = " and ")
tmp_str <- gsub("-", "", tmp_str)
# input$file1 will be NULL initially. After the user selects
# and uploads a file, it will be a data frame with 'name',
# 'size', 'type', and 'datapath' columns. The 'datapath'
# column will contain the local filenames where the data can
# be found.
inFile <- input$file1
if (is.null(inFile))
return(NULL)
df <- read.csv(inFile$datapath, header = FALSE, sep =",")
#Prepare file for query
#read the user file as a single string into csvString
csvString <- paste(readLines(inFile$datapath), collapse=", ")
print(csvString)
#put all emails into 1 string with quotes around each
csvString <- paste0(sprintf("%s", csvString), collapse = ", ")
#Authenticate on DB
ds <- "authentication string. custom library"
#Run Query
query <- paste0("
SELECT item_id, country, total_new_images
FROM inventory
WHERE item_id IN (", csvString, ")
GROUP BY item_id, country
ORDER BY item_id
")
d$data <- ds$execute_query(query) #custom function
d$result1 <- as.data.frame(d$data)
})
#------------------------------------------
# Download Output
#------------------------------------------
output$downloadData1 <- downloadHandler(
filename = function() {
tmp<- paste(as.character(input$dates), collapse = "_")
tmp <- gsub("-", "", tmp)
paste0("content_upload_",tmp,".csv") },
content = function(file) {
write.csv(d$result1, file)
})
}
shinyApp(ui = ui, server = server)
Upvotes: 0
Views: 45
Answers (1)
amrrs
Reputation: 6325
Encapsulating your output functions inside observeEvent would help do that.
#Libraries to load
library(shiny)
library(dplyr)
library('devtools')
#--------------------------------------
# Interface
#--------------------------------------
ui <- fluidPage(
# Application title
titlePanel("Content Upload Report"),
sidebarPanel(
h4("1. Select the desired data range and upload your file. A preview will be shown once it gets loaded."),
# Sidebar with a data range input
dateRangeInput("dates", "Date range",
start = "2017-09-01", end = "2017-09-30",
min = "2017-01-01", max = "2018-12-31",
format = "yyyy-mm-dd", startview = "month", weekstart = 1,
language = "en", separator = " to "),
#Sidebar with a file input
fileInput("file1", "Choose CSV File",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")),
h4("2. Once you see that the list seems correct, click on the button below."),
tableOutput("preview"),
#Submit button
actionButton("startQuery","Start Query",icon ("search"), width = NULL, class="butt"),
tags$head(tags$style(".butt{background-color:#007fad;} .butt{color: white;}")),
tags$br(),
#Warning about loading time
helpText("When you click the button above, it might take a while until the results are ready.",
"The size of your list directly impacts the waiting time for the query."),
#Horizontal Line
tags$hr(),
#Download Results
downloadButton('downloadData1', label = "Download Results", class = "btmcolor"),
tags$head(tags$style(".btmcolor{background-color:#007fad;} .btmcolor{color: white;}"))
),
mainPanel(
dataTableOutput("result"),
tags$style(type="text/css", '#result tfoot {display:none;}')
)
)
#--------------------------------------
# Server
#--------------------------------------
server <- function(input, output) {
d<-reactiveValues()
output$preview <- renderTable({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, it will be a data frame with 'name',
# 'size', 'type', and 'datapath' columns. The 'datapath'
# column will contain the local filenames where the data can
# be found.
inFile <- input$file1
if (is.null(inFile))
return(NULL)
df <- read.csv(inFile$datapath, header = FALSE, sep =",")
#This will be printed on the preview
head(df)
})
observeEvent(input$startQuery,{
output$result <- renderDataTable({
# Fix data input to format yyyymmdd
tmp_str <- paste(as.character(input$dates), collapse = " and ")
tmp_str <- gsub("-", "", tmp_str)
# input$file1 will be NULL initially. After the user selects
# and uploads a file, it will be a data frame with 'name',
# 'size', 'type', and 'datapath' columns. The 'datapath'
# column will contain the local filenames where the data can
# be found.
inFile <- input$file1
if (is.null(inFile))
return(NULL)
df <- read.csv(inFile$datapath, header = FALSE, sep =",")
#Prepare file for query
#read the user file as a single string into csvString
csvString <- paste(readLines(inFile$datapath), collapse=", ")
print(csvString)
#put all emails into 1 string with quotes around each
csvString <- paste0(sprintf("%s", csvString), collapse = ", ")
#Authenticate on DB
ds <- "authentication string. custom library"
#Run Query
query <- paste0("
SELECT item_id, country, total_new_images
FROM inventory
WHERE item_id IN (", csvString, ")
GROUP BY item_id, country
ORDER BY item_id
")
d$data <- ds$execute_query(query) #custom function
d$result1 <- as.data.frame(d$data)
})
})
#------------------------------------------
# Download Output
#------------------------------------------
observeEvent(input$downloadData1,{
output$downloadData1 <- downloadHandler(
filename = function() {
tmp<- paste(as.character(input$dates), collapse = "_")
tmp <- gsub("-", "", tmp)
paste0("content_upload_",tmp,".csv") },
content = function(file) {
write.csv(d$result1, file)
})
})
}
shinyApp(ui = ui, server = server)
Upvotes: 1
Related Questions
- How to use reactive() inside of a reactiveValues()?
- Using Shiny Reactive
- fail to pass reactive value to variables in shiny
- Not sure how to use reactive values
- Shiny reactive works only if print the input variables
- Reactive values - what am I doing wrong
- Issues with assigning reactive values within reactive functions
- Reactive input in Shiny not working
- R shiny error: Problems with a reactive function
- R shiny - Simple Reactive issue