Using a download handler to save ggplot images in shiny - r

I am developing an application in shiny.In shiny, I am rendering a simple plot using the action button. I have included a download button to download the the plot that is now in UI. from my code(plot3)
I tried the below code, to save the image, but I am getting an error
plotInput not found.
Could any one suggest where i am going wrong.
Below is my code for reference.
UI:
ui <- tabItem(tabName = "models2",
fluidPage(
fluidRow(
infoBoxOutput("overview")
),
fluidRow(
actionButton("result1","Generate Result"),
downloadButton('downloadPlot','Download Plot'),
plotOutput("plot3")
)
))
SERVER
server <- function(input,output,session{
output$overview <- renderValueBox({
valueBox(
paste("91"),"Overview",icon=icon("hourglass"),
color="green"
)
})
observeEvent(input$result1,{
output$plot3 <- renderPlot({
ggplot(data=timedata, aes(x=dat1, y=yes, group=3))+
geom_point(shape=1)+
coord_cartesian(xlim=c(dat1_xlowlim,dat1_xhighlim))+
labs(title="Probability",x="Date",y="True probability")
})
})
output$downloadPlot <- downloadHandler(
filename = function(){paste(input$plot3,'.png',sep='')},
content = function(plot3){
ggsave(plot3,plotInput())
}
)
})
Also, to note my shiny and R studio are in R environment.

library(shiny)
library(shinydashboard)
ui <- tabItem(tabName = "models2",
fluidPage(
fluidRow(
infoBoxOutput("overview")
),
fluidRow(
actionButton("result1","Generate Result"),
downloadButton('downloadPlot','Download Plot'),
plotOutput("plot3")
)
))
server <- function(input,output,session){
output$overview <- renderValueBox({
valueBox(
paste("91"),"Overview",icon=icon("hourglass"),
color="green"
)
})
data <- reactiveValues()
observeEvent(input$result1,{
data$plot <- ggplot(data=iris, aes(x=Sepal.Length, y=Sepal.Width))+
geom_point(shape=1)})
output$plot3 <- renderPlot({ data$plot })
output$downloadPlot <- downloadHandler(
filename = function(){paste("input$plot3",'.png',sep='')},
content = function(file){
ggsave(file,plot=data$plot)
}
)
}
shinyApp(ui, server)

#Mikz
I don't have enough reputation to follow your comment. Thus, I create a new anwser but wish to answer your question 'why app closes automatically?'.
I had same issue when I develop shiny app on rstudio-server of my company. My app will close by itself after a while. However, same app run on my local laptop don't have this issue.
After my research, I believe it caused by timeout setting (default is 60 seconds). I also use function ~~Sys.sleep()~~ to test this default time. I found the solution works for me from this blog .
The idea is using WebSocket to trigger app every 50 seconds. In this way, you don't need to ask technique guy to adjust setting on server level.

Related

Waiter for R shiny not showing properly when using it on renders of different tabPanel

I have an issue with the waiter which I need for an app built with R shiny.
The example below (based on the fantastic website on the waiter package by John Coene: https://waiter.john-coene.com/#/waiter/examples#on-render) helps me illustrate my issue.
The app is made of two tabPanels, the first one which shows a table, and the second one that shows a chart. The table and the chart will appear after some waiting time, and the waiter spinner should, in the meantime, appear in the middle of the rendering areas of both tabPanels.
However, what actually happen is that the waiter spinner only shows up in the middle of the rendering area of the tabPanel I open first, whereas in the other tabPanel it is stuck in the top-left corner of the page.
Many thanks in advance for whoever can help me fix this problem!
library(shiny)
library(highcharter)
library(shinythemes)
library(waiter)
ui <- fluidPage(
theme = shinytheme("cyborg"),
useWaiter(),
actionButton("draw", "render stuff"),
fluidPage(
tabsetPanel(
tabPanel("Table", tableOutput("table")),
tabPanel("Chart", highchartOutput("hc"))
)
)
)
server <- function(input, output){
# specify the id
w <- Waiter$new(id = c("hc", "table"))
dataset <- reactive({
input$draw
w$show()
Sys.sleep(8)
head(cars)
})
output$table <- renderTable(dataset())
output$hc <- renderHighchart({
hchart(dataset(), "scatter", hcaes(speed, dist))
})
}
shinyApp(ui, server)
I would recommend you use shinycssloaders instead. The reason is that loaders' positions in waiter are calculated by current visible height and width. However, there is no visible position in the second tab or the hidden tabs, so waiter can't add the loader to the right spot. There is no fix we can do here. This is a feature that waiter doesn't support currently.
library(shiny)
library(highcharter)
library(shinythemes)
library(shinycssloaders)
ui <- fluidPage(
theme = shinytheme("cyborg"),
actionButton("draw", "render stuff"),
fluidPage(
tabsetPanel(
tabPanel("Table", withSpinner(tableOutput("table"), type = 3, color.background = "#060606", color = "#EEEEEE")),
tabPanel("Chart", withSpinner(highchartOutput("hc"), type = 3, color.background = "#060606", color = "#EEEEEE"))
)
)
)
server <- function(input, output){
dataset <- reactive({
input$draw
Sys.sleep(4)
head(cars)
})
output$table <- renderTable(dataset())
output$hc <- renderHighchart({
hchart(dataset(), "scatter", hcaes(speed, dist))
})
}
shinyApp(ui, server)

Reset event_data using shinyjs doesn't seem to work anymore, after the recent update

I am maintaining my code for a big and bulky shiny dashboard, and I noticed that the click-event functionality doesn't reset anymore.
After stripping it down to a minimal working example, and comparing to solutions from https://stackoverflow.com/a/44543204/11703379 and https://community.plot.ly/t/reseting-click-events/2718, I come to conclusion that there must have been a change in either plotly, or shinyjs libraries, which disable this feature.
By halting the execution at the plot, I see that the plot object does carry the source attribute correctly.
library(plotly)
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
plotlyOutput("plot"),
extendShinyjs(text = "shinyjs.resetClick = function() { Shiny.onInputChange('.clientValue-plotly_click-plot', 'null'); }"),
actionButton("reset", "Reset click"),
verbatimTextOutput("click")
)
server <- function(input, output, session) {
observeEvent(input$reset, js$resetClick())
output$click <- renderPrint(event_data("plotly_click", source = "plot" ))
output$plot <- renderPlotly(
plot_ly(mtcars, x = ~mpg, y = ~wt,
type="scatter",
mode="markers",
source = "plot") %>%
event_register("plotly_click")
)
output$click <- renderPrint({
d <- event_data(source = "plot","plotly_click")
if (is.null(d)) "No click" else d
})
}
shinyApp(ui, server)
Can anyone confirm this?
I am using plotly version 4.9.0,
and shinyjs version 1.0.
Seems like .clientValue- is not necessary anymore. Probably a change in plotly, but I am not sure about it.
Change .clientValue-plotly_click-plot to plotly_click-plot and it should work.
Output:

R shiny fileInput large files

i have some problem with fileInput for R Shiny. Size limit is set to 5MB per default.
Since the files i have to work with are very large (>50GB), I only need the datapath and or name of the file. Unfortunatly fileInput wants to upload the complete file or at least it is loading the file somehow and tells me that the file is too big after i have reached the 5MB limit.
How can I only hand over the path to my app without uploading the file?
ui.R
library(shiny)
# Define UI ----
shinyUI(fluidPage(
h1("SAS Toolbox"),
tabsetPanel(
tabPanel("SASFat",
sidebarPanel(h2("Input:"),
actionButton("runSASFat","Run Job",width="100%",icon("paper-plane"),
style="color: #fff; background-color: #337ab7; border-color: #2e6da4"),
wellPanel(
#tags$style(".shiny-file-input-progress {display: none}"),
fileInput("FEInp","Pfad FE input Deck:"),
fileInput("FERes","Pfad FE Results:")
),
wellPanel(
checkboxGroupInput("options1","Auswertung:",c("Grundmaterial","Schweissnähte")),
conditionalPanel(condition="$.inArray('Schweissnähte',input.options1) > -1",
sliderInput("filter", "Filter:", 0.75, min = 0, max = 1))
),
wellPanel(
radioButtons("solver", "Solver:", c("Ansys","Abaqus", "Optistruct")),
conditionalPanel(condition="input.solver == 'Ansys'",selectInput("lic", "Lizenz",c("preppost","stba","meba")))
),
wellPanel(
checkboxGroupInput("options2","Optionen:",c("Schreibe LCFiles"))
)
),
mainPanel(br(),h2("Output:"),width="30%")
),
tabPanel("Nietauswertung"),
tabPanel("Spannungskonzept EN12663")
)
))
server.R
# Define server logic ----
shinyServer(function(input, output) {
observeEvent(input$runSASFat, {
FEInp <- input$FEInp
FERes <- input$FERes
opt1 <- input$options1
opt2 <- input$options2
filter <- input$filter
solver <- input$solver
lic <- input$lic
write(c(FEInp$datapath,FERes$datapath,opt1,opt2,filter,solver,lic),"ghhh.inp")
})
})
Thanks in advance
Michael
Thanks for the example #MichaelBird. I adapted your code to let users cancel the request without choosing a file (your app crashed after canceling):
This by the way only works on the PC hosting the shiny app.
library(shiny)
ui <- fluidPage(
titlePanel("Choosing a file example"),
sidebarLayout(
sidebarPanel(
actionButton("filechoose",label = "Pick a file")
),
mainPanel(
textOutput("filechosen")
)
)
)
server <- function(input, output) {
path <- reactiveVal(value = NULL)
observeEvent(input$filechoose, {
tryPath <- tryCatch(
file.choose()
, error = function(e){e}
)
if(inherits(tryPath, "error")){
path(NULL)
} else {
path(tryPath)
}
})
output$filechosen <- renderText({
if(is.null(path())){
"Nothing selected"
} else {
path()
}
})
}
shinyApp(ui = ui, server = server)
An alternative way would be to increase the maximum file size for uploads:
By default, Shiny limits file uploads to 5MB per file. You can modify
this limit by using the shiny.maxRequestSize option. For example,
adding options(shiny.maxRequestSize = 30*1024^2) to the top of app.R
would increase the limit to 30MB.
See this RStudio article.
Here is an example of using file.choose() in a shiny app to obtain the local path of the file (and hence the file name):
library(shiny)
ui <- fluidPage(
# Application title
titlePanel("Choosing a file example"),
sidebarLayout(
sidebarPanel(
actionButton("filechoose",label = "Pick a file")
),
mainPanel(
textOutput("filechosen")
)
)
)
server <- function(input, output) {
path <- reactiveValues(
pth=NULL
)
observeEvent(input$filechoose,{
path$pth <- file.choose()
})
output$filechosen <- renderText({
if(is.null(path$pth)){
"Nothing selected"
}else{
path$pth
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Is this what you're after?

Create multiple graphs with button in shiny

I have the following shiny script
library(shiny)
ui <- fluidPage(
actionButton("go", "Go"),
#This should trigger a default 100 hist
actionButton("go", "Go"),
numericInput("n", "n", 50),
plotOutput("plot")
)
server <- function(input, output) {
randomVals <- eventReactive(input$go, {
runif(input$n)
})
randomVals2 <- eventReactive(input$go, {
runif(n = 100)
})
output$plot <- renderPlot({
hist(randomVals())
})
output$plot2 <- renderPlot({
hist(randomVals2())
})
}
shinyApp(ui, server)
This provides me with a button I can press to get a histogram. It works fine. However, I would also like to include another button next to it that gives a histogram with default n = 100 (just for learning purposes).
However the second button does not seem to work.
Any thoughts on what should be changed to trigger it?
#PorkChop has correctly pointed out one bug in your code, which is the repeated IDs of both buttons. Also, your don't have plot2 defined in your UI function.
However, I would like to comment that the functions defined is a bit redundant. In principle, both buttons should preform the same functionalities (generate random data and plot their histogram), with different size parameter.
The neatest way would be defining one function that does the full functionality required, and calling it with the specific parameters with each button:
library(shiny)
ui <- fluidPage(
actionButton("go_hist", "Go"),
actionButton("go_hist_100", "Go with 100"), #This should trigger a default 100 hist
numericInput("n", "n", 50),
plotOutput("plot")
)
server <- function(input, output) {
plotHist = function(size){
randomData = runif(size)
output$plot = renderPlot(hist(randomData, main = paste("n =", size)))
}
observeEvent(input$go_hist, plotHist(input$n))
observeEvent(input$go_hist_100, plotHist(100))
}
shinyApp(ui, server)
With such functionalization, your code will be easier to read, debug and maintain.
You cant have multiple buttons with the same id please change button names
actionButton("go", "Go"),
#This should trigger a default 100 hist
actionButton("go1", "Go"),

Shiny: Increase highchart size on button click

I want to increase the size of highchart on clicking the zoom button. I tried using the code below to increase the size but so far I have not been able to achieve what I want to do. I actually wanted the highchart to expand and occupy the full page on clicking the zoom button. I have written the following code so far but it does not seem to work. Can anyone tell me what I am doing wrong?
require(shiny)
require(rCharts)
ui <- fluidPage(
tags$script('Shiny.addCustomMessageHandler("ZoomPlot", function(variableName){
document.getElementById(variableName).style.height = "1000px";
});
'),
headerPanel("Test app"),
actionButton("test", "Zoom"),
div(class = "chart-container", showOutput("viz", "highcharts"))
)
server <- shinyServer(function(input, output, session) {
output$viz <- renderChart2({
a <- highchartPlot(Sepal.Length ~ Sepal.Width, data=iris)
a
})
observeEvent(input$test,{
session$sendCustomMessage(type = 'ZoomPlot', message = "viz")
})
})
shinyApp(ui, server)
You can do it using only server side like
server <- shinyServer(function(input, output, session) {
hh=reactive({
if(input$test>0 ) {1000}else{400}
})
output$viz <- renderChart2({
a <- highchartPlot(Sepal.Length ~ Sepal.Width, data=iris)
a$set(height = hh()
)
a
})
})

Resources