Export DiagrammeR, data.tree to image (png) in Shiny - r

I'm trying to download a image from a Shiny App, this image is produced by a DiagrammeR object.
This is the code:
# Load packages
library(shinythemes)
library(DiagrammeR)
library(data.tree)
library(plotly)
library(shiny)
# Load data
data(acme)
# Define UI
ui <- fluidPage(theme = shinytheme("lumen"),
titlePanel("Paula trying II"),
sidebarLayout(
sidebarPanel(downloadButton(outputId = "dld_diagrama", label = "Download diagram")),
mainPanel(
grVizOutput("tree_plot", width = "100%", height = "760px")
)
)
)
# Define server function
server <- function(input, output) {
output$tree_plot <- renderGrViz({
plot(acme)
})
output$dld_diagrama <- downloadHandler(
filename = function(){
paste("diagram", "png", sep = ".")
},
content = function(file) {
plotly::export(tree_plot, file = "diagram.png")
}
)
}
# Create Shiny object
shinyApp(ui = ui, server = server)
This downloads (with errors) a .txt, obviously wrong. I'm trying to download a .png Also I've tried with appshot with no success.

Here is one solution among many using shiny, you could also bring back the export as png button
library(shinythemes)
library(DiagrammeR)
library(data.tree)
library(plotly)
library(shiny)
data(acme)
# Define UI
ui <- fluidPage(theme = shinytheme("lumen"),
titlePanel("Paula trying II"),
sidebarLayout(
sidebarPanel(downloadButton(outputId = "dld_diagrama", label = "Download diagram")),
mainPanel(
grVizOutput("tree_plot", width = "100%", height = "760px")
)
)
)
# Define server function
server <- function(input, output) {
input_plot <- reactive(plot(acme))
output$tree_plot <- renderGrViz({
input_plot()
})
output$dld_diagrama <- downloadHandler(
filename = function(){
paste("diagram", "html", sep = ".")
},
content = function(file) {
htmlwidgets::saveWidget(as_widget(input_plot()), file)
}
)
}
# Create Shiny object
shinyApp(ui = ui, server = server)

This works:
# Load packages
library(shinythemes)
library(DiagrammeR)
library(data.tree)
library(plotly)
library(shiny)
# Load data
data(acme)
# Define UI
ui <- fluidPage(theme = shinytheme("lumen"),
titlePanel("Paula trying II"),
sidebarLayout(
sidebarPanel(downloadButton(outputId = "dld_diagrama", label = "Download diagram")),
mainPanel(
grVizOutput("tree_plot", width = "100%", height = "760px")
)
)
)
# Define server function
server <- function(input, output) {
input_plot <- reactive(plot(acme))
output$tree_plot <- renderGrViz({
plot(acme)
})
output$dld_diagrama <- downloadHandler(
filename = function(){
paste("diagram", "png", sep = ".")
},
content = function(file) {
htmlwidgets::saveWidget(as_widget(input_plot()), "www/diagrama.html", selfcontained = FALSE)
webshot(url = "diagrama.html", delay = 5, file = file)
}
)
}
# Create Shiny object
shinyApp(ui = ui, server = server)

Related

Download multiple dataframes in multiple sheets of the same excel file in a shiny app

I wonderif there is a way to download 2 dataframes in the same excel file but in different sheet via shiny app.
library(shiny)
library(xlsx)
ui <- shinyUI(fluidPage(
titlePanel("Testing File upload"),
sidebarLayout(
sidebarPanel(
downloadButton("dl","Export in Excel")
),
mainPanel(
)
)
))
server <- shinyServer(function(input, output) {
output$dl <- downloadHandler(
filename = function() {
paste0("df_dmodel", "_Table", ".xls")
},
content = function(file){
tbl<-iris
tbl2<-mtcars
write.xlsx(tbl,tbl2 file,
sheetName = "Sheet1", row.names = FALSE)
}
)
})
shinyApp(ui = ui, server = server)
try changing your server code to this. Also, remember to open the app in your browser and not just the rstudio viewer (assuming your are using rstudio). Hope this helps!
server <- shinyServer(function(input, output) {
output$dl <- downloadHandler(
filename = function() {
paste0("df_dmodel", "_Table", ".xlsx")
},
content = function(file){
tbl<-iris
tbl2<-mtcars
sheets <- mget(ls(pattern = "tbl")) # getting all objects in your environment with tbl in the name
names(sheets) <- paste0("sheet", seq_len(length(sheets))) # changing the names in your list
writexl::write_xlsx(sheets, path = file) # saving the file
}
)
})
An alternative to Andrew's answer using write.xlsx from openxlsx with a list of dataframes.
library(shiny)
library(openxlsx)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
downloadButton("dl","Export in Excel")
),
mainPanel(
)
)
))
server <- shinyServer(function(input, output) {
output$dl <- downloadHandler(
filename = function() {
"test.xlsx"
},
content = function(filename){
df_list <- list(iris=iris, mtcars=mtcars)
write.xlsx(x = df_list , file = filename, row.names = FALSE)
}
)
})
shinyApp(ui = ui, server = server)

How to have one observable function for three buttons in Shiny app

I have a button linked to an observable event. The button just uploads an excel spreadsheet and then loads it as a dataframe. I have three of these buttons. Each does the same thing. I would like to create a function that does the uploading so that I dont have to define it two separate times. I just cant figure out how to create a function that allows me to do this in Shiny.
library(shiny)
library(shinydashboard)
library(shinyjs)
library(readxl)
ui <- fluidPage(
titlePanel("My button issue"),
mainPanel(
box(status = "primary", solidHeader = TRUE,collapsible = T,collapsed=FALSE,title = "A. Upload data",
fileInput("pathology",label="",multiple = FALSE),br()),
box(status = "primary", solidHeader = TRUE,collapsible = T,collapsed=FALSE,title = "B. Upload data",
fileInput("FileIn_endoscopy",label="",multiple = FALSE),br())
)
)
server <- function(input, output) {
observe({
inFile_path <- input$pathology
if (!is.null(inFile_path)) {
dataFile <- read_excel(inFile_path$datapath, sheet=1)
RV2$data<-data.frame(dataFile, stringsAsFactors=FALSE)
enable("textPrepPath")
}
else{disable("textPrepPath")}
})
observe({
inFile_endoscopy <- input$FileIn_endoscopy
if (!is.null(inFile_endoscopy)) {
dataFile <- read_excel(inFile_endoscopy$datapath, sheet=1)
RV$data<-data.frame(dataFile, stringsAsFactors=FALSE)
enable("textPrep")
}
else{disable("textPrep")}
})
}
# Run the application
shinyApp(ui = ui, server = server)
I don't have a lot of experience with shiny modules, but I think it's a good approach here. Your example code is incomplete so I can't test it, but maybe something like this whould work?
library(shiny)
library(shinydashboard)
library(shinyjs)
library(readxl)
fileButton <- function(id, title) {
ns <- NS(id)
tagList(
box(status = "primary", solidHeader = TRUE,collapsible = T,collapsed=FALSE,title = title,
fileInput(ns("inputfile"),label="",multiple = FALSE),br())
)
}
file <- function(input, output, session) {
observeEvent(input$inputfile, {
inFile_path <- input$inputfile
if (!is.null(inFile_path)) {
dataFile <- read_excel(inFile_path$datapath, sheet=1)
RV2$data<-data.frame(dataFile, stringsAsFactors=FALSE)
enable("textPrepPath")
}
else{disable("textPrepPath")}
})
}
ui <- fluidPage(
titlePanel("My button issue"),
mainPanel(
fileButton("pathology", "A. Upload data"),
fileButton("FileIn_endoscopy", "B. Upload data")
)
)
server <- function(input, output) {
callModule(file, "pathology")
callModule(file, "FileIn_endoscopy")
}
# Run the application
shinyApp(ui = ui, server = server)

How can I browse and upload an image in a shiny application?

I want to create a shiny application which will the user the ability to browse and load an image and then display it. My question is whether this is supported by shiny.
#ui.r
pageWithSidebar(
headerPanel('Image Recognition'),
sidebarPanel(
fileInput("file1", "Choose Image",
accept = c(
".jpg")
))
,
mainPanel(
imageOutput("file1")
)
)
#server.r
library(shiny)
function(input, output, session) {
(shiny.maxRequestSize=30*1024^2)
output$myImage <- renderImage({
# A temp file to save the output.
# This file will be removed later by renderImage
file1 <- tempfile(fileext = '.png')
# Generate the PNG
png(file1, width = 400, height = 300)
dev.off()
# Return a list containing the filename
list(src = file1,
contentType = 'image/png',
width = 400,
height = 300,
alt = "This is alternate text")
}, deleteFile = TRUE)
}
Here is a solution using base64 encoding of the uploaded file.
library(shiny)
library(base64enc)
options(shiny.maxRequestSize = 30*1024^2)
ui <- fluidPage(
fileInput("upload", "Upload image", accept = "image/png"),
uiOutput("image")
)
server <- function(input, output){
base64 <- reactive({
inFile <- input[["upload"]]
if(!is.null(inFile)){
dataURI(file = inFile$datapath, mime = "image/png")
}
})
output[["image"]] <- renderUI({
if(!is.null(base64())){
tags$div(
tags$img(src= base64(), width="100%"),
style = "width: 400px;"
)
}
})
}
shinyApp(ui, server)

How to put entire image location in tags$img of shiny package?

The following code for tags$img is:
Working...when the image is stored in 'www' folder and src = "Rlogo.png"
Not working...when entire path of the image is given
I need to put the entire location in one of my shiny app where the app.R file will be run from command prompt. Please help thanks..
library(shiny)
ui <- fluidPage(
box(
tags$img(height = 100, width = 100,src = "Rlogo.png"),
tags$img(height = 100, width = 100,src = "E:/myApp/www/Rlogo.png")
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
use imageOutput instead of tags$img:
library(shiny)
ui <- fluidPage(
box(
tags$img(height = 100, width = 100,src = "Rlogo.png"),
imageOutput('image')
)
)
server <- function(input, output, session) {
output$image <- renderImage({
list(src = "E:/myApp/www/Rlogo.png",
alt = "This is alternate text"
)
}, deleteFile = TRUE)
}
shinyApp(ui, server)

Download plots as PNG documents

I am fairly new to Shiny Apps and I wish to download the plots as png/pdf file. After publishing the app online, the downloaded filename is correct but it is an empty file. I applied print function in content for downloadHandler but it doesn seem to work. Can anyone help me out? Thanks
ui.r
library(shiny)
ui <- fluidPage(
titlePanel("My First Shiny Project"),
sidebarLayout(
sidebarPanel(
selectInput("select","Choose a Dataset",
choices = list("trees","pressure"),
selected = "pressure"),
selectInput("format","Choose file format",
choices = list("pdf","png"))
),
mainPanel(
plotOutput("graph")
)
),
downloadButton("download","Download Here")
)
server.r
library(shiny)
server <- function(input,output){
data <- function()({
switch(input$select,
"trees" = trees,
"pressure" = pressure)
})
output$graph <- renderPlot(
plot(data())
)
output$download <- downloadHandler(
filename = function(){
paste("data",input$select,input$format,sep = ".")
},
content = function(file){
if(input$format == "png")
png(file)
if(input$format == "pdf")
pdf(file)
print(plot(data()))
dev.off
}
)
}
It seems that the only issue was that you used dev.off instead of dev.off(), you also do not need the print() statement. A working version of your code is shown below, hope this helps!
library(shiny)
library(ggplot2movies)
library(dplyr)
ui <- fluidPage(
titlePanel("My First Shiny Project"),
sidebarLayout(
sidebarPanel(
selectInput("select","Choose a Dataset",
choices = list("trees","pressure"),
selected = "pressure"),
selectInput("format","Choose file format",
choices = list("pdf","png"))
),
mainPanel(
plotOutput("graph")
)
),
downloadButton("download","Download Here")
)
server <- function(input,output){
data <- function()({
switch(input$select,
"trees" = trees,
"pressure" = pressure)
})
output$graph <- renderPlot(
plot(data())
)
output$download <- downloadHandler(
filename = function(){
paste("data",input$select,input$format,sep = ".")
},
content = function(file){
if(input$format == "png")
png(file)
if(input$format == "pdf")
pdf(file)
plot(data())
dev.off()
}
)
}
shinyApp(ui,server)

Resources