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))
}
)
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)
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)
})
}
)
I need to pass filtration from configuration file to datatable. When the table is rendered the user must be able to clean the filtration and see the full content of the table
The problem arises when the filtration is applied to factor columns. In this case the content of the table is rendered but is not shown in the table. It is necessary click additionally on the filter and choose another value. But it still works fine with character columns. How one may fix it?
There is an example which reproduce my problem.
library(shiny)
library(DT)
ui <- fluidPage(
fluidRow(
selectInput(inputId = "table_fltration",
label = 'Choose table filtration',
choices = c("Working example",
"Not working example"),
selected = "Working example"),
actionButton(inputId = 'update_btn', label = "Use config")),
fluidRow(dataTableOutput("iris_table"))
)
server <- function(input, output, session) {
columns_search <- reactive({
if (input$table_fltration == "Working example") {
ex <- c("7.2 ... 7.9", "", "", "", "", "[\"anything\"]")
} else {
ex <- c("", "", "", "", "[\"anything\"]", "")
}
columns_search <- list()
for ( i in 1:length(ex)) {
if(ex[i] != "") {
element = list(list(search = ex[i]))
} else {element = NULL}
columns_search[i] <- element
}
columns_search
})
iris_table_ex <- reactive({
iris$Species_2 = as.character(iris$Species)
iris
})
observeEvent(input$update_btn,
output$iris_table <- DT::renderDataTable({
DT::datatable(iris_table_ex(),
filter = list(position = 'top'),
class = 'hover',
rownames = FALSE,
options = list(orderClasses = TRUE,
stateSave = FALSE,
searchHighlight = TRUE,
searchCols = columns_search(),
scrollX = TRUE,
paging = TRUE,
pageLength = 10))
})
)
}
shinyApp(ui, server)
I am looking for suggestions in improving performance of my shiny app. This shiny app saves data in CSV format when user selects a particular row by clicking on check box. I don't want it to save data every time when user clicks on check box. Hence I created action button so that user clicks on button only when he is done with the checkbox selection of multiple rows.
library(shiny)
library(DT)
mydata = mtcars
mydata$id = 1:nrow(mydata)
runApp(
list(ui = pageWithSidebar(
headerPanel('Examples of Table'),
sidebarPanel(
textInput("collection_txt",label="RowIndex")
,br(),
actionButton("run", "Write Data"),
br(),
p("Writeback with every user input. CSV file gets saved on your working directory!")),
mainPanel(
DT::dataTableOutput("mytable")
))
, server = function(input, output, session) {
shinyInput <- function(FUN,id,num,...) {
inputs <- character(num)
for (i in seq_len(num)) {
inputs[i] <- as.character(FUN(paste0(id,i),label=NULL,...))
}
inputs
}
rowSelect <- reactive({
rows=names(input)[grepl(pattern = "srows_",names(input))]
paste(unlist(lapply(rows,function(i){
if(input[[i]]==T){
return(substr(i,gregexpr(pattern = "_",i)[[1]]+1,nchar(i)))
}
})))
})
observe({
updateTextInput(session, "collection_txt", value = rowSelect() ,label = "RowIndex:" )
d = data.frame(n = rowSelect(), stringsAsFactors = F)
if (input$run == 0)
return()
isolate({write.csv(mydata[as.numeric(d$n),], file = "Writeback.csv" , row.names=F)})
})
output$mytable = DT::renderDataTable({
DT::datatable(cbind(Flag=shinyInput(checkboxInput,"srows_",nrow(mydata),value=NULL,width=1),
mydata), extensions = 'Buttons', options = list(orderClasses = TRUE,
pageLength = 5, lengthChange = FALSE, dom = 'Bfrtip',
buttons = c('copy', 'csv', 'excel'),
drawCallback= JS(
'function(settings) {
Shiny.bindAll(this.api().table().node());}')
),escape=F)
}
)
}), launch.browser = T
)
I want action button to write data in CSV format only when user clicks on action button. Is there any way to improve the code below.
d = data.frame(n = rowSelect(), stringsAsFactors = F)
if (input$run == 0)
return()
isolate({write.csv(mydata[as.numeric(d$n),], file = "Writeback.csv" , row.names=F)})
Why are you not using observeEvent for the actionButton?
observeEvent(input$run, {
updateTextInput(session, "collection_txt", value = rowSelect() ,label = "RowIndex:" )
d = data.frame(n = rowSelect(), stringsAsFactors = F)
write.csv(mydata[as.numeric(d$n),], file = "Writeback.csv" , row.names=F)
})
I think you're looking for the require function req(input$run) or try if(is.null(input$run)==T){return()}
Hello I'm building a shinydashboard using several excel files.
I inserted links to these files in the footer of the box and I want to refresh the shinydashboard when changing something in my excel file.
I don't want to run the whole R code each time.
How can I re-render the Output once the file content changes?
Here an example:
sidebar <- dashboardSidebar(
sidebarMenu( menuItem("Hello", tabName = "Hello", icon = icon("dashboard"))
))
body <- dashboardBody(
tabItems(
tabItem(tabName = "Hello",
box(title = "my file",
footer = a("df.xlsx", href="df.xlsx" ) ,
DT::dataTableOutput("df1"),style = "font-size: 100%; overflow: auto;",
width = 12, hight = NULL, solidHeader = TRUE, collapsible = TRUE, collapsed = TRUE, status = "primary")
)))
ui <- dashboardPage(
dashboardHeader(title = "My Dashboard"),
sidebar,
body)
server <- function(input, output) {
output$df1 <- renderDataTable({
df <- read_excel("df.xlsx")
DT::datatable(df, escape = FALSE, rownames=FALSE,class = "cell-border",
options =list(bSort = FALSE, paging = FALSE, info = FALSE)
)
})
}
shinyApp(ui, server)
To monitor the change in a file you could use the cheksum of the file like this:
library(shiny)
library(digest)
# Create data to read
write.csv(file="~/iris.csv",iris)
shinyApp(ui=shinyUI(
fluidPage(
sidebarLayout(
sidebarPanel(
textInput("path","Enter path: "),
actionButton("readFile","Read File"),
tags$hr()
),
mainPanel(
tableOutput('contents')
)))
),
server = shinyServer(function(input,output,session){
file <- reactiveValues(path=NULL,md5=NULL,rendered=FALSE)
# Read file once button is pressed
observeEvent(input$readFile,{
if ( !file.exists(input$path) ){
print("No such file")
return(NULL)
}
tryCatch({
read.csv(input$path)
file$path <- input$path
file$md5 <- digest(file$path,algo="md5",file=TRUE)
file$rendered <- FALSE
},
error = function(e) print(paste0('Error: ',e)) )
})
observe({
invalidateLater(1000,session)
print('check')
if (is.null(file$path)) return(NULL)
f <- read.csv(file$path)
# Calculate ckeksum
md5 <- digest(file$path,algo="md5",file=TRUE)
# If no change in cheksum, do nothing
if (file$md5 == md5 && file$rendered == TRUE) return(NULL)
output$contents <- renderTable({
print('render')
file$rendered <- TRUE
f
})
})
}))
If I understand the question correctly, I'd say you need the reactiveFileReader function.
Description from the function's reference page:
Given a file path and read function, returns a reactive data source
for the contents of the file.
The file reader will poll the file for changes, and once a change is detected the UI gets updated reactively.
Using the gallery example as a guide, I updated the server function in your example to the following:
server <- function(input, output) {
fileReaderData <- reactiveFileReader(500,filePath="df.xlsx", readFunc=read_excel)
output$df1 <- renderDataTable({
DT::datatable(fileReaderData(), escape = FALSE, rownames=FALSE,class = "cell-border",
options =list(bSort = FALSE, paging = FALSE, info = FALSE)
)
})
}
With that, any changes I saved to 'df.xlsx' were propagated almost instantly to the UI.