I am having some difficulties with plotly. I would like to be able to download plotly as pdf. However while adding to my code some x and y axis parameters (cause if i transfer ggplot to plotly, titles of x and y axis are cut)
This code is working to download pdf file:
library(shiny)
library(DT)
library(ggplot2)
library(plotly)
shinyApp(
ui = fluidPage(
fluidRow(downloadButton('downloadplot',label='Download Plot')),
plotlyOutput('plot1')
),
server = function(input, output) {
testplot <- function(){
a <- ggplot(mtcars, aes(x = interaction(cyl, carb, lex.order = T), y = mpg,fill = interaction(cyl, carb, lex.order = T))) +
geom_boxplot()
}
output$plot1 <- renderPlotly({testplot()})
output$downloadplot <- downloadHandler(
filename ="plot.pdf",
content = function(file) {
pdf(file, width=12, height=6.3)
print(testplot())
dev.off()
})})
and addition of this code to fix the titles of the ggplotly fails:
a <- ggplot(mtcars, aes(x = interaction(cyl, carb, lex.order = T), y = mpg,fill = interaction(cyl, carb, lex.order = T))) +
geom_boxplot()
p <- ggplotly(a + ylab(" ") + xlab(" "))
x <- list(
title = "[x]"
)
y <- list(
title = "[y]"
)
p %>% layout(xaxis = x, yaxis = y)}
gives an empty plot...
Thanks for any help!
I have solved my question. The solution is not elegant but it works!
So the trick is to set the x and y titles in renderPlotly and NOT in testplot() function.
However the x and y axis titles have to be additionally typed in testplot() function - cause this is going to be our output as pdf, and view of the plot is done with plotly.
Here is code:
library(shiny)
library(DT)
library(ggplot2)
library(plotly)
shinyApp(
ui = fluidPage(
fluidRow(downloadButton('downloadplot',label='Download Plot')),
plotlyOutput('plot1')
),
server = function(input, output) {
testplot <- function(){
a <- ggplot(mtcars, aes(x = interaction(cyl, carb, lex.order = T), y = mpg,fill = interaction(cyl, carb, lex.order = T))) +
geom_boxplot()
}
output$plot1 <- renderPlotly({
p <- ggplotly(testplot() + ylab(" ") + xlab(" "))
x <- list(
title = "[x]"
)
y <- list(
title = "[y]"
)
p %>% layout(xaxis = x, yaxis = y)})
output$downloadplot <- downloadHandler(
filename ="plot.pdf",
content = function(file) {
pdf(file, width=12, height=6.3)
print(testplot())
dev.off()
})})
Related
What to add in server in order to save the plot as either png or svg?
Does ggsave work with ggtern? (which is an extension to ggplot for ternary plots)
Here is a minimal reproducible example of what I'm trying to do in Shiny:
library(shiny)
library(ggtern)
library(tidyverse)
ui <- fluidPage(
downloadButton("dwnld", label = "Save plot"),
plotOutput("ternary")
)
server <- function(input, output) {
# ternary plot via ggtern
output$ternary <- renderPlot({
data <- tibble(x = 0.2, y = 0.3, z = 0.5)
plot <- ggtern(data, aes(x = x, y = y, z = z)) + geom_point(size = 8)
print(plot)
})
# download the plot
#????????
}
shinyApp(ui = ui, server = server)
You can proceed as follows:
myPlot <- reactive({
data <- tibble(x = 0.2, y = 0.3, z = 0.5)
ggtern(data, aes(x = x, y = y, z = z)) + geom_point(size = 8)
})
output[["ternary"]] <- renderPlot({
myPlot()
})
output[["dwnld"]] <- downloadHandler(
filename = "myPlot.png",
content = function(file){
ggsave(file, myPlot())
}
)
When I run this code with renderPlotly. It gives me error but without renderplotly it is working fine. Can you help me in fixing this code with renderPlotly? Thanks in advance.
output$tot_finalized_claims1 <- renderPlotly({
req(input$yearSelectInput)
#filter df to be used in graph
claims1 <- newly_formatted_logResults %>% filter(YEAR == input$yearSelectInput) %>% filter(PEND == "CMI") %>% select(YEAR,MONTH_NUM,PEND, TOTAL_FINALIZE,TOTAL)
data_pcode <- summarize(group_by(claims1,MONTH_NUM), actual_auto = round(sum(as.numeric(TOTAL_FINALIZE),na.rm = TRUE)/sum(as.numeric(TOTAL),na.rm = TRUE),digits = 2))
data_pcode <- data.frame(data_pcode)
ggplot(data = data_pcode,aes(x = MONTH_NUM, y = actual_auto )) +
geom_point() + geom_line() + # add the points and lines
stat_QC(method = "XmR" # specify QC charting method
auto.label = T, # Use Autolabels
label.digits = 2, # Use two digit in the label
show.1n2.sigma = T # Show 1 and two sigma lines
)+
labs(x = "Months",y = "Automation Rate",title = paste("Actual automations by CMI Pend code"))+
geom_text(aes(label=paste(actual_auto ,"%")), position=position_dodge(width=0.95), vjust=-0.5)+
scale_x_continuous(breaks = 1:12,labels = c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"))+
scale_y_continuous(breaks = seq(0.0, 1.0, 0.1))
}) #end tot finalized plot summary
Apart from the fact that you didn't even use the plotly function to create the plot, if you want to generate plotly output you must remember two things:
In server section renderPlotly instead of renderPlot
In UI section plotlyOutput instead of plotOutput
You can try this code to see how it works:
library(shiny)
library(ggplot2)
library(ggthemes)
library(plotly)
ui <- fluidPage(
titlePanel("Plotly"),
sidebarLayout(
sidebarPanel(),
mainPanel(
plotlyOutput("plot2"))
))
server <- function(input, output) {
output$plot2 <- renderPlotly({
ggplotly(
ggplot(data = mtcars, aes(x = disp, y = cyl)) +
geom_smooth(method = lm, formula = y~x) +
geom_point() +
theme_gdocs())
})
}
shinyApp(ui, server)
I would like to disable the plotly legend selection from the server side using the R Plotly. We see here that it is possible to achieve this on plotly javascript using the following,
gd.on('plotly_legendclick',function() { return false; })
Is there any way we can achieve this in R using event_register() or event_data()?
I found a hacky solution using CSS to disable the legend. However, if you have multiple different plots for the same output$gg, the CSS code disables the legend for all plots.
Reprex:
The final goal, clicking on the legend below must not hide any of the points.
library(shiny)
library(plotly)
library(tidyverse)
ui <- fluidPage(
plotlyOutput("gg"),
verbatimTextOutput("click"),
verbatimTextOutput("doubleclick")
)
server <- function(input, output, session) {
output$gg <- renderPlotly({
p <- ggplot(mtcars, aes(wt, mpg, color = factor(cyl))) +
geom_point() +
facet_wrap(~vs)
ggplotly(p) %>%
event_register("plotly_legendclick") %>%
event_register("plotly_legenddoubleclick")
})
output$click <- renderPrint({
event_data("plotly_legendclick")
})
output$doubleclick <- renderPrint({
event_data("plotly_legenddoubleclick")
})
}
shinyApp(ui,server)
This is a job for htmlwidgets::onRender:
library(plotly)
library(htmlwidgets)
x <- c(1:15)
y <- c(1:15)
w <- gl(3,5)
dat <- data.frame(x = x, y = y, w = w)
example <- ggplot(dat, aes(x = x, y = y, color = w)) + geom_line()
ggplotly(example) %>%
onRender("function(el,x){el.on('plotly_legendclick', function(){ return false; })}")
htmlwidgets::onRender isn't needed. We can simply use layout():
library(plotly)
x <- c(1:15)
y <- c(1:15)
w <- gl(3, 5)
dat <- data.frame(x = x, y = y, w = w)
example <- ggplot(dat, aes(x = x, y = y, color = w)) + geom_line()
ggplotly(example) %>% layout(legend = list(
itemclick = FALSE,
itemdoubleclick = FALSE,
groupclick = FALSE
))
Run schema()and navigate:
object ► layout ► layoutAttributes ► legend ► itemclick
for more information on these parameters.
Hello is there a way to display the data labels only for specific data of my dataset? I used key instead of label in order to create the tooltip but I cannot make it work. As a final result I want to be able to display labels of my choice as now and also have some data labels always displayed.
library(shiny)
library(plotly)
library(ggplot2)
ui <- fluidPage(
plotlyOutput("iris")
)
server <- function(input, output, session) {
output$iris <- renderPlotly({
# set up plot
p1 <- ggplot(iris, aes_string(x = "Sepal.Length",
y = "Sepal.Width",
key = "Species")) +
geom_point()+
geom_text(data=subset(iris, Sepal.Lenth > 6),
aes(Sepal.Length,Sepal.Width,label=Species))
# get clicked point
click_data <- event_data("plotly_click", source = "select")
# if a point has been clicked, add a label to the plot
if(!is.null(click_data)) {
label_data <- data.frame(x = click_data[["x"]],
y = click_data[["y"]],
label = click_data[["key"]],
stringsAsFactors = FALSE)
p1 <- p1 +
geom_text(data = label_data,
aes(x = x, y = y, label = label),
inherit.aes = FALSE, nudge_x = 0.25)
}
# return the plot
ggplotly(p1, source = "select", tooltip = c("key"))
})
}
shinyApp(ui, server)
A possible solution is:
library(shiny)
library(plotly)
library(ggplot2)
p1 <- ggplot(iris, aes_string(x = "Sepal.Length",
y = "Sepal.Width",
text = "Species")) +
geom_point() +
geom_text(data=subset(iris, Sepal.Length > 6),
aes(Sepal.Length,Sepal.Width,label=Species))
ui <- fluidPage(
plotlyOutput("iris")
)
server <- function(input, output, session) {
output$iris <- renderPlotly({
# get clicked point
click_data <- event_data("plotly_click", source = "select")
# if a point has been clicked, add a label to the plot
if(!is.null(click_data)) {
pos <- click_data$pointNumber+1
label_data <- data.frame(x = iris$Sepal.Length[pos],
y = iris$Sepal.Width[pos],
label = iris$Species[pos],
stringsAsFactors = FALSE)
p1 <<- p1 +
geom_text(data = label_data,
aes(x = x, y = y, label = label),
inherit.aes = FALSE, nudge_y=.1)
}
# return the plot
ggplotly(p1, source = "select", tooltip = c("text"))
})
}
shinyApp(ui, server)
I have the following shiny app:
library(shiny)
library(ggplot2)
library(dplyr)
library(networkD3)
library(ggmosaic)
#Loading data
Category <- c("Bankpass", "Bankpass", "Bankpass", "Moving", "Moving")
Subcategory <- c("Stolen", "Lost", "Login", "Address", "New contract")
Weight <- c(10,20,13,40,20)
Duration <- as.character(c(0.2,0.4,0.5,0.44,0.66))
Silence <- as.character(c(0.1,0.3,0.25,0.74,0.26))
df <- data.frame(Category, Subcategory, Weight, Duration, Silence)
ui <- fluidPage(
tags$div(class="header",
selectInput("measure", "", c("Duration", "Silence"))
),
mainPanel(
tags$div(class = "dashboard_main",
tags$div(class="dashboard_main_left", plotOutput("secondPlot"))
)
)
)
server <- function(input, output){
output$secondPlot <- renderPlot({
ggplot(data = df) +
geom_mosaic(aes(weight = Weight, x = product(Category), fill=Duration),
offset = 0, na.rm=TRUE) +
theme(axis.text.x=element_text(angle=-25, hjust= .1)) +
theme(axis.title.x=element_blank()) +
scale_fill_manual(values=c("#e8f5e9", "#c8e6c9", "#a5d6a7", "#81c784", "#66bb6a"))
})
}
shinyApp(ui = ui, server= server)
I would like to make the second plot interactive now. So if you select the Duration the fill in the plot "secondPlot" should be Duration and if you you select "Silence" the fill should be "Silence".
However when I change the relevante code of the graph to:
ggplot(data = df) +
geom_mosaic(aes(weight = Weight, x = product(Category), fill=input$measure),
offset = 0, na.rm=TRUE) +
theme(axis.text.x=element_text(angle=-25, hjust= .1)) +
theme(axis.title.x=element_blank())
I dont see the colour gradients anymore. Any thoughts on what goes wrong here?
You should use aes_string inside geom_mosaic. Try this:
server <- function(input, output){
df$prodcat <- product(df$Category)
output$secondPlot <- renderPlot({
ggplot(data = df) +
geom_mosaic(aes_string(weight = "Weight", x = "prodcat", fill=input$measure),
offset = 0, na.rm=TRUE) +
theme(axis.text.x=element_text(angle=-25, hjust= .1)) +
theme(axis.title.x=element_blank()) +
scale_fill_manual(values=c("#e8f5e9", "#c8e6c9", "#a5d6a7", "#81c784", "#66bb6a"))
})
}