How to export plot_ly image as png from shiny app? I want to export png or jpg on action button 'ExportPlot' (as specified below). I know about plot_ly solution https://plot.ly/r/static-image-export/ however it require to create user on plot_ly as i read about it.
I would be grateful for any tips/solution.
library(shiny)
library(plotly)
ui <- fluidPage(
actionButton('ExportPlot', 'Export as png'),
plotlyOutput("plot"),
verbatimTextOutput("event")
)
server <- function(input, output) {
# renderPlotly() also understands ggplot2 objects!
output$plot <- renderPlotly({
plot_ly(mtcars, x = ~mpg, y = ~wt)
})
output$event <- renderPrint({
d <- event_data("plotly_hover")
if (is.null(d)) "Hover on a point!" else d
})
}
shinyApp(ui, server)
Here is the solution which provides download on click:
library(shiny)
library(plotly)
ui <- fluidPage(
downloadButton('ExportPlot', 'Export as png'),
plotlyOutput("plot")
)
server <- function(input, output) {
# generate the plot
thePlot <- reactive({
p <- plot_ly(mtcars, x = ~mpg, y = ~wt)
})
# renderPlotly()
output$plot <- renderPlotly({
thePlot()
})
# download
output$ExportPlot <- downloadHandler(
# file name
filename <- 'plot.png',
# content
content = function(file){
# create plot
export(p = thePlot(), file = 'tempPlot.png')
# hand over the file
file.copy('tempPlot.png',file)
}
)
}
shinyApp(ui, server)
Please note: With the RStudio browser/viewer the file name which is set per default is not correctly hand over, with external Browsers (e.g. Firefox) it should work.
Related
I want the bar plot to be embedded into application.output of vector d is giving me result I want that to be embedded into shinyapp and later I want to make it interactive too.
library(ggplot2)
driver1 <- read.csv("E:/RMARKDOWN/shiny/driver.csv",header = T)
New_DataSet1<-
data.frame(driver1$ï..Year_AG,driver1$Severity_Desc,driver1$Injury.Type)
New_DataSet1
latest <- New_DataSet1[1:100,]
latest
d <- aggregate(latest$driver1.Injury.Type, by=list(chkID =
latest$driver1.Severity_Desc), FUN=sum)
ui <- dashboardPage(
dashboardHeader(title = "Row layout"),
dashboardSidebar(),
dashboardBody()
)
server <- function(input, output) {
#output$plot <- renderPlot({ barplot(d$x, xlab = d$chkID) })
renderPlot(d$x)
#barplot(d$x, xlab = d$chkID)
# barplot(d$x, names.arg = d$chkID)
}
shinyApp(ui,server)
You can read file first and render it using bar chart as below:
library(plotly)
library(shiny)
ui <- fluidPage(
mainPanel(
plotlyOutput("chart")
)
)
server <- function(input, output, session) {
output$chart <- renderPlotly({
# write code here to read data from csv file
df=read.csv("")
# Set x and y axis and display data in bar chart using plotly
p <- plot_ly( x = iris$Species,
y = iris$Sepal.Length,
name = "Iris data",
type = "bar")
})
}
shinyApp(ui, server)
Screenshot from working demo:
I have the data frame below:
Name<-c("John","Bob","Jack")
Number<-c(3,3,5)
NN<-data.frame(Name,Number)
And a simple shiny app which creates a plotly histogram out of it. My goal is to click on a bar of the histogram and display the Name in a datatable that correspond to this bar. For example if I click on the first bar which is 3 I will take a table with John and Bob names.
library(plotly)
library(shiny)
library(DT)
ui <- fluidPage(
mainPanel(
plotlyOutput("heat")
),
DT::dataTableOutput('tbl4')
)
server <- function(input, output, session) {
output$heat <- renderPlotly({
p <- plot_ly(x = NN$Number, type = "histogram")
})
output$tbl4 <- renderDataTable({
s <- event_data("plotly_click")
if (length(s) == 0) {
"Click on a bar in the histogram to see its values"
} else {
NN[ which(NN$Number==as.numeric(s[2])), 1]
}
})
}
shinyApp(ui, server)
I am adding the solution by modifying your data.frame as mentioned in the comment:
library(plotly)
library(shiny)
library(DT)
ui <- fluidPage(
mainPanel(
plotlyOutput("heat")
),
DT::dataTableOutput('tbl4')
)
server <- function(input, output, session) {
output$heat <- renderPlotly({
Name<-c("John","Bob","Jack")
Number<-c(3,3,5)
Count<-c(2,2,1)
NN<-data.frame(Name,Number,Count)
render_value(NN) # You need function otherwise data.frame NN is not visible
p <- plot_ly(x = NN$Number, type = "histogram",source="subset") # set source so
# that you can get values from source using click_event
})
render_value=function(NN){
output$tbl4 <- renderDataTable({
s <- event_data("plotly_click",source = "subset")
print(s)
return(DT::datatable(NN[NN$Count==s$y,]))
})
}
}
shinyApp(ui, server)
Screenshot from solution:
Is it possible to download a ggplotly() object as .png like a ggplot() object in a shiny application which you open in a browser. I have found some ways to download a ggplot but none for ggplotly. If there is no way is there some hacky alternative?
library(shiny)
library(plotly)
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("event"),
downloadButton("download","Download Plot")
)
server <- function(input, output) {
# renderPlotly() also understands ggplot2 objects!
save<-reactive({
plot_ly(mtcars, x = ~mpg, y = ~wt)
})
output$plot <- renderPlotly({
ggplotly(save())
})
output$download <- downloadHandler(
filename = function() {
paste("down", ".png", sep="")
},
content = function(file) {
ggsave(file, plot = save())
}
)
}
shinyApp(ui, server)
I am new to R&shiny. I'd like to make a shiny app that the plot can be interactive with subset I choose, but ggplot cannot work with warning
Error in ouptut$Trendplot <- renderPlot({ : object 'ouptut' not found
It will be really appreciated if you can help to figure it works.
The following is my code:
library(shiny)
library(ggplot2)
# Define UI for application that draws a histogram
ui <- pageWithSidebar(
# Application title
headerPanel("Pre-report situation"),
# Sidebar with a slider input for number of bins
sidebarPanel(selectizeInput("DMS", "DMS:", choices = unique(datass$DMS)
)),
# Show a plot of the generated distribution
mainPanel(
h3(textOutput("caption")),
plotOutput("Trendplot"))
)
datass <- read.csv("C:/Users/yyu6/Documents/PR.csv", sep=",", stringsAsFactors = FALSE)
# Define server logic required to draw a histogram
server <- function(input, output) {
formulaText <- reactive({
input$DMS })
datasetInput <- reactive({
selection <- Input$DMS
subset(datass, DMS == selection)
})
output$caption <- renderText({formulaText()
})
ouptut$Trendplot <- renderPlot({
ggplot(datasetInput(), mapping = aes(x=DMS))+geom_histogram(stat = "count")
})
}
# Run the application
shinyApp(ui = ui, server = server)
I would like to fetch nearPoints using the data from a click event.
I have found the below snippet from the Shiny webpage and it works fine as expected.
output$plot <- renderPlot({
d <- data()
plot(d$speed, d$dist)
})
output$plot_clickedpoints <- renderPrint({
# For base graphics, we need to specify columns, though for ggplot2,
# it's usually not necessary.
res <- nearPoints(data(), input$plot_click, "speed", "dist")
if (nrow(res) == 0)
return()
res
})
I tried to mimic the above the approach to identify the nearPoints in the Plotly plots using the click event data. However, it did not work.
output$plot <- renderPlotly({
d <- data()
plot(d$speed, d$dist)
})
output$plot_clickedpoints <- renderPrint({
# For base graphics, we need to specify columns, though for ggplot2,
# it's usually not necessary.
res <- nearPoints(data(), event_data("plotly_click"), "speed", "dist")
if (nrow(res) == 0)
return()
res
})
Any idea on how to pass the coordinate information to the plotly plot?
I am not sure on how to do this with the nearPoints function, but is using that function really necessary? You could find the points that are within a threshold of the clicked point as well with the following code:
library(shiny)
library(plotly)
library(DT)
threshold_mpg = 3
threshold_cyl = 1
shinyApp(
ui <- shinyUI(
fluidPage(
plotlyOutput("plot"),
DT::dataTableOutput("table")
)
),
function(input,output){
data <- reactive({
mtcars
})
output$plot <- renderPlotly({
d <- data()
plot_ly(d, x= ~mpg, y=~cyl, mode = "markers", type = "scatter", source="mysource")
})
output$table<- DT::renderDataTable({
event.data <- event_data("plotly_click", source = "mysource")
print(event.data)
if(is.null(event.data)) { return(NULL)}
# A simple alternative for the nearPoints function
result <- data()[abs(data()$mpg-event.data$x)<=threshold_mpg & abs(data()$cyl-event.data$y)<=threshold_cyl, ]
DT::datatable(result)
})
}
)
Hope this helps.
The "plotly_selected" plotly.js event returns more information than event_data("plotly_selected") actually gives you, including coordinate information (this was arguably a design mistake made by event_data() that's too late to change). Fortunately, if you know a bit of JavaScript, know how to listen to plotly select events, and how to send data from client to a shiny server, you can do something like this to access that info:
library(shiny)
library(plotly)
library(htmlwidgets)
ui <- fluidPage(
plotlyOutput("p"),
verbatimTextOutput("info")
)
server <- function(input, output, session, ...) {
output$p <- renderPlotly({
plot_ly(x = 1:10, y = 1:10) %>%
layout(dragmode = "select") %>%
onRender(
"function(el, x) {
var gd = document.getElementById(el.id);
gd.on('plotly_selected', function(d) {
// beware, sometimes this event fires objects that can't be seralized
console.log(d);
Shiny.onInputChange('my-select-event', d.range)
})
}")
})
output$info <- renderPrint({
print(session$rootScope()$input[["my-select-event"]])
})
}
shinyApp(ui, server)
Using the coordinate information you could write a function that works in a similar way to nearPoints().