Problem: I have the following app. Essentially, I want to press the button to load the data. After the first time I load the data via button press I want to get ask if I want to save my changes. If yes, confirmation that changes were successfully saved, else show some other data (other data not included).
Approach I tried to solve it with observeEvent expressions which are triggered via reactiveValues. However, as you will observe when running the script below, this does not work out as expected.
Question: Any idea on what is wrong?
library(shiny)
library(shinyWidgets)
library(rhandsontable)
shinyApp(
ui = fluidPage(
actionButton("show", "Show data", width = "100%"),
rHandsontableOutput("data_table")
),
server = function(input, output) {
rv <- reactiveValues(
# Triggers
pressed_first_time = 0,
confirm_module = TRUE,
save_module = TRUE,
table_change = TRUE
)
observeEvent(input$show, ignoreInit = TRUE, {
if (rv$pressed_first_time == 0){
rv$pressed_first_time <- isolate(rv$pressed_first_time + 1)
rv$table_change <- isolate(!rv$table_change)
cat("pressed_first time")
} else {
rv$pressed_first_time <- isolate(rv$pressed_first_time + 1)
rv$confirm_module <- isolate(!rv$confirm_module)
}
})
observeEvent(rv$confirm_module, ignoreInit = TRUE,{
confirmSweetAlert(
session = session,
inputId = session$ns("show_confirmation"),
title = "Be careful, your changes might be lost",
text = "Do you want to save your changes?",
type = "question",
btn_labels = c("Cancel", "Save"),
btn_colors = NULL,
closeOnClickOutside = FALSE,
showCloseButton = FALSE,
html = FALSE
)
cat("confirmation module")
rv$save_module <- isolate(!rv$save_module)
})
observeEvent(rv$save_module, ignoreInit = TRUE, {
if (isTRUE(input$show_confirmation)) {
sendSweetAlert(
session = session,
title = "Saved",
text = "Updated data has been successfully saved",
type = "success"
)
rv$table_change <- isolate(!rv$table_change)
cat("saving module")
} else {
return()
}
})
data_to_modify <- eventReactive(rv$table_change, ignoreInit = TRUE, {
mtcars
})
handson_df <- eventReactive(rv$table_change, ignoreInit = TRUE, {
cat("create handsons")
req(data_to_modify())
rhandsontable(data_to_modify())
})
output$data_table <- renderRHandsontable({
cat("plot module")
req(handson_df())
htmlwidgets::onRender(handson_df(),change_hook)
})
}
)
I think its just that you need session inside the server, as in:
server = function(input, output, session) {...
Actually, I found out the problem. The link from data_to_modify to handson_df was missing. In the below solution I put them together but in principle adding another reactiveValue triggering handson_df from data_to_modify will also work
library(shiny)
library(rhandsontable)
shinyApp(
ui = fluidPage(
actionButton("show", "Show data", width = "100%"),
rHandsontableOutput("data_table")
),
server = function(input, output) {
rv <- reactiveValues(
# Triggers
pressed_first_time = 0,
confirm_module = TRUE,
save_module = TRUE,
table_change = TRUE
)
observeEvent(input$show, ignoreInit = TRUE, {
if (rv$pressed_first_time == 0){
rv$pressed_first_time <- 1
rv$table_change <- isolate(!rv$table_change)
cat("pressed_first time")
} else {
rv$pressed_first_time <- 1
rv$confirm_module <- isolate(!rv$confirm_module)
}
})
observeEvent(rv$confirm_module, ignoreInit = TRUE,{
confirmSweetAlert(
session = session,
inputId = session$ns("show_confirmation"),
title = "Be careful, your changes might be lost",
text = "Do you want to save your changes?",
type = "question",
btn_labels = c("Cancel", "Save"),
btn_colors = NULL,
closeOnClickOutside = FALSE,
showCloseButton = FALSE,
html = FALSE
)
})
observeEvent(input$show_confirmation, ignoreInit = TRUE, {
if (isTRUE(input$show_confirmation)) {
sendSweetAlert(
session = session,
title = "Saved",
text = "Updated data has been successfully saved",
type = "success"
)
rv$table_change <- isolate(!rv$table_change)
cat("saving module")
} else {
return()
}
})
data_to_modify <- eventReactive(rv$table_change, ignoreInit = TRUE, {
rhandsontable(mtcars)
})
# handson_df <- eventReactive(rv$table_change, ignoreInit = TRUE, {
# cat("create handsons")
# req(data_to_modify())
# rhandsontable(data_to_modify())
# })
output$data_table <- renderRHandsontable({
cat("plot module")
req(data_to_modify())
data_to_modify()
# htmlwidgets::onRender(handson_df(),change_hook)
})
}
)
Related
I am creating an app where the users can download the plot displayed. I want the user to be able to click download and ShinyAlert will pop up to ask for filename as the input.
So far the file gets downloaded if I press on save. However, when the CancelButton is clicked, shiny tries to download the page's HTML, with a "Failed - Server problem".
I placed an if function inside downloadHandler so that when input$shinyalert != FALSE the downloadHandler will execute the code, but I couldn't find the fault in my code. Any help will be appreciated, thanks.
Here is the code:
UI:
ui <- fluidPage(
useShinyalert(),
plotOutput("vmgraph"),
actionButton("downloadPlot", "Download Plot")
useShinyjs(),
## hide the downloadButton and only display actionButton
conditionalPanel(
"false",
downloadButton("downloadData")
)
)
Server:
observeEvent(input$downloadPlot, {
shinyalert("Save as:",
type = "input",
size = "m",
closeOnEsc = TRUE,
closeOnClickOutside = TRUE,
showConfirmButton = TRUE,
showCancelButton = TRUE,
confirmButtonText = "Save",
confirmButtonCol = "#0075B8",
animation = TRUE)
})
output$downloadData <- downloadHandler(
filename = function() {
if (input$shinyalert != FALSE) {
paste(input$shinyalert, ".png", sep = "")}},
content = function(file) {
if (input$shinyalert != FALSE) {
ggsave(file, plot = vmgraph(), width = 12, height = 7.7)
}})
observeEvent(input$shinyalert, {
## Click on the downloadButton when input$shinyalert is updated
shinyjs::runjs("$('#downloadData')[0].click();")
})
Perform your check for the cancel button before you get into the downloadHandler:
library(shiny)
library(shinyjs)
library(shinyalert)
library(ggplot2)
gg <- ggplot(mtcars, aes(mpg)) +
geom_boxplot()
ui <- fluidPage(
useShinyalert(),
plotOutput("vmgraph"),
actionButton("downloadPlot", "Download Plot"),
useShinyjs(),
## hide the downloadButton and only display actionButton
conditionalPanel(
"false",
downloadButton("downloadData")
)
)
server <- function(input, output) {
observeEvent(input$downloadPlot, {
shinyalert("Save as:",
type = "input",
size = "m",
closeOnEsc = TRUE,
closeOnClickOutside = TRUE,
showConfirmButton = TRUE,
showCancelButton = TRUE,
confirmButtonText = "Save",
confirmButtonCol = "#0075B8",
animation = TRUE
)
})
output$downloadData <- downloadHandler(
# do not perform check here
filename = function() {
paste(input$shinyalert, ".png", sep = "")
},
content = function(file) {
ggsave(file, plot = gg, width = 12, height = 7.7)
}
)
observeEvent(input$shinyalert, {
## Click on the downloadButton when input$shinyalert is updated
# perform the check here
if (input$shinyalert != FALSE) {
shinyjs::runjs("$('#downloadData')[0].click();")
}
})
}
shinyApp(ui = ui, server = server)
I'm working on a shiny dashboard that makes heavy use of shiny modules and my client has asked me to make it so that the same two inputs from my dashboard's various tabs take on the same values regardless of tab. I'm having a huge problem doing this and was able to recreate it using a toy example that you'll find below.
#app.R
library(data.table)
library(shiny)
library(ggplot2)
library(ggthemes)
library(shinythemes)
source("Modules.R")
penguins <<- as.data.table(palmerpenguins::penguins)
ui = uiOutput("ui")
inputs <<- reactiveValues(species = NULL, island = NULL)
server <- function(input, output, session) {
bill_species_server("tab1")
flipper_mass_scatter_server("tab2")
output$ui = renderUI({
fluidPage(
titlePanel("", "Penguin Dashboard"),
tabsetPanel(
tabPanel("Bill Length by Species",
ui_code("tab1")
),
tabPanel("Flipper Length by Body Mass",
ui_code("tab2")
)
)
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
#Modules.R
ui_code = function (id) {
ns = NS(id)
sidebarLayout(position = "left",
sidebarPanel(
selectInput(ns("species"), "Choose 1+ species:", choices = penguins[, sort(unique(species))], multiple = TRUE),
selectInput(ns("island"), "Choose 1+ islands:", choices = penguins[, sort(unique(island))], multiple = TRUE)
),
mainPanel(
plotOutput(ns("plot"))
)
)
}
bill_species_server = function(id) {
moduleServer(id, function(input, output, session) {
observeEvent(inputs$species, ignoreInit = TRUE, ignoreNULL = TRUE, {
if (length(inputs$species) > 0) {
updateSelectInput(session = session, inputId = "species", selected = inputs$species)
}
})
observeEvent(inputs$island, ignoreInit = TRUE, ignoreNULL = TRUE, {
if (length(inputs$island) > 0) {
updateSelectInput(session = session, inputId = "island", selected = inputs$island)
}
})
output$plot = renderPlot({
if (length(input$species) > 0) {
penguins = penguins[species %in% input$species]
}
if (length(input$island) > 0) {
penguins = penguins[island %in% input$island]
}
ggplot(penguins) + geom_histogram(aes(x = `bill_length_mm`, fill = species)) + scale_fill_canva(palette = "Striking and energetic")
})
observeEvent(input$species, ignoreNULL = TRUE, ignoreInit = TRUE, {
inputs$species = input$species
})
observeEvent(input$island, ignoreNULL = TRUE, ignoreInit = TRUE, {
inputs$island = input$island
})
})
return(inputs)
}
flipper_mass_scatter_server = function (id) {
moduleServer(id, function(input, output, session) {
observeEvent(inputs$species, ignoreInit = TRUE, ignoreNULL = TRUE, {
if (length(inputs$species) > 0) {
updateSelectInput(session = session, inputId = "species", selected = inputs$species)
}
})
observeEvent(inputs$island, ignoreInit = TRUE, ignoreNULL = TRUE, {
if (length(inputs$island) > 0) {
updateSelectInput(session = session, inputId = "island", selected = inputs$island)
}
})
output$plot = renderPlot({
if (length(input$species) > 0) {
penguins = penguins[species %in% input$species]
}
if (length(input$island) > 0) {
penguins = penguins[island %in% input$island]
}
ggplot(penguins) + geom_point(aes(x = `flipper_length_mm`, y = body_mass_g, colour = species)) + scale_colour_canva(palette = "Striking and energetic")
})
observeEvent(input$species, ignoreNULL = TRUE, ignoreInit = TRUE, {
inputs$species = input$species
})
observeEvent(input$island, ignoreNULL = TRUE, ignoreInit = TRUE, {
inputs$island = input$island
})
})
return(inputs)
}
So the two inputs that I'm trying to link in this toy example are species and island. I've set it up so that when someone makes a new selection on either input, an observer should update a global variable which in this case I've labelled inputs. And then if inputs is updated, the other tab should then update its own selectInput.
Weirdly, I find that with this code, if I make my selections kind of slowly, all works just fine! However, the moment that I click 2+ choices in rapid succession, it causes an infinite loop to happen in the current tab where the second choice appears, then disappears, then appears... etc. Conversely, when I have 3 choices selected and try to delete options in rapid succession, it just doesn't let me delete all choices!!
So weird.
Anyone know what the problem is with my code, and how I can force the inputs in both tabs to keep the same values as chosen in the other tabs?
Thanks!
I significantly restructured how I approached this problem and came up with a solution. Basically, I used shinydashboard and decided that I would define the species and island selectInput controls outside of my modules.
The values to those controls were then passed to the modules as reactive objects that were then used to filter the data before the data got plotted. This works so much better now! Have a look at my two files:
#app.R
library(data.table)
library(shiny)
library(ggplot2)
library(ggthemes)
library(shinythemes)
library(shinydashboard)
source("Modules.R")
penguins <<- as.data.table(palmerpenguins::penguins)
ui = dashboardPage(header = dashboardHeader(title = "Penguin Dashboard"),
sidebar = dashboardSidebar(
sidebarMenu(id = "tabs",
selectInput("species", "Choose 1+ species:", choices = penguins[, sort(unique(species))], multiple = TRUE),
selectInput("island", "Choose 1+ islands:", choices = penguins[, sort(unique(island))], multiple = TRUE),
menuItem("Bill Length by Species", expandedName = "tab1", tabName = "tab1", startExpanded = TRUE,
sliderInput("mass", "Select a range of body masses:",
min = penguins[, min(body_mass_g, na.rm=TRUE)],
max = penguins[, max(body_mass_g, na.rm=TRUE)],
value = penguins[, range(body_mass_g, na.rm=TRUE)])
),
menuItem("Flipper Length by Body Mass", expandedName = "tab2", tabName = "tab2",
checkboxGroupInput("sex", "Choose sex of penguins:",
choices = c("male","female")))
)),
body = dashboardBody(
uiOutput("plots")
)
)
#inputs <<- reactiveValues(species = NULL, island = NULL)
server <- function(input, output, session) {
#inputs <- reactiveValues(species=input$species, island=input$island)
in_species = reactive({input$species})
in_island = reactive({input$island})
in_mass = reactive({input$mass})
in_sex = reactive({input$sex})
bill_species_server("tab1", in_species, in_island, in_mass)
flipper_mass_scatter_server("tab2", in_species, in_island, in_sex)
output$plots = renderUI({
validate(need(!is.null(input$sidebarItemExpanded), ""))
if (input$sidebarItemExpanded == "tab1") {
ui_code("tab1")
} else {
ui_code("tab2")
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
#Modules.R
ui_code = function (id) {
ns = NS(id)
plotOutput(ns("plot"))
}
bill_species_server = function(id, in_species, in_island, in_mass) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$plot = renderPlot({
if (length(in_species()) > 0) {
penguins = penguins[species %in% in_species()]
}
if (length(in_island()) > 0) {
penguins = penguins[island %in% in_island()]
}
penguins = penguins[body_mass_g %between% c(in_mass()[1], in_mass()[2])]
ggplot(penguins) + geom_histogram(aes(x = `bill_length_mm`, fill = species)) + scale_fill_canva(palette = "Striking and energetic")
})
})
}
flipper_mass_scatter_server = function (id, in_species, in_island, in_sex) {
moduleServer(id, function(input, output, session) {
output$plot = renderPlot({
if (length(in_species()) > 0) {
penguins = penguins[species %in% in_species()]
}
if (length(in_island()) > 0) {
penguins = penguins[island %in% in_island()]
}
if (length(in_sex()) > 0) {
penguins = penguins[sex %in% in_sex()]
}
ggplot(penguins) + geom_point(aes(x = `flipper_length_mm`, y = body_mass_g, colour = species)) + scale_colour_canva(palette = "Striking and energetic")
})
})
}
My aim is to refresh .Rdata objects when the user confirms a dataset reloading through a shinyalert pop up. A small example below. Before loading the app I've created and saved 2 objects (DatasetNumber1 and DatasetNumber2) containing a label and data to be displayed.
When the app is launched I load by default DatasetNumber1 objects thanks to the global.R file. So now test and data objects from DatasetNumber1 are accessible through server.R AND ui.R, which I need to (not in this example, but in my full app).
I want the user to be able to select the other dataset via the dropdown to refresh the global R objects and in the end the plotting.
The print statement in the server.R, after I've selected the other dataset in the dropdown, clicked on the Load button and validate through the shinyalert, confirms that the dropdown input changed but the load statement does not refresh R objects.
I've tried to make the loading reactive straight in the global.R script but I ended with the same result. Maybe the rendering is faster than the loading and so does not take the updated data in account to render...
In any case I do not want to reload neither the app nor the session.
Thanks !
#inputCreation.R
test <- "IamDatasetNumber1"
data <- c(1, 3, 6, 4, 9)
save(test, data, file = "./Test/DatasetNumber1.Rdata")
test <- "IamDatasetNumber2"
data <- c(2, 7, 9, 12, 13)
save(test, data, file = "./Test/DatasetNumber2.Rdata")
#global.R
library(shiny)
library(shinyjs)
library(shinyalert)
load("DatasetNumber1.Rdata")
#ui.R
shinyUI(
fluidPage(
useShinyjs(),
div(
id = "main_page",
fluidRow( # -------------------------------------------------------
column(
2, offset=0,
selectInput("dropdown_dataset", "Dataset :", choices=c("DatasetNumber1", "DatasetNumber2"), selected="DatasetNumber1")
),
column(
1, offset=0,
useShinyalert(),
actionButton("button_dataset", "Load"),
)
),
fluidRow( # -------------------------------------------------------
uiOutput("test_text")
),
fluidRow( # -------------------------------------------------------
plotOutput("test_plot")
)
)
)
)
#server.R
shinyServer(
function(input, output, session) {
observeEvent(input$button_dataset, {
shinyalert(title = "Are you sure?",
text = "This action can take a while",
type = "warning",
closeOnEsc = TRUE,
closeOnClickOutside = TRUE,
showCancelButton = TRUE,
showConfirmButton = TRUE,
confirmButtonText = "OK",
confirmButtonCol = "#AEDEF4",
cancelButtonText = "Cancel",
inputId = "shinyalert",
callbackR = function(x){
if(x){
showModal(modalDialog("Loading...", footer=NULL))
print(paste(input[["dropdown_dataset"]],sep=""))
load(paste(input[["dropdown_dataset"]],".Rdata",sep=""))
removeModal()
}
}
)
})
output$test_text <- renderText(test)
output$test_plot <- renderPlot(plot(data))
}
)
I changed the initialization of react_data. You should get rid of the load from your global file. This way the dataset can be garbage collected when you switch. Otherwise, it will exist in .GlobalEnv forever.
Try this server:
shinyServer(
function(input, output, session) {
react_data <- reactiveVal()
react_data(local({load("DatasetNumber1.Rdata"); data}))
observeEvent(
input$shinyalert,
{
req(input$shinyalert)
load(paste(input$dropdown_dataset,".Rdata",sep=""))
react_data(data)
})
observeEvent(input$button_dataset, {
shinyalert(title = "Are you sure?",
text = "This action can take a while",
type = "warning",
closeOnEsc = TRUE,
closeOnClickOutside = TRUE,
showCancelButton = TRUE,
showConfirmButton = TRUE,
confirmButtonText = "OK",
confirmButtonCol = "#AEDEF4",
cancelButtonText = "Cancel",
inputId = "shinyalert",
callbackR = function(x){
if(x){
showModal(modalDialog("Loading...", footer=NULL))
print(paste(input[["dropdown_dataset"]],sep=""))
removeModal()
}
}
)
})
output$test_text <- renderText(test)
output$test_plot <- renderPlot(plot(react_data()))
}
)
With #Tyler's help !
#server.R
shinyServer(
function(input, output, session) {
react <- reactiveVal()
react(local({load("DatasetNumber1.Rdata"); list(test=test,data=data)}))
observeEvent(
input$shinyalert,
{
req(input$shinyalert)
load(paste(input$dropdown_dataset,".Rdata",sep=""))
react(list(test=test,data=data))
})
observeEvent(input$button_dataset, {
shinyalert(title = "Are you sure?",
text = "This action can take a while",
type = "warning",
closeOnEsc = TRUE,
closeOnClickOutside = TRUE,
showCancelButton = TRUE,
showConfirmButton = TRUE,
confirmButtonText = "OK",
confirmButtonCol = "#AEDEF4",
cancelButtonText = "Cancel",
inputId = "shinyalert",
callbackR = function(x){
if(x){
showModal(modalDialog("Loading...", footer=NULL))
print(paste(input[["dropdown_dataset"]],sep=""))
removeModal()
}
}
)
})
output$test_text <- renderText(react()$test)
output$test_plot <- renderPlot(plot(react()$data))
}
)
What I am attempting to do, is to allow the user to pass in a configuration/lookup excel table into shiny, display this table in shiny, allow the user to make cells edits in shiny, and use the values that were edited from the editable table for calculations. My problem arises for the last step "use the values that were edited from the editable table for calculations".
The excel file consists of 2 tabs with data of the following content:
Tab1 Name: "parameters"
data.frame(Name = c("a", "b", "c"), Value = c(1:3))
Tab2 Name: "parameters2"
data.frame(Name = c("a", "b", "c"), Value = c(4:6))
The ideal shiny app would do the following:
1) At upload, perform a calculation adding the unchanged first values of Tab 1 and Tab 2. This would be 1 + 4 = 5.
2) If user edits Tab 1's value of 1 to 8, then the calculation would result in 8 + 4 = 12.
Effectively, I want to use the edited tables values to update all my calculations if the user makes any edits to it. I know this can be done by simply uploading a new file in shiny, but I would rather allow them to do this in shiny as opposed to uploading a new file.
Here is my shiny app. Appreciate any help/guidance!
library(shiny)
library(DT)
shinyApp(
ui <- fluidPage(
fileInput(inputId = "config", label = "Upload Configuration File",
multiple = F, accept = c(".xlsx", ".xls")),
verbatimTextOutput("txt"),
tagList(tags$head(tags$style(type = 'text/css','.navbar-brand{display:none;}')),
navbarPage(title = "",
tabPanel(title = "Parameters",
dataTableOutput(outputId = "edit.param", width = 2)),
tabPanel(title = "Parameters2",
dataTableOutput(outputId = "edit.param2", width = 2))
)
)
),
server = function(input, output, session) {
config.path = reactive({
inFile = input$config
if(is.null(inFile)) {
return(NULL)
} else {
return(inFile$datapath)
}
})
df.param = reactive({
read_excel(path = config.path(), sheet = "parameters")
})
df.param2 = reactive({
read_excel(path = config.path(), sheet = "parameters2")
})
output$edit.param = renderDT(df.param(), selection = "none", server = F, editable = "cell")
output$edit.param2 = renderDT(df.param2(), selection = "none", server = F, editable = "cell")
observeEvent(input$edit.param_cell_edit, {
df.param()[input$edit.param_cell_edit$row, input$edit.param_cell_edit$col] <<- input$edit.param_cell_edit$value
})
observeEvent(input$edit.param2_cell_edit, {
df.param()[input$edit.param2_cell_edit$row, input$edit.param2_cell_edit$col] <<- input$edit.param2_cell_edit$value
})
output$txt = reactive({
df.param()$value[1] + df.param2()$value[1]
})
}
)
I also tried this for the server section and had no luck either:
output$edit.param = renderDT(df.param(), selection = "none", server = F, editable = "cell")
output$edit.param2 = renderDT(df.param2(), selection = "none", server = F, editable = "cell")
observe(input$edit.param_cell_edit)
observe(input$edit.param2_cell_edit)
Could you try this? (I have not tried).
library(shiny)
library(DT)
shinyApp(
ui <- fluidPage(
fileInput(inputId = "config", label = "Upload Configuration File",
multiple = F, accept = c(".xlsx", ".xls")),
verbatimTextOutput("txt"),
tagList(tags$head(tags$style(type = 'text/css','.navbar-brand{display:none;}')),
navbarPage(title = "",
tabPanel(title = "Parameters",
dataTableOutput(outputId = "edit_param", width = 2)),
tabPanel(title = "Parameters2",
dataTableOutput(outputId = "edit_param2", width = 2))
)
)
),
server = function(input, output, session) {
config.path = reactive({
inFile = input$config
if(is.null(inFile)) {
return(NULL)
} else {
return(inFile$datapath)
}
})
df_param <- reactiveVal()
observe({
req(config.path())
df_param(read_excel(path = config.path(), sheet = "parameters"))
})
df_param2 <- reactiveVal()
observe({
req(config.path())
df_param2(read_excel(path = config.path(), sheet = "parameters2"))
})
output$edit_param = renderDT({
req(df_param())
datatable(isolate(df_param()), selection = "none", editable = "cell")
})
output$edit_param2 = renderDT({
req(df_param2())
datatable(isolate(df_param2()), selection = "none", editable = "cell")
})
proxy <- dataTableProxy("edit_param")
proxy2 <- dataTableProxy("edit_param2")
observeEvent(input$edit_param_cell_edit, {
info <- input$edit_param_cell_edit
df_param(editData(df_param(), info, proxy, resetPaging = FALSE))
})
observeEvent(input$edit_param2_cell_edit, {
info <- input$edit_param2_cell_edit
df_param2(editData(df_param2(), info, proxy2, resetPaging = FALSE))
})
output$txt = renderPrint({
df_param()$value[1] + df_param2()$value[1]
})
}
)
My original data of mtcar gets downloaded using Download Handlers in ShinyApp whereas i want the the modified data (using SelectInputs) to be downloaded through Handlers.
I have attached my codes as well, please let me know whats wrong with them. Many thanks:)
library(shiny)
library(tidyr)
library(dplyr)
library(readr)
library(DT)
data_table <- mtcars
# Define UI
ui <- fluidPage(
downloadButton('downLoadFilter',"Download the filtered data"),
selectInput(inputId = "cyl",
label = "cyl:",
choices = c("All",
unique(as.character(data_table$cyl))),
selected = "4",
multiple = TRUE),
selectInput(inputId = "vs",
label = "vs:",
choices = c("All",
unique(as.character(data_table$vs))),
selected = "1",
multiple = TRUE),
DT::dataTableOutput('ex1'))
server <- function(input, output) {
thedata <- reactive({
if(input$cyl != 'All'){
return(data_table[data_table$cyl == input$cyl,])
}
else if(input$vs != 'All'){
return(data_table[data_table$vs == input$vs,])
}
else{
return(data_table)
}
})
output$ex1 <- DT::renderDataTable(DT::datatable(filter = 'top',
escape = FALSE,
options = list(pageLength =
10, scrollX='500px',autoWidth = TRUE),{
thedata() # Call reactive
thedata()
}))
output$downLoadFilter <- downloadHandler(
filename = function() {
paste('Filtered data-', Sys.Date(), '.csv', sep = '')
},
content = function(path){
write_csv(thedata(),path) # Call reactive thedata()
})}
shinyApp(ui = ui, server = server)
You are updating thedata() only inside your renderDataTable. You need to make it a reactive and then use it for being rendered as DataTable and being downloaded.
Change your server to:
# Define server logic
server <- function(input, output) {
thedata <- reactive({
if(input$cyl != 'All'){
return(data_table[data_table$cyl == input$cyl,])
}
else{
return(data_table)
}
})
output$ex1 <- DT::renderDataTable(DT::datatable(filter = 'top',
escape = FALSE,
options = list(pageLength = 10, scrollX='500px',autoWidth = TRUE),{
thedata() # Call reactive thedata()
}))
output$downLoadFilter <- downloadHandler(
filename = function() {
paste('Filtered data-', Sys.Date(), '.csv', sep = '')
},
content = function(path){
write_csv(thedata(),path) # Call reactive thedata()
})}