I have the shiny app below which displays a plotly() oblect and a download button to download it. While png and jpeg are downloaded normally there seems to be an issue when I try to download the svg file.
library(shiny)
library(plotly)
library(webshot)
ui <- fluidPage(
plotlyOutput("plot"),
uiOutput("down")
)
server <- function(input, output) {
# renderPlotly() also understands ggplot2 objects!
save<-reactive({
plot_ly(mtcars, x = ~mpg, y = ~wt)
})
output$plot <- renderPlotly({
save()
})
output$down<-renderUI({
#Download files with quotes or not depending on the quote=input$quotes which has value TRUE or FALSE.
output$downloadData <- downloadHandler(
filename = function() {
paste("test", "svg", sep = ".")
},
# This function should write data to a file given to it by
# the argument 'file'.
content = function(file) {
# Write to a file specified by the 'file' argument
export(save(), file=file)
}
)
downloadButton("downloadData", "Download",class = "butt1")
})
}
shinyApp(ui, server)
I'm not sure why you put the switch in there in the first place, but it looks very out of place to me.
As far as I know, switch is not a plotly- or shiny-function, but just the base-R function. And that function just helps you choose between cases, as a kind of help to prevent you from having to write endless if-else if-else if-...-statements.
It chooses from the 2nd to n-th argument based on the first, something like this:
myvar <- sample(c('one', 'two', 'three'))
counted <- switch(myvar,
one='First',
two='Second',
three='Third',
'Error')
The unnamed argument is there as a fallback, default value. Syntactically it's not wrong to give a default as the only value, but it does defeat the value. Basically, what you've written is sep <- "jpeg", and then moved on, not using sep. You can check it by changing "jpeg" to something else, there is no difference.
In the next step, you're just trying to save your file, which is named correctly.
That causes export to try to save the plot in the format as recognised by the extension. Which can be done automatically for jpegs and pngs, but not for svg.
Some help is written in ?plotly::export, where it tells you it needs something from the RSelenium-package. Which unfortunately I can't help you with, but I think you can find answers by googling more of that package.
But the switch-line is misleading you, it's at least not working the way you are trying to use it.
Related
I am getting crazy with this small reproducible Shiny app:
Basically 3 steps:
I have an input$text which the user can chose
The user triggers an R file create_text.R transforming this text, creating a my_text string. (IRL it is basically a download and data preparation step)
The user triggers the render of an R Markdown where my_text value is printed
My base code looks like:
app.R
library(shiny)
ui <- fluidPage(
selectInput(inputId = "text",
label = "Choose a text",
choices = c("Hello World!", "Good-bye World!")),
actionButton("create_text", "Prepare text"),
downloadButton("report", "Render markdown"))
)
server <- function(input, output) {
observeEvent(input$create_text, {
text_intermediate <- input$text
source('create_text.R')
})
output$report <- downloadHandler(
filename = "report_test.html",
content = function(file) {
rmarkdown::render(input = "report_test.Rmd",
output_file = file)
})
}
shinyApp(ui, server)
create_text.R
my_text <- paste("transfomation //", text_intermediate)
report_test.Rmd
---
title: "My title"
output: html_document
---
```{r}
my_text
```
My problem is the intermediate step (2.), probably because I am confused between environments.
If I run source('create_text.R', local = FALSE), it fails because the R file is run from an empty environment, then does not recognize text_intermediate.
# Warning: Error in paste: object 'text_intermediate' not found
On the opposite way, if I run source('create_text.R', local = TRUE), the created my_text string is not "saved" for the next of the shiny app, then the Rmd cannot be rendered since my_text is not found.
# Warning: Error in eval: object 'my_text' not found
What I have tried:
Two ugly solutions would be:
do not use an intermediate R file and have the whole code inside the app but it will make it very unreadable
or even more ugly, only use hard assigning <-- in the R file, like my_text <<- paste("transfomation //", text_intermediate)
Playing with the env argument of the render() function dit not help neither.
Lastly, starting from scratch I would have used reactive values everywhere, but both my R and Rmd files are very big and "finished", and it would be difficult to adapt the code.
Any help ?
OK, at the end I bypassed the problem with this unelegant solution:
I added a block of code after running the external R script, which stocks all created objects into the global environment. This way, those objects are callable later on in the server function. This allows to go without eventReactive(). Not very pleasant but works.
For this, I use assign within a lapply. In my example, it would be equivalent to write: my_text <<- my_text. The lapply allows to do it for all objects.
observeEvent(input$create_text, {
text_intermediate <- input$text
source('create_text.R')
lapply(X = (ls()), FUN = function(object) {assign(object, get(object), envir = globalenv())})
})
I have a Shiny app that use a fileInput to get some files client-side (I cannot use shinyFiles package that manages files server-side).
I want the user to be only able to upload files matching a specific pattern (e.g. helloWorld.txt) not only matching a file type (e.g. text, csv, etc.).
fileInput has an accept argument where you can provide accepted file types. From the doc:
accept A character vector of MIME types; gives the browser a hint of
what kind of files the server is expecting.
I do not just want to specify accepted file types, which is not restrictive enough for my app. Is there a way to do this?
Here is a MWE to accept only text files:
library(shiny)
ui <- fluidPage(
fileInput(
"file_choice",
label = "Choose a files",
multiple = TRUE,
accept = c(
".txt"
)
)
)
server <- function(input, output, session) {}
shinyApp(ui, server)
If I use:
accept = c(
"helloWorld.txt"
)
It does not work because it is not a MIME type.
This page Shiny fileInput parameter "accept" issue proposes to handle the selected file afterward server-side, which is what I will end up doing, but I would prefer a restriction a priori and not a posteriori (to avoid the server-side file checking and feedback to user).
One method is to interject some javascript as an onchange event trigger that checks the filename and, if it doesn't match, interrupt the upload process. This method uses an alert, I know many consider this method to be a bit invasive and not great aesthetics, I'm sure others can make better suggestions.
I should start with a simple caveat: the conditional here is strictly "the filename begins with the literal hello". Your example might require a little more finesse, instead requiring the filename sans-extension to match. In that case, regular expressions might be in order, reference something like https://developer.mozilla.org/en-US/docs/Web/JavaScript/Guide/Regular_Expressions for more info. What this answer provides is a framework for you to fill in the holes.
(While modifying this code, you might find it useful to add alert(FileName) and/or alert(FileBase) to see what javascript is comparing against your pattern. It will popup with every attempt. In my case here, it helped me discover that, not surprisingly, the windows path was present, meaning it was using backslashes instead of forward-slashes, necessitating the split(/[\\/]/), further escaped for R.)
checkjs <- 'function checkFileName(fieldObj) {
var FileName = fieldObj.value;
var FileBase = FileName.split(/[\\\\/]/).pop();
if (! FileBase.startsWith("hello")) {
fieldObj.value = "";
alert("File does not start with hello");
return false;
}
return true;
}'
attrib_replace <- function(x, cond, ...) {
if (all(names(cond) %in% names(x)) && identical(cond, x[names(cond)])) x <- c(x, list(...))
if ("attribs" %in% names(x)) x$attribs <- attrib_replace(x$attribs, cond = cond, ...)
if ("children" %in% names(x)) x$children <- lapply(x$children, function(ch) attrib_replace(ch, cond = cond, ...))
x
}
A sample app, using this:
library(shiny)
shinyApp(
ui = fluidPage(
tags$script(checkjs),
attrib_replace(fileInput(
"file_choice",
label = "Choose a file",
multiple = TRUE,
accept = c(".txt")
), list(id = "file_choice", type = "file"), onchange = "checkFileName(this);")
),
server = function(input, output, session) {}
)
When you select a file that does not start with "hello", it gives an alert and does not upload the file. A proper file uploads just file.
Some other answers I referenced for this:
How stop file upload event using javascript
Need a basename function in Javascript
I'm trying to create a shiny app that uploads a table, runs a function, and displays a graph and table. The uploading file works fine, but I am unable to run the function and output the graph and table (We shall only focus on the table for now). I am presented with the error:
Warning: Error in read.table: 'file' must be a character string or connection
I have run the function separately in R, and works fine with the desired output. I have tried different read functions, and different separators/delimiters, and read the function in the reactive renderPlot function (as described in a previous post here). Below is a snippet of the code I've been working on:
ui.R:
fileInput("file1",
"Load Input File",
accept = c("text/csv", "text/comma-separated-values,text/plain",".csv")
)
server.R:
execute = observeEvent(input$runButton, {
output$plot1 = renderPlot({
inFile = input$file1
if (is.null(inFile)) {
print(NULL)
}
podr_fun_graphs(inFile$datapath)
})
}
podr_graphs function:
podr_fun_graphs <- function(p) {
df1 <- read.delim(p, sep = "\t")
... # From here there is some data cleaning and manipulation of df1
}
Code similar to this was working a few weeks ago, I made some small changes and it then broke. Would appreciate any help to fix this.
Thanks
the problem is in your if statement. You have written print(NULL). But it should be:
if (is.null(inFile)) {
return(NULL)
}
R will go on to execute podr_fun_graphs(inFile$datapath) if you don't specify return.
I am using Shiny as an interface for viewing tables stored locally in a series of .RData files however I am unable to get the table to render.
My server code is like this:
output$table1 <- renderTable({
load(paste0(input$one,"/",input$two,".RData"))
myData})
On the ui side I am simply displaying the table in the main panel.
This other SO question suggests that the issue is that the environment that the data is loaded into goes away so the data isn't there to display. They suggest creating a global file and loading the .RData file in there, but I don't believe I will be able to load the data dynamically that way. Any guidance on how to use .RData files effectively within shiny would be appreciated.
Regards
I think you just need to move the load statement outside of the renderTable function. So you should have
load(paste0(input$one,"/",input$two,".RData"))
output$table1 <- renderTable({myData})
If you look at the help file for renderTable, the first argument is
expr: An expression that returns an R object that can be used with
xtable.
load does not return this.
I got around this by "tricking" R Shiny. I make a BOGUS textOutput, and in renderText, call a external function that, based in the input selected, sets the already globally loaded environments to a single environment called "e". Note, you MUST manually load all RDatas into environments in global.R first, with this approach. Assuming your data isn't that large, or that you don't have a million RDatas, this seems like a reasonable hack.
By essentially creating a loadEnvFn() like the below that returns a string input passed as input$datasetNumber, you can avoid the scoping issues that occur when you put code in a reactive({}) context. I tried to do a TON of things, but they all required reactive contexts. This way, I could change the objects loaded in e, without having to wrap a reactive({}) scope around my shiny server code.
#Global Environment Pre-loaded before Shiny Server
e = new.env()
dataset1 = new.env()
load("dataset1.RData", env=dataset1)
dataset2 = new.env()
load("dataset2.RData", env=dataset2)
dataset3 = new.env()
load("dataset3.RData", env=dataset3)
ui = fluidPage(
# Application title
titlePanel(title="View Datasets"),
sidebarLayout(
# Sidebar panel
sidebarPanel(width=3, radioButtons(inputId = "datasetNumber", label = "From which dataset do you want to display sample data?", choices = list("Dataset1", "Dataset2", "Dataset3"), selected = "Dataset2")
),
# Main panel
mainPanel(width = 9,
textOutput("dataset"), # Bogus textOutput
textOutput("numInEnv")
)
)
)
loadEnvFn = function(input) {
if (input$datasetNumber=="Dataset1") {
.GlobalEnv$e = dataset1
} else if (input$datasetNumber=="Dataset2") {
.GlobalEnv$e = dataset2
} else {
.GlobalEnv$e = dataset3
}
# Bogus return string unrelated to real purpose of function loadEnvFn
return(input$datasetNumber)
}
server = function(input, output, session) {
output$dataset = renderText(sprintf("Dataset chosen was %s", loadEnvFn(input))) # Bogus output
output$numInEnv = renderText(sprintf("# objects in environment 'e': %d", length(ls(e))))
}
shinyApp(ui, server)
Hope someone can help me with this.
Let's say there is a function "example" which is something like
##function from a package
example<-function(f){
#does something
cat("step 1 done....")
# etc etc
cat("step 2 done....")
return(some_data_frame)
}
##server ui code
example2<-reactive({
if(input$some_action_button==0)
return()
result<-isolate(example(input$f1))
return(result)
})
output$f2<-renderPrint({
example2()
})
Is there some way to capture the "cat" outputs from the function into renderPrint, periodically? Assuming that this is a long function to process and it would be nice for the user to get some feedbabk. invalidateLater does not work for things that are already within a function (at least it seems that way when I tried it here).
Also, as a secondary problem, writing the code in the above manner would cause renderPrint to capture both the "cat" and the data.frame together, possibly because of the "return".
If anyone could point me in the right direction, it would be most helpful! Thanks!
First of, great question I've been thinking a lot about this.
Since shiny is single threaded it's a bit tricky capturing function output and displaying it in shiny from what i know.
A work around for this would be using a non blocking file connection and running the function you want to capture the output from in the background while reading the file for the function output (Check the edit history to see how to do this).
Another way of doing this would be overriding the cat function to write to stderr (simply switching cat with message) and capture the function output like this:
library(shiny)
library(shinyjs)
myPeriodicFunction <- function(){
for(i in 1:5){
msg <- paste(sprintf("Step %d done.... \n",i))
cat(msg)
Sys.sleep(1)
}
}
# Override cat function
cat <- message
runApp(shinyApp(
ui = fluidPage(
shinyjs::useShinyjs(),
actionButton("btn","Click me"),
textOutput("text")
),
server = function(input,output, session) {
observeEvent(input$btn, {
withCallingHandlers({
shinyjs::text("text", "")
myPeriodicFunction()
},
message = function(m) {
shinyjs::text(id = "text", text = m$message, add = FALSE)
})
})
}
))
This example is mostly based on this question by daattali.