Shiny experts!
In our application we have download button for plot downloading. The button is working only when some data are loaded and processed. When you push the button before, there is an error message from plotting function, because it has no data.
content = function(file) {
r <- rChart_line_plot(follow_view_func(),log_scale = input$checkbox_log_scale_plot,isRel = input$checkboxRelativeTab2)
r$save(file, standalone = TRUE)
}
We want to make our app foolproof and error-free. Is there any possible way to send to downloadHandler's content "NULL"? This don't work.
content = function(file) {
if ( "our data are ready for printing" ) {
r <- rChart_line_plot(follow_view_func(),log_scale = input$checkbox_log_scale_plot,isRel = input$checkboxRelativeTab2)
r$save(file, standalone = TRUE)
} else {
NULL
}
}
And we're getting:
Error opening file: 2
Error reading: 9
Is there something like validate() function with even information for user "Please load file first"
Thank You a lot.
You are correct that you want a validate statement. Here is a link with descriptions from the RStudio team. This will allow you to have a more informative error message. Your complete downloadHandler function would look something like the following. Note that this assumes your dataset could be null.
output$Download <- downloadHandler(
filename = function() {
paste("test.png",sep="")
},
content = function(file) {
myData <- follow_view_func()
validate(
need(!is.null(myData), "Please select valid dataset")
)
r <- rChart_line_plot(myData,log_scale = input$checkbox_log_scale_plot,isRel = input$checkboxRelativeTab2)
r$save(file, standalone = TRUE)
}
)
Here is a complete reproducible example with the iris dataset.
library(shiny)
library(rCharts)
runApp(
list(
ui = pageWithSidebar(
headerPanel("Using 'validate' for useful error messages"),
sidebarPanel(
selectInput("dataset", "Choose a dataset:",
choices = c("null", "iris")),
selectInput(inputId = "x",
label = "Choose X",
choices = c('SepalLength', 'SepalWidth', 'PetalLength', 'PetalWidth'),
selected = "SepalLength"),
selectInput(inputId = "y",
label = "Choose Y",
choices = c('SepalLength', 'SepalWidth', 'PetalLength', 'PetalWidth'),
selected = "SepalWidth"),
downloadButton("Download")
),
mainPanel(
showOutput("myChart", "polycharts")
)
),
server = function(input, output) {
datasetInput <- reactive({
switch(input$dataset,
"iris" = iris,
"null" = NULL)
})
myChart <- reactive({
myData <- datasetInput()
validate(
need(!is.null(myData), "Please select valid dataset")
)
names(myData) = gsub("\\.", "", names(myData))
p1 <- rPlot(input$x, input$y, data = myData, color = "Species",
facet = "Species", type = 'point')
p1$addParams(dom = 'myChart')
return(p1)
})
output$myChart <- renderChart({myChart()})
output$Download <- downloadHandler(
filename = function() {
paste("test.png",sep="")
},
content = function(file) {
p1 <- myChart()
p1$save(file, standalone = TRUE)
}
)
}
)
)
UPDATE
As per the OP request, it may be ideal to have no error whatsoever with the download button. The only solution I could come up with is to make the button a conditionalPanel. This intuitively makes sense to me because why would you download if there is nothing on the screen? The only change in the code above needed for this is to change:
downloadButton("Download")
to
conditionalPanel("output.myChart", downloadButton("Download"))
Now the download button will only be present when a valid chart is created.
Related
In running the below "abbreviated code", I'm trying to create a file upload validation that the csv to be uploaded must have "Scenario 1" and "Scenario 1" in cells A1 and B1 of the csv. Otherwise the file isn't uploaded and it is flagged "invalid". Any ideas of how to do this?
If you run the below, click the single action button and save the matrix inputs by clicking the button in the bottom of the modal dialog, look at the downloaded csv, and see how cells A1 and B1 show "Scenario 1" and "Scenario 1" from the downloaded matrix. This is good. If you delete these, and save the csv, you'll see that this modified csv can still be uploaded when running the App. I'd like those 2 csv fields to serve as a validation flag.
I really like the try() function as a catch-all test in this App.
Abbreviated code:
library(dplyr)
library(shiny)
library(shinyFeedback)
library(shinyMatrix)
sumMat <- function(x){return(rep(sum(x,na.rm = TRUE), 10))}
ui <- fluidPage(
useShinyFeedback(),
sidebarLayout(
sidebarPanel(
actionButton("matrix3show","Click for matrix input"),
),
mainPanel(plotOutput("plot"))
)
)
server <- function(input, output, session) {
uploadMat3Data <- reactive({
req(input$uploadMat3)
validate(need(identical(tools::file_ext(input$uploadMat3$datapath),"csv"),"Invalid"))
try(read.csv(input$uploadMat3$datapath, header = TRUE))
})
observeEvent(uploadMat3Data(), {
if(is.data.frame(uploadMat3Data())){
updateMatrixInput(session,"matrix3",as.matrix(uploadMat3Data()))
hideFeedback("file")
}
else {showFeedbackWarning("file", "Invalid")}
})
observeEvent(input$matrix3show,{
showModal(
modalDialog(
fileInput(inputId = "uploadMat3",label = NULL,accept = ".csv"),
matrixInput(
inputId = "matrix3",
value = if(is.null(input$matrix3)){matrix(c(1,5),ncol=2,dimnames=list(NULL,rep("Scenario 1",2)))}
else {input$matrix3},
rows = list(extend = TRUE, delete = TRUE),
cols = list(extend = TRUE, delta = 2, delete = TRUE, multiheader = TRUE),
class = "numeric"),
output$verbMat3 <- renderPrint(class(uploadMat3Data())),
footer =
tagList(
downloadButton("saveMat3","Save",style = "width:80px;"),
modalButton("Exit box")
) # close tag list
))
})
observeEvent(input$matrix3, {
tmpMat3 <- input$matrix3
colnames(tmpMat3) <- paste("Scenario",rep(1:ncol(tmpMat3),each=2,length.out=ncol(tmpMat3)))
rownames(tmpMat3) <- paste("Row", seq_len(nrow(input$matrix3)))
updateMatrixInput(session,inputId="matrix3",value=tmpMat3)
})
data <- function(){tibble(X = seq_len(10),Y = sumMat(input$matrix3))}
output$plot<-renderPlot({plot(data(),type="l")})
output$saveMat3 <- downloadHandler(
filename = function(){paste("Inputs","csv",sep=".")},
content = function(file){write.csv(input$matrix3, file,row.names=FALSE)}
)
}
shinyApp(ui, server)
To resolve I changed the observeEvent for uploadMat3Data() to the following:
observeEvent(uploadMat3Data(), {
if(is.data.frame(uploadMat3Data())
&& colnames(uploadMat3Data()[1]) == "Scenario.1"
&& colnames(uploadMat3Data()[2]) == "Scenario.1.1"
){
updateMatrixInput(session,"matrix3",as.matrix(uploadMat3Data()))
hideFeedback("uploadMat3")
}
else {showFeedbackWarning("uploadMat3", "Invalid")}
})
Note the additions of && colnames(... where the code peeks into the headers for the uploaded data frame and checks for the required headers. Also note that in the original code the id references in hideFeedback() and showFeedbackWarning() were incorrect; they are now corrected to "uploadMat3"
I am using a downloadHandler in a shiny app which let's me download 4 reactive dataframes that has been created. I want to include a functionality if either one of the dataframes has not been created then that will be printed in renderPrint/renderText saying one of the dataframes is missing. A minimal example from the server code is given below but it does not work the way I want it to.
output$dl <-
if((df1()!= '') || (df2()!='') || (df3()!= '') || (df4()!= '') ){
downloadHandler(
filename = "New_Data.xlsx",
content = function(file){
write_xlsx(list("S1" = df1(), "S2" = df2(), "S3" = df3(), "S4" = df4()), path = file)
}else{
output$dl_error <- renderPrint({'One of the dataframes is missing'})
}
)
or something like this
data_list <- reactive({
list("S1" = df1(),
"S2" = df2(),
"S3" = df3(),
"S4" = df4())
})
output$dl <- reactive({
if(length(data_list()==4)){
downloadHandler(
filename = "New_Data.xlsx",
content = function(file){
write_xlsx(data_list(), path = file)
}
)
}else{
output$dl_error <- renderPrint({'One of the dataframes is missing'})
}
})
It will be great if someone can help me out with this. Also, it would be better if the error message in the renderPrint/renderText shows which dataframe is missing.
As said in my comment, you could disable the button. You can use the shinyjs package to do that easily. Another option is to hide the download button with a conditionalPanel. Here is a third option. I hide the download button with a conditionalPanel and instead I display a "fake" download button. When the dataframe is available, the fake data button is hidden and the true download button becomes visible. If the user clicks on the fake download button, he is told that the dataframe is not available with an alert.
library(shiny)
library(shinyalert)
library(writexl)
ui <- fluidPage(
useShinyalert(),
br(),
conditionalPanel(
condition = "!output.ok",
actionButton("fake", "Download", icon = icon("save"))
),
conditionalPanel(
condition = "output.ok",
style = "display: none;",
downloadButton("dwnld", "Download", icon = icon("save"))
),
br(),
actionButton("databtn", "Generate dataframe")
)
server <- function(input, output, session){
observeEvent(input[["fake"]], {
shinyalert(
title = "Error!",
text = "The dataframe is not ready yet",
type = "error"
)
})
df <- reactiveVal(NULL)
observeEvent(input[["databtn"]], {
df(iris)
})
output[["ok"]] <- reactive({
!is.null(df())
})
outputOptions(output, "ok", suspendWhenHidden = FALSE)
output[["dwnld"]] <- downloadHandler(
filename = "iris.xlsx",
content = function(file){
write_xlsx(list(iris = df()), path = file)
}
)
}
shinyApp(ui, server)
I'm relatively new to using R and shiny. Currently, I'm getting the Error: Conflict (HTTP 409) when trying to access an html file from dropbox and this is fine, I know the reason. What I do have a problem with is trying to find a way to change Error code message.
I've tried a couple forms of validation and try-catches.
library(shiny)
library(rdrop2)
library(httr)
ui <- # Define UI for dataset viewer application
shinyUI(pageWithSidebar(
headerPanel("Test DropBox html Docs to Shiny"),
sidebarPanel(
selectInput("Cat", "Choose a Category:",
choices = c("A", "B", "C")),
selectInput("Year", "Choose a Year:",
choices = c("2012", "2011")),
downloadButton("downFile", "Download File"),
width = 2),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Html Pages", htmlOutput("viewReport"))),
width = 10)
)
)
#IMPORTANT: The two lines below needs to be run just one time unless the token is deleted
# Create Token
token <- drop_auth()
# Save token
saveRDS(token, "droptoken.rds")
token <- readRDS("droptoken.rds")
server <- shinyServer(function(input, output) {
# ---------------------------------------------------
filePutReport <- reactive(
paste(input$Cat, "_", input$Year, "_Doc.html", sep = "")
)
filePutReport2 <- reactive({
# Search if the file exists in DropBox
drop_download(path = paste("shiny_docs/shinydbtest/", filePutReport(), sep = ""),
overwrite = TRUE, local_path = "./www",
dtoken = token)
filePutReport()
})
# Show Html Pages
output$viewReport <- renderUI({
tags$iframe(seamless = "seamless", width = "1400", height = "1000",
src = filePutReport2()
)
})
###
output$downFile <- downloadHandler(
# generate bins based on input$bins from ui.R
filename = function() {
paste0(filePutReport() )
},
content = function(file){
file.copy(from = paste0("./www/", filePutReport2() ), to = file, overwrite = TRUE)
}
)
})
shinyApp(ui = ui, server = server)
Instead of simply "Error: Conflict (HTTP 409)", I would a message a client might be able to understand. Any and all suggestions are welcome. Thank you in advance for your help.
In my current environment I cannot establish a connection to dropbox, but please try the approach below. I first deleted the last line refering to filePutReport() in your filePutReport2() reactive, since they are the same and you want your call to drop_download to produce either a value (TRUE) or an invisible object of class "try-error". Therefore, you need to further wrap your call to drop_download in a try statement. This way filePutReport2() either contains the value TRUE or an invisible object of class "try-error". Then you should be able to use a need/validate function in your renderUI statement including a custom error message. I hope it's working, since I can't test it.
library(shiny)
library(rdrop2)
library(httr)
ui <- # Define UI for dataset viewer application
shinyUI(pageWithSidebar(
headerPanel("Test DropBox html Docs to Shiny"),
sidebarPanel(
selectInput("Cat", "Choose a Category:",
choices = c("A", "B", "C")),
selectInput("Year", "Choose a Year:",
choices = c("2012", "2011")),
downloadButton("downFile", "Download File"),
width = 2),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Html Pages", htmlOutput("viewReport"))),
width = 10)
)
)
#IMPORTANT: The two lines below needs to be run just one time unless the token is deleted
# Create Token
token <- drop_auth()
# Save token
saveRDS(token, "droptoken.rds")
token <- readRDS("droptoken.rds")
server <- shinyServer(function(input, output) {
# ---------------------------------------------------
filePutReport <- reactive(
paste(input$Cat, "_", input$Year, "_Doc.html", sep = "")
)
filePutReport2 <- reactive({
# Search if the file exists in DropBox
try({
drop_download(path = paste("shiny_docs/shinydbtest/", filePutReport(), sep = ""),
overwrite = TRUE, local_path = "./www",
dtoken = token)
}, silent = TRUE)
})
# Show Html Pages
output$viewReport <- renderUI({
validate(
need(filePutReport2(), 'Custom error message!'))
tags$iframe(seamless = "seamless", width = "1400", height = "1000",
src = filePutReport()
)
})
###
output$downFile <- downloadHandler(
# generate bins based on input$bins from ui.R
filename = function() {
paste0(filePutReport() )
},
content = function(file){
file.copy(from = paste0("./www/", filePutReport2() ), to = file, overwrite = TRUE)
}
)
})
shinyApp(ui = ui, server = server)
There are existing data.frames that are called: active_acc_newacc, active_acc_oldacc, inactive_acc_newacc, inactive_acc_oldacc. They all contain a lot of rows and columns. I created a code with Shiny, where the user chooses with a radio button if they want to download active or inactive and old, or new. When they click on Download, a csv file needs to be downloaded. The csv should be the content of the dataframe, for example the user chooses Active and new, then the dataframe called active_acc_newacc should be downloaded as a csv, another example is if they chose Inactive and old, then the dataframe called inactive_acc_oldaccdataframe should be downloaded as csv.
In this example, active_acc_newacc contains this sample data:
structure(list(Alpha = c(0.192491906485068, -1.44670180633351,
-0.323180534047634, 1.62229611652493, -0.689024123596357, 2.04212222261495,
0.94377911190294, 2.0819268787991, 1.91711727878331, -0.414812239592928
), Beta = c(1.03285349943413, -1.67856959219527, 0.157549690345431,
1.48913611644558, -0.0757895625491196, 1.27178094415894, 0.641673407672177,
0.800761254937157, 1.86265922566283, -0.545356026768875), Gamma = c(1.52068837343838,
-3.61004798325456, -1.35857038834863, 3.48938862108709, -3.05109504225968,
6.5047022366346, 2.50727319977214, 5.31673927920108, 3.69096202696173,
-1.03802874828505)), row.names = c(NA, -10L), class = "data.frame")
I have the following in the ui.R, requesting input:
ui = fluidPage(
titlePanel("Account classification"),
sidebarLayout(
sidebarPanel(
radioButtons("account_status","Select account status", choices=c("Active","Inactive","Include both"),selected = "Active"),
br(),
radioButtons("account_age","Select account creation time", choices=c("old","new","Created any time"),selected = "new")
),
mainPanel(
downloadButton('downloadData', 'Download')
)
)
)
I created the following server.R
server = function(input, output) {
datasetInput <- reactive({
switch(input$account_status,
"Active" = active_acc,
"Inactive" = inactive_acc,
"Include both" = NULL)
switch(input$account_age,
"old" = oldacc,
"new" = newacc,
"Created any time" = all)
})
dfname <- reactive({
paste(input$account_status,input$account_age, sep='_')
})
output$downloadData <- downloadHandler(
filename = function() { paste(input$dataset, '.csv', sep='') },
content = function(file) {
write.csv(dfname(), file)
}
)
}
shinyApp(ui, server)
Unfortunately, it does not work, when I hit the "download" button, it downloads a csv that contains this (in case of inactive and old are selected) :
"","x"
"1","Inactive_old”
So only the text is written out.
I modified the code and sometimes what Download does is downloading the ui.R radio button page as an html.
How shall I write the codes in order to get a successful csv download?
How about this:
Activeacc_newacc <- structure(list(Alpha = c(0.192491906485068, -1.44670180633351,
-0.323180534047634, 1.62229611652493, -0.689024123596357, 2.04212222261495,
0.94377911190294, 2.0819268787991, 1.91711727878331, -0.414812239592928
), Beta = c(1.03285349943413, -1.67856959219527, 0.157549690345431,
1.48913611644558, -0.0757895625491196, 1.27178094415894, 0.641673407672177,
0.800761254937157, 1.86265922566283, -0.545356026768875), Gamma = c(1.52068837343838,
-3.61004798325456, -1.35857038834863, 3.48938862108709, -3.05109504225968,
6.5047022366346, 2.50727319977214, 5.31673927920108, 3.69096202696173,
-1.03802874828505)), row.names = c(NA, -10L), class = "data.frame")
ui = fluidPage(
titlePanel("Account classification"),
sidebarLayout(
sidebarPanel(
radioButtons("account_status","Select account status", choices=c("Active","Inactive","Include both"),selected = "Active"),
br(),
radioButtons("account_age","Select account creation time", choices=c("old","new","Created any time"),selected = "new")
),
mainPanel(
downloadButton('downloadData', 'Download')
)
)
)
server = function(input, output) {
datasetInput <- reactive({
switch(input$account_status,
"Active" = active_acc,
"Inactive" = inactive_acc,
"Include both" = NULL)
switch(input$account_age,
"old" = oldacc,
"new" = newacc,
"Created any time" = all)
})
dfname <- reactive({
test <- paste0(input$account_status, "acc_", input$account_age, "acc", sep='')
get(test)
})
output$downloadData <- downloadHandler(
filename = function() { paste(input$dataset, '.csv', sep='') },
content = function(file) {
write.csv(dfname(), file)
}
)
}
shinyApp(ui, server)
I recently updated R and shiny.
The problem I am having is translating Shiny code into shiny modules. I thought the RStudio guide was very good, but I seem to be missing something fundamental. I would love any direct guidance on the project I am working on. I would also love recommended principles for how to convert from Shiny code to modularized code, particularly hints missing from the RStudio article
My goal in the shiny app below (which is part of a larger project) is to create an app that allows someone to load a .csv file, transform that file into a dissimilarity matrix, and download the matrix.
I have code that works in Shiny, but I haven't been able to convert it into a modularized version.
Note: Because I couldn't figure out how to add a separate .csv file for people to use when evaluating this code, and I wanted to make sure I included sample code, I tossed in sample data and commented out the code that would have allowed people to select an external .csv file. I hope that doesn't mess things up too much.
library(dplyr)
library(cluster)
library(shiny)
bin <- sample(letters[1:10], 50, replace = TRUE) %>% as.factor()
df <- matrix(bin, ncol = 5) %>% as.data.frame()
# User Input Function
cardsortInput <- function(id) {
ns <- NS(id)
tagList(
fileInput(
inputId = "datafile",
label = "Card Sort Results (.csv)",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
checkboxInput(inputId = "header",
label = "Header",
value = TRUE),
checkboxInput(inputId = "strings",
label = "Strings as Factors",
value = TRUE),
selectInput(inputId = "dmetric",
label = "Distance Metric",
choices = c("Euclidean" = "euclidean",
"Manhattan" = "manhattan",
"Gower" = "gower"),
selected = "gower"),
checkboxInput(inputId = "standard",
label = "Data Standardization",
value = FALSE),
downloadButton('downloadData', 'Download Dissimilarity Matrix'),
br(),
br(),
tabsetPanel(
tabPanel(
"Card Sort Data",
tableOutput(
outputId = "cs_table")
),
tabPanel(
"Dissimilarity Matrix",
tableOutput(
outputId = "cs_dissMatrix")
)
)
)
}
# Server Function
cardsort <- function(input, output, session) {
userFile <- reactive({
validate(need(input$datafile, message = FALSE))
input$datafile
})
#dataframe <- reactive({
# read.csv(
# file = userFile()$data.path,
# header = input$header,
#stringsAsFactors = TRUE)
#})
dataframe <- reactive({df
})
diss_matrix <- reactive({
data <- dataframe()
if (is.null(data))
return(NULL)
daisy(
x = data,
metric = input$dmetric,
stand = input$standard) %>%
as.matrix()
})
output$dissMatrix <- renderTable({
diss_matrix()
})
output$downloadData <- downloadHandler(
filename = function() {paste("data-",
Sys.Date(),
".csv", sep="")
},
content = function(file) {
write.csv(diss_matrix(),
file,
row.names = FALSE)
}
)
}
#########
ui <- fluidPage(
cardsortInput("test")
)
server <- function(input, output, session) {
datafile <- callModule(cardsort, "test")
}
shinyApp(ui = ui, server = server)